1 files changed, 76 insertions, 0 deletions
diff --git a/debian/perl-framework/Apache-Test/lib/Apache/TestSort.pm b/debian/perl-framework/Apache-Test/lib/Apache/TestSort.pm
new file mode 100644
index 0000000..33eabc2
--- /dev/null
+++ b/debian/perl-framework/Apache-Test/lib/Apache/TestSort.pm
@@ -0,0 +1,76 @@
+# 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;