[Summary view] [Print] [Text view]

   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;