lib/Test/Harness/Util.pm

   1 package Test::Harness::Util;
   2
   3 use strict;
   4 use vars qw($VERSION);
   5 $VERSION = '0.01';
   6
   7 use File::Spec;
   8 use Exporter;
   9 use 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
  17 Test::Harness::Util - Utility functions for Test::Harness::*
  18
  19 =head1 SYNOPSIS
  20
  21 Utility functions for Test::Harness::*
  22
  23 =head1 PUBLIC FUNCTIONS
  24
  25 The following are all available to be imported to your module.  No symbols
  26 are exported by default.
  27
  28 =head2 all_in( {parm => value, parm => value} )
  29
  30 Finds all the F<*.t> in a directory.  Knows to skip F<.svn> and F<CVS>
  31 directories.
  32
  33 Valid parms are:
  34
  35 =over
  36
  37 =item start
  38
  39 Starting point for the search.  Defaults to ".".
  40
  41 =item recurse
  42
  43 Flag to say whether it should recurse.  Default to true.
  44
  45 =back
  46
  47 =cut
  48
  49 sub 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
  87 Returns a shuffled copy of I<@list>.
  88
  89 =cut
  90
  91 sub 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
 103 Finds all the blib directories.  Stolen directly from blib.pm
 104
 105 =cut
 106
 107 sub 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
 133 1;