1BEGIN {
2    if ($ENV{PERL_CORE}) {
3	chdir 't' if -d 't';
4	@INC = ("../lib", "lib/compress");
5    }
6}
7
8use lib qw(t t/compress);
9use strict ;
10use warnings ;
11
12use Test::More ;
13use CompTestUtils;
14
15
16BEGIN
17{
18    plan(skip_all => "File::GlobMapper needs Perl 5.005 or better - you have
19Perl $]" )
20        if $] < 5.005 ;
21
22    # use Test::NoWarnings, if available
23    my $extra = 0 ;
24    $extra = 1
25        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
26
27    plan tests => 68 + $extra ;
28
29    use_ok('File::GlobMapper') ;
30}
31
32{
33    title "Error Cases" ;
34
35    my $gm;
36
37    for my $delim ( qw/ ( ) { } [ ] / )
38    {
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";
43    }
44
45    for my $delim ( qw/ ( ) [ ] / )
46    {
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 {}";
51    }
52
53
54}
55
56{
57    title "input glob matches zero files";
58
59    my $tmpDir = 'td';
60    my $lex = new LexDir $tmpDir;
61
62    my $gm = new File::GlobMapper("$tmpDir/Z*", '*.X');
63    ok $gm, "  created GlobMapper object" ;
64
65    my $map = $gm->getFileMap() ;
66    is @{ $map }, 0, "  returned 0 maps";
67    is_deeply $map, [], " zero maps" ;
68
69    my $hash = $gm->getHash() ;
70    is_deeply $hash, {}, "  zero maps" ;
71}
72
73{
74    title 'test wildcard mapping of * in destination';
75
76    my $tmpDir = 'td';
77    my $lex = new LexDir $tmpDir;
78    mkdir $tmpDir, 0777 ;
79
80    touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
81
82    my $gm = new File::GlobMapper("$tmpDir/ab*.tmp", "*X");
83    ok $gm, "  created GlobMapper object" ;
84
85    my $map = $gm->getFileMap() ;
86    is @{ $map }, 3, "  returned 3 maps";
87    is_deeply $map,
88        [ [map { "$tmpDir/$_" } qw(abc1.tmp abc1.tmpX)],
89          [map { "$tmpDir/$_" } qw(abc2.tmp abc2.tmpX)],
90          [map { "$tmpDir/$_" } qw(abc3.tmp abc3.tmpX)],
91        ], "  got mapping";
92
93    my $hash = $gm->getHash() ;
94    is_deeply $hash,
95        { map { "$tmpDir/$_" } qw(abc1.tmp abc1.tmpX
96                                  abc2.tmp abc2.tmpX
97                                  abc3.tmp abc3.tmpX),
98        }, "  got mapping";
99}
100
101{
102    title 'no wildcards in input or destination';
103
104    my $tmpDir = 'td';
105    my $lex = new LexDir $tmpDir;
106    mkdir $tmpDir, 0777 ;
107
108    touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
109
110    my $gm = new File::GlobMapper("$tmpDir/abc2.tmp", "$tmpDir/abc2.tmp");
111    ok $gm, "  created GlobMapper object" ;
112
113    my $map = $gm->getFileMap() ;
114    is @{ $map }, 1, "  returned 1 maps";
115    is_deeply $map,
116        [ [map { "$tmpDir/$_.tmp" } qw(abc2 abc2)],
117        ], "  got mapping";
118
119    my $hash = $gm->getHash() ;
120    is_deeply $hash,
121        { map { "$tmpDir/$_.tmp" } qw(abc2 abc2),
122        }, "  got mapping";
123}
124
125{
126    title 'test wildcard mapping of {} in destination';
127
128    my $tmpDir = 'td';
129    my $lex = new LexDir $tmpDir;
130    mkdir $tmpDir, 0777 ;
131
132    touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
133
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" ;
137
138    my $map = $gm->getFileMap() ;
139    is @{ $map }, 2, "  returned 2 maps";
140    is_deeply $map,
141        [ [map { "$tmpDir/$_" } qw(abc1.tmp abc1.tmp.X)],
142          [map { "$tmpDir/$_" } qw(abc3.tmp abc3.tmp.X)],
143        ], "  got mapping";
144
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" ;
149
150    $map = $gm->getFileMap() ;
151    is @{ $map }, 2, "  returned 2 maps";
152    is_deeply $map,
153        [ [map { "$tmpDir/$_" } qw(abc1.tmp X.1.X)],
154          [map { "$tmpDir/$_" } qw(abc3.tmp X.3.X)],
155        ], "  got mapping";
156
157}
158
159
160{
161    title 'test wildcard mapping of multiple * to #';
162
163    my $tmpDir = 'td';
164    my $lex = new LexDir $tmpDir;
165    mkdir $tmpDir, 0777 ;
166
167    touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
168
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 ;
172
173    my $map = $gm->getFileMap() ;
174    is @{ $map }, 3, "  returned 3 maps";
175    is_deeply $map,
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)],
179        ], "  got mapping";
180}
181
182{
183    title 'test wildcard mapping of multiple ? to #';
184
185    my $tmpDir = 'td';
186    my $lex = new LexDir $tmpDir;
187    mkdir $tmpDir, 0777 ;
188
189    touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
190
191    my $gm = new File::GlobMapper("$tmpDir/?b(*).tmp", "$tmpDir/X-#2-#1-X");
192    ok $gm, "  created GlobMapper object" ;
193
194    my $map = $gm->getFileMap() ;
195    is @{ $map }, 3, "  returned 3 maps";
196    is_deeply $map,
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)],
200        ], "  got mapping";
201}
202
203{
204    title 'test wildcard mapping of multiple ?,* and [] to #';
205
206    my $tmpDir = 'td';
207    my $lex = new LexDir $tmpDir;
208    mkdir $tmpDir, 0777 ;
209
210    touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
211
212    my $gm = new File::GlobMapper("./$tmpDir/?b[a-z]*.tmp", "./$tmpDir/X-#3-#2-#1-X");
213    ok $gm, "  created GlobMapper object" ;
214
215    #diag "Input pattern is $gm->{InputPattern}";
216    my $map = $gm->getFileMap() ;
217    is @{ $map }, 3, "  returned 3 maps";
218    is_deeply $map,
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)],
222        ], "  got mapping";
223}
224
225{
226    title 'input glob matches a file multiple times';
227
228    my $tmpDir = 'td';
229    my $lex = new LexDir $tmpDir;
230    mkdir $tmpDir, 0777 ;
231
232    touch "$tmpDir/abc.tmp";
233
234    my $gm = new File::GlobMapper("$tmpDir/{a*,*c}.tmp", '*.X');
235    ok $gm, "  created GlobMapper object" ;
236
237    my $map = $gm->getFileMap() ;
238    is @{ $map }, 1, "  returned 1 maps";
239    is_deeply $map,
240        [ [map { "$tmpDir/$_" } qw(abc.tmp abc.tmp.X)], ], "  got mapping";
241
242    my $hash = $gm->getHash() ;
243    is_deeply $hash,
244        { map { "$tmpDir/$_" } qw(abc.tmp abc.tmp.X) }, "  got mapping";
245
246}
247
248{
249    title 'multiple input files map to one output file';
250
251    my $tmpDir = 'td';
252    my $lex = new LexDir $tmpDir;
253    mkdir $tmpDir, 0777 ;
254
255    touch map { "$tmpDir/$_.tmp" } qw( abc def) ;
256
257    my $gm = new File::GlobMapper("$tmpDir/*.tmp", "$tmpDir/fred");
258    ok ! $gm, "  did not create GlobMapper object" ;
259
260    is $File::GlobMapper::Error, 'multiple input files map to one output file', "  Error is expected" ;
261
262    #my $map = $gm->getFileMap() ;
263    #is @{ $map }, 1, "  returned 1 maps";
264    #is_deeply $map,
265    #[ [map { "$tmpDir/$_" } qw(abc1 abc.X)], ], "  got mapping";
266}
267
268{
269    title "globmap" ;
270
271    my $tmpDir = 'td';
272    my $lex = new LexDir $tmpDir;
273    mkdir $tmpDir, 0777 ;
274
275    touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
276
277    my $map = File::GlobMapper::globmap("$tmpDir/*b*.tmp", "$tmpDir/X-#2-#1-X");
278    ok $map, "  got map"
279        or diag $File::GlobMapper::Error ;
280
281    is @{ $map }, 3, "  returned 3 maps";
282    is_deeply $map,
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)],
286        ], "  got mapping";
287}
288
289# TODO
290# test each of the wildcard metacharacters can be mapped to the output filename
291#
292#   ~ [] {} . *
293
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
302# {ab*,de*}
303# {abc,{},{de,f}} => abc {} de f
304
305