home *** CD-ROM | disk | FTP | other *** search
/ Mac Easy 2010 May / Mac Life Ubuntu.iso / casper / filesystem.squashfs / usr / share / perl / 5.10.0 / Test / Harness / Util.pm < prev   
Encoding:
Perl POD Document  |  2009-06-26  |  2.7 KB  |  134 lines

  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;
  134.