home *** CD-ROM | disk | FTP | other *** search
- package Test::Harness::Util;
-
- use strict;
- use vars qw($VERSION);
- $VERSION = '0.01';
-
- use File::Spec;
- use Exporter;
- use vars qw( @ISA @EXPORT @EXPORT_OK );
-
- @ISA = qw( Exporter );
- @EXPORT = ();
- @EXPORT_OK = qw( all_in shuffle blibdirs );
-
- =head1 NAME
-
- Test::Harness::Util - Utility functions for Test::Harness::*
-
- =head1 SYNOPSIS
-
- Utility functions for Test::Harness::*
-
- =head1 PUBLIC FUNCTIONS
-
- The following are all available to be imported to your module. No symbols
- are exported by default.
-
- =head2 all_in( {parm => value, parm => value} )
-
- Finds all the F<*.t> in a directory. Knows to skip F<.svn> and F<CVS>
- directories.
-
- Valid parms are:
-
- =over
-
- =item start
-
- Starting point for the search. Defaults to ".".
-
- =item recurse
-
- Flag to say whether it should recurse. Default to true.
-
- =back
-
- =cut
-
- sub all_in {
- my $parms = shift;
- my %parms = (
- start => ".",
- recurse => 1,
- %$parms,
- );
-
- my @hits = ();
- my $start = $parms{start};
-
- local *DH;
- if ( opendir( DH, $start ) ) {
- my @files = sort readdir DH;
- closedir DH;
- for my $file ( @files ) {
- next if $file eq File::Spec->updir || $file eq File::Spec->curdir;
- next if $file eq ".svn";
- next if $file eq "CVS";
-
- my $currfile = File::Spec->catfile( $start, $file );
- if ( -d $currfile ) {
- push( @hits, all_in( { %parms, start => $currfile } ) ) if $parms{recurse};
- }
- else {
- push( @hits, $currfile ) if $currfile =~ /\.t$/;
- }
- }
- }
- else {
- warn "$start: $!\n";
- }
-
- return @hits;
- }
-
- =head1 shuffle( @list )
-
- Returns a shuffled copy of I<@list>.
-
- =cut
-
- sub shuffle {
- # Fisher-Yates shuffle
- my $i = @_;
- while ($i) {
- my $j = rand $i--;
- @_[$i, $j] = @_[$j, $i];
- }
- }
-
-
- =head2 blibdir()
-
- Finds all the blib directories. Stolen directly from blib.pm
-
- =cut
-
- sub blibdirs {
- my $dir = File::Spec->curdir;
- if ($^O eq 'VMS') {
- ($dir = VMS::Filespec::unixify($dir)) =~ s-/\z--;
- }
- my $archdir = "arch";
- if ( $^O eq "MacOS" ) {
- # Double up the MP::A so that it's not used only once.
- $archdir = $MacPerl::Architecture = $MacPerl::Architecture;
- }
-
- my $i = 5;
- while ($i--) {
- my $blib = File::Spec->catdir( $dir, "blib" );
- my $blib_lib = File::Spec->catdir( $blib, "lib" );
- my $blib_arch = File::Spec->catdir( $blib, $archdir );
-
- if ( -d $blib && -d $blib_arch && -d $blib_lib ) {
- return ($blib_arch,$blib_lib);
- }
- $dir = File::Spec->catdir($dir, File::Spec->updir);
- }
- warn "$0: Cannot find blib\n";
- return;
- }
-
- 1;
-