File Coverage

blib/lib/Apache/TestSort.pm
Criterion Covered Total %
statement 9 39 23.1
branch 0 8 0.0
condition 0 6 0.0
subroutine 3 7 42.9
pod 0 4 0.0
total 12 64 18.8


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