# Licensed to the Apache Software Foundation (ASF) under one or more # contributor license agreements. See the NOTICE file distributed with # this work for additional information regarding copyright ownership. # The ASF licenses this file to You under the Apache License, Version 2.0 # (the "License"); you may not use this file except in compliance with # the License. You may obtain a copy of the License at # # http://www.apache.org/licenses/LICENSE-2.0 # # Unless required by applicable law or agreed to in writing, software # distributed under the License is distributed on an "AS IS" BASIS, # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. # See the License for the specific language governing permissions and # limitations under the License. # package Apache::TestSort; use strict; use warnings FATAL => 'all'; use Apache::TestTrace; sub repeat { my($list) = @_; return @{$list}; } sub random { my($list) = @_; my $seed = $ENV{APACHE_TEST_SEED} || ''; my $info = ""; if ($seed) { $info = " (user defined)"; # so we could reproduce the order } else { $info = " (autogenerated)"; $seed = time ^ ($$ + ($$ << 15)); } warning "Using random number seed: $seed" . $info; srand($seed); #from perlfaq4.pod for (my $i = @$list; --$i; ) { my $j = int rand($i+1); next if $i == $j; @$list[$i,$j] = @$list[$j,$i]; } } sub run { my($self, $list, $args) = @_; my $order = $args->{order} || 'repeat'; if ($order =~ /^\d+$/) { #dont want an explicit -seed option but env var can be a pain #so if -order is number assume it is the random seed $ENV{APACHE_TEST_SEED} = $order; $order = 'random'; } my $sort = \&{$order}; # re-shuffle the list according to the requested order if (defined &$sort) { $sort->($list); } else { error "unknown order '$order'"; } } 1;