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