]>
Commit | Line | Data |
---|---|---|
d8f41ccd A |
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; |