home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / TestSort.pm < prev    next >
Encoding:
Perl POD Document  |  2004-03-04  |  2.0 KB  |  86 lines
  1. # Copyright 2001-2004 The Apache Software Foundation
  2. #
  3. # Licensed under the Apache License, Version 2.0 (the "License");
  4. # you may not use this file except in compliance with the License.
  5. # You may obtain a copy of the License at
  6. #
  7. #     http://www.apache.org/licenses/LICENSE-2.0
  8. #
  9. # Unless required by applicable law or agreed to in writing, software
  10. # distributed under the License is distributed on an "AS IS" BASIS,
  11. # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  12. # See the License for the specific language governing permissions and
  13. # limitations under the License.
  14. #
  15. package Apache::TestSort;
  16.  
  17. use strict;
  18. use warnings FATAL => 'all';
  19. use Apache::TestTrace;
  20.  
  21. sub repeat {
  22.     my($list, $times) = @_;
  23.     # a, a, b, b
  24.     @$list = map { ($_) x $times } @$list;
  25. }
  26.  
  27. sub rotate {
  28.     my($list, $times) = @_;
  29.     # a, b, a, b
  30.     @$list = (@$list) x $times;
  31. }
  32.  
  33. sub random {
  34.     my($list, $times) = @_;
  35.  
  36.     rotate($list, $times); #XXX: allow random,repeat
  37.  
  38.     my $seed = $ENV{APACHE_TEST_SEED} || '';
  39.     my $info = "";
  40.  
  41.     if ($seed) {
  42.         $info = " (user defined)";
  43.         # so we could reproduce the order
  44.     }
  45.     else {
  46.         $info = " (autogenerated)";
  47.         $seed = time ^ ($$ + ($$ << 15));
  48.     }
  49.  
  50.     warning "Using random number seed: $seed" . $info;
  51.  
  52.     srand($seed);
  53.  
  54.     #from perlfaq4.pod
  55.     for (my $i = @$list; --$i; ) {
  56.         my $j = int rand($i+1);
  57.         next if $i == $j;
  58.         @$list[$i,$j] = @$list[$j,$i];
  59.     }
  60. }
  61.  
  62. sub run {
  63.     my($self, $list, $args) = @_;
  64.  
  65.     my $times = $args->{times} || 1;
  66.     my $order = $args->{order} || 'rotate';
  67.     if ($order =~ /^\d+$/) {
  68.         #dont want an explicit -seed option but env var can be a pain
  69.         #so if -order is number assume it is the random seed
  70.         $ENV{APACHE_TEST_SEED} = $order;
  71.         $order = 'random';
  72.     }
  73.     my $sort = \&{$order};
  74.  
  75.     # re-shuffle the list according to the requested order
  76.     if (defined &$sort) {
  77.         $sort->($list, $times);
  78.     }
  79.     else {
  80.         error "unknown order '$order'";
  81.     }
  82.  
  83. }
  84.  
  85. 1;
  86.