1package Test::Harness::Util;
2
3use strict;
4use vars qw($VERSION);
5$VERSION = '0.01';
6
7use File::Spec;
8use Exporter;
9use vars qw( @ISA @EXPORT @EXPORT_OK );
10
11@ISA = qw( Exporter );
12@EXPORT = ();
13@EXPORT_OK = qw( all_in shuffle blibdirs );
14
15=head1 NAME
16
17Test::Harness::Util - Utility functions for Test::Harness::*
18
19=head1 SYNOPSIS
20
21Utility functions for Test::Harness::*
22
23=head1 PUBLIC FUNCTIONS
24
25The following are all available to be imported to your module.  No symbols
26are exported by default.
27
28=head2 all_in( {parm => value, parm => value} )
29
30Finds all the F<*.t> in a directory.  Knows to skip F<.svn> and F<CVS>
31directories.
32
33Valid parms are:
34
35=over
36
37=item start
38
39Starting point for the search.  Defaults to ".".
40
41=item recurse
42
43Flag to say whether it should recurse.  Default to true.
44
45=back
46
47=cut
48
49sub all_in {
50    my $parms = shift;
51    my %parms = (
52        start => ".",
53        recurse => 1,
54        %$parms,
55    );
56
57    my @hits = ();
58    my $start = $parms{start};
59
60    local *DH;
61    if ( opendir( DH, $start ) ) {
62        my @files = sort readdir DH;
63        closedir DH;
64        for my $file ( @files ) {
65            next if $file eq File::Spec->updir || $file eq File::Spec->curdir;
66            next if $file eq ".svn";
67            next if $file eq "CVS";
68
69            my $currfile = File::Spec->catfile( $start, $file );
70            if ( -d $currfile ) {
71                push( @hits, all_in( { %parms, start => $currfile } ) ) if $parms{recurse};
72            }
73            else {
74                push( @hits, $currfile ) if $currfile =~ /\.t$/;
75            }
76        }
77    }
78    else {
79        warn "$start: $!\n";
80    }
81
82    return @hits;
83}
84
85=head1 shuffle( @list )
86
87Returns a shuffled copy of I<@list>.
88
89=cut
90
91sub shuffle {
92    # Fisher-Yates shuffle
93    my $i = @_;
94    while ($i) {
95        my $j = rand $i--;
96        @_[$i, $j] = @_[$j, $i];
97    }
98}
99
100
101=head2 blibdir()
102
103Finds all the blib directories.  Stolen directly from blib.pm
104
105=cut
106
107sub blibdirs {
108    my $dir = File::Spec->curdir;
109    if ($^O eq 'VMS') {
110        ($dir = VMS::Filespec::unixify($dir)) =~ s-/\z--;
111    }
112    my $archdir = "arch";
113    if ( $^O eq "MacOS" ) {
114        # Double up the MP::A so that it's not used only once.
115        $archdir = $MacPerl::Architecture = $MacPerl::Architecture;
116    }
117
118    my $i = 5;
119    while ($i--) {
120        my $blib      = File::Spec->catdir( $dir, "blib" );
121        my $blib_lib  = File::Spec->catdir( $blib, "lib" );
122        my $blib_arch = File::Spec->catdir( $blib, $archdir );
123
124        if ( -d $blib && -d $blib_arch && -d $blib_lib ) {
125            return ($blib_arch,$blib_lib);
126        }
127        $dir = File::Spec->catdir($dir, File::Spec->updir);
128    }
129    warn "$0: Cannot find blib\n";
130    return;
131}
132
1331;
134