ext/Compress/Zlib/t/globmapper.t

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