Silence ill-behaved Test::Harness test on VMS.

[p5sagit/p5-mst-13.2.git] / lib / Test / Harness / Util.pm

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;