4 @INC = ("../lib", "lib/compress");
18 plan(skip_all => "File::GlobMapper needs Perl 5.005 or better - you have
22 # use Test::NoWarnings, if available
25 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
27 plan tests => 68 + $extra ;
29 use_ok('File::GlobMapper') ;
37 for my $delim ( qw/ ( ) { } [ ] / )
39 $gm = new File::GlobMapper("${delim}abc", '*.X');
40 ok ! $gm, " new failed" ;
41 is $File::GlobMapper::Error, "Unmatched $delim in input fileglob",
42 " catch unmatched $delim";
45 for my $delim ( qw/ ( ) [ ] / )
47 $gm = new File::GlobMapper("{${delim}abc}", '*.X');
48 ok ! $gm, " new failed" ;
49 is $File::GlobMapper::Error, "Unmatched $delim in input fileglob",
50 " catch unmatched $delim inside {}";
57 title "input glob matches zero files";
60 my $lex = new LexDir $tmpDir;
62 my $gm = new File::GlobMapper("$tmpDir/Z*", '*.X');
63 ok $gm, " created GlobMapper object" ;
65 my $map = $gm->getFileMap() ;
66 is @{ $map }, 0, " returned 0 maps";
67 is_deeply $map, [], " zero maps" ;
69 my $hash = $gm->getHash() ;
70 is_deeply $hash, {}, " zero maps" ;
74 title 'test wildcard mapping of * in destination';
77 my $lex = new LexDir $tmpDir;
80 touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
82 my $gm = new File::GlobMapper("$tmpDir/ab*.tmp", "*X");
83 ok $gm, " created GlobMapper object" ;
85 my $map = $gm->getFileMap() ;
86 is @{ $map }, 3, " returned 3 maps";
88 [ [map { "$tmpDir/$_" } qw(abc1.tmp abc1.tmpX)],
89 [map { "$tmpDir/$_" } qw(abc2.tmp abc2.tmpX)],
90 [map { "$tmpDir/$_" } qw(abc3.tmp abc3.tmpX)],
93 my $hash = $gm->getHash() ;
95 { map { "$tmpDir/$_" } qw(abc1.tmp abc1.tmpX
102 title 'no wildcards in input or destination';
105 my $lex = new LexDir $tmpDir;
106 mkdir $tmpDir, 0777 ;
108 touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
110 my $gm = new File::GlobMapper("$tmpDir/abc2.tmp", "$tmpDir/abc2.tmp");
111 ok $gm, " created GlobMapper object" ;
113 my $map = $gm->getFileMap() ;
114 is @{ $map }, 1, " returned 1 maps";
116 [ [map { "$tmpDir/$_.tmp" } qw(abc2 abc2)],
119 my $hash = $gm->getHash() ;
121 { map { "$tmpDir/$_.tmp" } qw(abc2 abc2),
126 title 'test wildcard mapping of {} in destination';
129 my $lex = new LexDir $tmpDir;
130 mkdir $tmpDir, 0777 ;
132 touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
134 my $gm = new File::GlobMapper("$tmpDir/abc{1,3}.tmp", "*.X");
135 #diag "Input pattern is $gm->{InputPattern}";
136 ok $gm, " created GlobMapper object" ;
138 my $map = $gm->getFileMap() ;
139 is @{ $map }, 2, " returned 2 maps";
141 [ [map { "$tmpDir/$_" } qw(abc1.tmp abc1.tmp.X)],
142 [map { "$tmpDir/$_" } qw(abc3.tmp abc3.tmp.X)],
145 $gm = new File::GlobMapper("$tmpDir/abc{1,3}.tmp", "$tmpDir/X.#1.X")
146 or diag $File::GlobMapper::Error ;
147 #diag "Input pattern is $gm->{InputPattern}";
148 ok $gm, " created GlobMapper object" ;
150 $map = $gm->getFileMap() ;
151 is @{ $map }, 2, " returned 2 maps";
153 [ [map { "$tmpDir/$_" } qw(abc1.tmp X.1.X)],
154 [map { "$tmpDir/$_" } qw(abc3.tmp X.3.X)],
161 title 'test wildcard mapping of multiple * to #';
164 my $lex = new LexDir $tmpDir;
165 mkdir $tmpDir, 0777 ;
167 touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
169 my $gm = new File::GlobMapper("$tmpDir/*b(*).tmp", "$tmpDir/X-#2-#1-X");
170 ok $gm, " created GlobMapper object"
171 or diag $File::GlobMapper::Error ;
173 my $map = $gm->getFileMap() ;
174 is @{ $map }, 3, " returned 3 maps";
176 [ [map { "$tmpDir/$_" } qw(abc1.tmp X-c1-a-X)],
177 [map { "$tmpDir/$_" } qw(abc2.tmp X-c2-a-X)],
178 [map { "$tmpDir/$_" } qw(abc3.tmp X-c3-a-X)],
183 title 'test wildcard mapping of multiple ? to #';
186 my $lex = new LexDir $tmpDir;
187 mkdir $tmpDir, 0777 ;
189 touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
191 my $gm = new File::GlobMapper("$tmpDir/?b(*).tmp", "$tmpDir/X-#2-#1-X");
192 ok $gm, " created GlobMapper object" ;
194 my $map = $gm->getFileMap() ;
195 is @{ $map }, 3, " returned 3 maps";
197 [ [map { "$tmpDir/$_" } qw(abc1.tmp X-c1-a-X)],
198 [map { "$tmpDir/$_" } qw(abc2.tmp X-c2-a-X)],
199 [map { "$tmpDir/$_" } qw(abc3.tmp X-c3-a-X)],
204 title 'test wildcard mapping of multiple ?,* and [] to #';
207 my $lex = new LexDir $tmpDir;
208 mkdir $tmpDir, 0777 ;
210 touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
212 my $gm = new File::GlobMapper("./$tmpDir/?b[a-z]*.tmp", "./$tmpDir/X-#3-#2-#1-X");
213 ok $gm, " created GlobMapper object" ;
215 #diag "Input pattern is $gm->{InputPattern}";
216 my $map = $gm->getFileMap() ;
217 is @{ $map }, 3, " returned 3 maps";
219 [ [map { "./$tmpDir/$_" } qw(abc1.tmp X-1-c-a-X)],
220 [map { "./$tmpDir/$_" } qw(abc2.tmp X-2-c-a-X)],
221 [map { "./$tmpDir/$_" } qw(abc3.tmp X-3-c-a-X)],
226 title 'input glob matches a file multiple times';
229 my $lex = new LexDir $tmpDir;
230 mkdir $tmpDir, 0777 ;
232 touch "$tmpDir/abc.tmp";
234 my $gm = new File::GlobMapper("$tmpDir/{a*,*c}.tmp", '*.X');
235 ok $gm, " created GlobMapper object" ;
237 my $map = $gm->getFileMap() ;
238 is @{ $map }, 1, " returned 1 maps";
240 [ [map { "$tmpDir/$_" } qw(abc.tmp abc.tmp.X)], ], " got mapping";
242 my $hash = $gm->getHash() ;
244 { map { "$tmpDir/$_" } qw(abc.tmp abc.tmp.X) }, " got mapping";
249 title 'multiple input files map to one output file';
252 my $lex = new LexDir $tmpDir;
253 mkdir $tmpDir, 0777 ;
255 touch map { "$tmpDir/$_.tmp" } qw( abc def) ;
257 my $gm = new File::GlobMapper("$tmpDir/*.tmp", "$tmpDir/fred");
258 ok ! $gm, " did not create GlobMapper object" ;
260 is $File::GlobMapper::Error, 'multiple input files map to one output file', " Error is expected" ;
262 #my $map = $gm->getFileMap() ;
263 #is @{ $map }, 1, " returned 1 maps";
265 #[ [map { "$tmpDir/$_" } qw(abc1 abc.X)], ], " got mapping";
272 my $lex = new LexDir $tmpDir;
273 mkdir $tmpDir, 0777 ;
275 touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
277 my $map = File::GlobMapper::globmap("$tmpDir/*b*.tmp", "$tmpDir/X-#2-#1-X");
279 or diag $File::GlobMapper::Error ;
281 is @{ $map }, 3, " returned 3 maps";
283 [ [map { "$tmpDir/$_" } qw(abc1.tmp X-c1-a-X)],
284 [map { "$tmpDir/$_" } qw(abc2.tmp X-c2-a-X)],
285 [map { "$tmpDir/$_" } qw(abc3.tmp X-c3-a-X)],
290 # test each of the wildcard metacharacters can be mapped to the output filename
294 # input & output glob with no wildcards is ok
295 # input with no wild or output with no wild is bad
296 # input wild has concatenated *'s
297 # empty string for either both from & to
298 # escaped chars within [] and {}, including the chars []{}
299 # escaped , within {}
300 # missing ] and missing }
301 # {} and {,} are special cases
303 # {abc,{},{de,f}} => abc {} de f