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 $tmpDir ;
61    my $lex = new LexDir $tmpDir;
62    my $d = quotemeta $tmpDir;
63
64    my $gm = new File::GlobMapper("$d/Z*", '*.X');
65    ok $gm, "  created GlobMapper object" ;
66
67    my $map = $gm->getFileMap() ;
68    is @{ $map }, 0, "  returned 0 maps";
69    is_deeply $map, [], " zero maps" ;
70
71    my $hash = $gm->getHash() ;
72    is_deeply $hash, {}, "  zero maps" ;
73}
74
75{
76    title 'test wildcard mapping of * in destination';
77
78    #my $tmpDir = 'td';
79    my $tmpDir ;
80    my $lex = new LexDir $tmpDir;
81    #mkdir $tmpDir, 0777 ;
82
83    touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
84
85    my $gm = new File::GlobMapper("$tmpDir/ab*.tmp", "*X");
86    ok $gm, "  created GlobMapper object" ;
87
88    my $map = $gm->getFileMap() ;
89    is @{ $map }, 3, "  returned 3 maps";
90    is_deeply $map,
91        [ [map { "$tmpDir/$_" } qw(abc1.tmp abc1.tmpX)],
92          [map { "$tmpDir/$_" } qw(abc2.tmp abc2.tmpX)],
93          [map { "$tmpDir/$_" } qw(abc3.tmp abc3.tmpX)],
94        ], "  got mapping";
95
96    my $hash = $gm->getHash() ;
97    is_deeply $hash,
98        { map { "$tmpDir/$_" } qw(abc1.tmp abc1.tmpX
99                                  abc2.tmp abc2.tmpX
100                                  abc3.tmp abc3.tmpX),
101        }, "  got mapping";
102}
103
104{
105    title 'no wildcards in input or destination';
106
107    #my $tmpDir = 'td';
108    my $tmpDir ;
109    my $lex = new LexDir $tmpDir;
110    #mkdir $tmpDir, 0777 ;
111
112    touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
113
114    my $gm = new File::GlobMapper("$tmpDir/abc2.tmp", "$tmpDir/abc2.tmp");
115    ok $gm, "  created GlobMapper object" ;
116
117    my $map = $gm->getFileMap() ;
118    is @{ $map }, 1, "  returned 1 maps";
119    is_deeply $map,
120        [ [map { "$tmpDir/$_.tmp" } qw(abc2 abc2)],
121        ], "  got mapping";
122
123    my $hash = $gm->getHash() ;
124    is_deeply $hash,
125        { map { "$tmpDir/$_.tmp" } qw(abc2 abc2),
126        }, "  got mapping";
127}
128
129{
130    title 'test wildcard mapping of {} in destination';
131
132    my $tmpDir ;#= 'td';
133    my $lex = new LexDir $tmpDir;
134    #mkdir $tmpDir, 0777 ;
135
136    touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
137
138    my $gm = new File::GlobMapper("$tmpDir/abc{1,3}.tmp", "*.X");
139    #diag "Input pattern is $gm->{InputPattern}";
140    ok $gm, "  created GlobMapper object" ;
141
142    my $map = $gm->getFileMap() ;
143    is @{ $map }, 2, "  returned 2 maps";
144    is_deeply $map,
145        [ [map { "$tmpDir/$_" } qw(abc1.tmp abc1.tmp.X)],
146          [map { "$tmpDir/$_" } qw(abc3.tmp abc3.tmp.X)],
147        ], "  got mapping";
148
149    $gm = new File::GlobMapper("$tmpDir/abc{1,3}.tmp", "$tmpDir/X.#1.X")
150        or diag $File::GlobMapper::Error ;
151    #diag "Input pattern is $gm->{InputPattern}";
152    ok $gm, "  created GlobMapper object" ;
153
154    $map = $gm->getFileMap() ;
155    is @{ $map }, 2, "  returned 2 maps";
156    is_deeply $map,
157        [ [map { "$tmpDir/$_" } qw(abc1.tmp X.1.X)],
158          [map { "$tmpDir/$_" } qw(abc3.tmp X.3.X)],
159        ], "  got mapping";
160
161}
162
163
164{
165    title 'test wildcard mapping of multiple * to #';
166
167    my $tmpDir ;#= 'td';
168    my $lex = new LexDir $tmpDir;
169    #mkdir $tmpDir, 0777 ;
170
171    touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
172
173    my $gm = new File::GlobMapper("$tmpDir/*b(*).tmp", "$tmpDir/X-#2-#1-X");
174    ok $gm, "  created GlobMapper object"
175        or diag $File::GlobMapper::Error ;
176
177    my $map = $gm->getFileMap() ;
178    is @{ $map }, 3, "  returned 3 maps";
179    is_deeply $map,
180        [ [map { "$tmpDir/$_" } qw(abc1.tmp X-c1-a-X)],
181          [map { "$tmpDir/$_" } qw(abc2.tmp X-c2-a-X)],
182          [map { "$tmpDir/$_" } qw(abc3.tmp X-c3-a-X)],
183        ], "  got mapping";
184}
185
186{
187    title 'test wildcard mapping of multiple ? to #';
188
189    my $tmpDir ;#= 'td';
190    my $lex = new LexDir $tmpDir;
191    #mkdir $tmpDir, 0777 ;
192
193    touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
194
195    my $gm = new File::GlobMapper("$tmpDir/?b(*).tmp", "$tmpDir/X-#2-#1-X");
196    ok $gm, "  created GlobMapper object" ;
197
198    my $map = $gm->getFileMap() ;
199    is @{ $map }, 3, "  returned 3 maps";
200    is_deeply $map,
201        [ [map { "$tmpDir/$_" } qw(abc1.tmp X-c1-a-X)],
202          [map { "$tmpDir/$_" } qw(abc2.tmp X-c2-a-X)],
203          [map { "$tmpDir/$_" } qw(abc3.tmp X-c3-a-X)],
204        ], "  got mapping";
205}
206
207{
208    title 'test wildcard mapping of multiple ?,* and [] to #';
209
210    my $tmpDir ;#= 'td';
211    my $lex = new LexDir $tmpDir;
212    #mkdir $tmpDir, 0777 ;
213
214    touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
215
216    my $gm = new File::GlobMapper("$tmpDir/?b[a-z]*.tmp", "$tmpDir/X-#3-#2-#1-X");
217    ok $gm, "  created GlobMapper object" ;
218
219    #diag "Input pattern is $gm->{InputPattern}";
220    my $map = $gm->getFileMap() ;
221    is @{ $map }, 3, "  returned 3 maps";
222    is_deeply $map,
223        [ [map { "$tmpDir/$_" } qw(abc1.tmp X-1-c-a-X)],
224          [map { "$tmpDir/$_" } qw(abc2.tmp X-2-c-a-X)],
225          [map { "$tmpDir/$_" } qw(abc3.tmp X-3-c-a-X)],
226        ], "  got mapping";
227}
228
229{
230    title 'input glob matches a file multiple times';
231
232    my $tmpDir ;#= 'td';
233    my $lex = new LexDir $tmpDir;
234    #mkdir $tmpDir, 0777 ;
235
236    touch "$tmpDir/abc.tmp";
237
238    my $gm = new File::GlobMapper("$tmpDir/{a*,*c}.tmp", '*.X');
239    ok $gm, "  created GlobMapper object" ;
240
241    my $map = $gm->getFileMap() ;
242    is @{ $map }, 1, "  returned 1 maps";
243    is_deeply $map,
244        [ [map { "$tmpDir/$_" } qw(abc.tmp abc.tmp.X)], ], "  got mapping";
245
246    my $hash = $gm->getHash() ;
247    is_deeply $hash,
248        { map { "$tmpDir/$_" } qw(abc.tmp abc.tmp.X) }, "  got mapping";
249
250}
251
252{
253    title 'multiple input files map to one output file';
254
255    my $tmpDir ;#= 'td';
256    my $lex = new LexDir $tmpDir;
257    #mkdir $tmpDir, 0777 ;
258
259    touch map { "$tmpDir/$_.tmp" } qw( abc def) ;
260
261    my $gm = new File::GlobMapper("$tmpDir/*.tmp", "$tmpDir/fred");
262    ok ! $gm, "  did not create GlobMapper object" ;
263
264    is $File::GlobMapper::Error, 'multiple input files map to one output file', "  Error is expected" ;
265
266    #my $map = $gm->getFileMap() ;
267    #is @{ $map }, 1, "  returned 1 maps";
268    #is_deeply $map,
269    #[ [map { "$tmpDir/$_" } qw(abc1 abc.X)], ], "  got mapping";
270}
271
272{
273    title "globmap" ;
274
275    my $tmpDir ;#= 'td';
276    my $lex = new LexDir $tmpDir;
277    #mkdir $tmpDir, 0777 ;
278
279    touch map { "$tmpDir/$_.tmp" } qw( abc1 abc2 abc3 ) ;
280
281    my $map = File::GlobMapper::globmap("$tmpDir/*b*.tmp", "$tmpDir/X-#2-#1-X");
282    ok $map, "  got map"
283        or diag $File::GlobMapper::Error ;
284
285    is @{ $map }, 3, "  returned 3 maps";
286    is_deeply $map,
287        [ [map { "$tmpDir/$_" } qw(abc1.tmp X-c1-a-X)],
288          [map { "$tmpDir/$_" } qw(abc2.tmp X-c2-a-X)],
289          [map { "$tmpDir/$_" } qw(abc3.tmp X-c3-a-X)],
290        ], "  got mapping";
291}
292
293# TODO
294# test each of the wildcard metacharacters can be mapped to the output filename
295#
296#   ~ [] {} . *
297
298# input & output glob with no wildcards is ok
299# input with no wild or output with no wild is bad
300# input wild has concatenated *'s
301# empty string for either both from & to
302# escaped chars within [] and {}, including the chars []{}
303# escaped , within {}
304# missing ] and missing }
305# {} and {,} are special cases
306# {ab*,de*}
307# {abc,{},{de,f}} => abc {} de f
308
309