File | /usr/local/lib/perl5/5.10.1/darwin-2level/File/GlobMapper.pm |
Statements Executed | 30 |
Statement Execution Time | 1.49ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 1.07ms | 1.88ms | BEGIN@10 | File::GlobMapper::
1 | 1 | 1 | 15µs | 18µs | BEGIN@3 | File::GlobMapper::
1 | 1 | 1 | 11µs | 31µs | BEGIN@341 | File::GlobMapper::
1 | 1 | 1 | 7µs | 44µs | BEGIN@5 | File::GlobMapper::
1 | 1 | 1 | 7µs | 15µs | BEGIN@4 | File::GlobMapper::
0 | 0 | 0 | 0s | 0s | _getFiles | File::GlobMapper::
0 | 0 | 0 | 0s | 0s | _parseBit | File::GlobMapper::
0 | 0 | 0 | 0s | 0s | _parseInputGlob | File::GlobMapper::
0 | 0 | 0 | 0s | 0s | _parseOutputGlob | File::GlobMapper::
0 | 0 | 0 | 0s | 0s | _retError | File::GlobMapper::
0 | 0 | 0 | 0s | 0s | _unmatched | File::GlobMapper::
0 | 0 | 0 | 0s | 0s | getFileMap | File::GlobMapper::
0 | 0 | 0 | 0s | 0s | getHash | File::GlobMapper::
0 | 0 | 0 | 0s | 0s | globmap | File::GlobMapper::
0 | 0 | 0 | 0s | 0s | new | File::GlobMapper::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package File::GlobMapper; | ||||
2 | |||||
3 | 3 | 25µs | 2 | 21µs | # spent 18µs (15+3) within File::GlobMapper::BEGIN@3 which was called
# once (15µs+3µs) by IO::Compress::Base::Common::BEGIN@9 at line 3 # spent 18µs making 1 call to File::GlobMapper::BEGIN@3
# spent 3µs making 1 call to strict::import |
4 | 3 | 18µs | 2 | 24µs | # spent 15µs (7+9) within File::GlobMapper::BEGIN@4 which was called
# once (7µs+9µs) by IO::Compress::Base::Common::BEGIN@9 at line 4 # spent 15µs making 1 call to File::GlobMapper::BEGIN@4
# spent 9µs making 1 call to warnings::import |
5 | 3 | 93µs | 2 | 81µs | # spent 44µs (7+37) within File::GlobMapper::BEGIN@5 which was called
# once (7µs+37µs) by IO::Compress::Base::Common::BEGIN@9 at line 5 # spent 44µs making 1 call to File::GlobMapper::BEGIN@5
# spent 37µs making 1 call to Exporter::import |
6 | |||||
7 | 1 | 100ns | our ($CSH_GLOB); | ||
8 | |||||
9 | BEGIN | ||||
10 | # spent 1.88ms (1.07+815µs) within File::GlobMapper::BEGIN@10 which was called
# once (1.07ms+815µs) by IO::Compress::Base::Common::BEGIN@9 at line 24 | ||||
11 | 1 | 4µs | if ($] < 5.006) | ||
12 | { | ||||
13 | require File::BSDGlob; import File::BSDGlob qw(:glob) ; | ||||
14 | $CSH_GLOB = File::BSDGlob::GLOB_CSH() ; | ||||
15 | *globber = \&File::BSDGlob::csh_glob; | ||||
16 | } | ||||
17 | else | ||||
18 | { | ||||
19 | 2 | 77µs | 1 | 10µs | require File::Glob; import File::Glob qw(:glob) ; # spent 10µs making 1 call to File::Glob::import |
20 | 1 | 2µs | 1 | 15µs | $CSH_GLOB = File::Glob::GLOB_CSH() ; # spent 15µs making 1 call to File::Glob::GLOB_CSH |
21 | #*globber = \&File::Glob::bsd_glob; | ||||
22 | 1 | 2µs | *globber = \&File::Glob::csh_glob; | ||
23 | } | ||||
24 | 1 | 1.07ms | 1 | 1.88ms | } # spent 1.88ms making 1 call to File::GlobMapper::BEGIN@10 |
25 | |||||
26 | 1 | 0s | our ($Error); | ||
27 | |||||
28 | 1 | 400ns | our ($VERSION, @EXPORT_OK); | ||
29 | 1 | 600ns | $VERSION = '1.000'; | ||
30 | 1 | 700ns | @EXPORT_OK = qw( globmap ); | ||
31 | |||||
32 | |||||
33 | 1 | 200ns | our ($noPreBS, $metachars, $matchMetaRE, %mapping, %wildCount); | ||
34 | 1 | 200ns | $noPreBS = '(?<!\\\)' ; # no preceeding backslash | ||
35 | 1 | 100ns | $metachars = '.*?[](){}'; | ||
36 | 1 | 2µs | $matchMetaRE = '[' . quotemeta($metachars) . ']'; | ||
37 | |||||
38 | 1 | 4µs | %mapping = ( | ||
39 | '*' => '([^/]*)', | ||||
40 | '?' => '([^/])', | ||||
41 | '.' => '\.', | ||||
42 | '[' => '([', | ||||
43 | '(' => '(', | ||||
44 | ')' => ')', | ||||
45 | ); | ||||
46 | |||||
47 | 1 | 7µs | %wildCount = map { $_ => 1 } qw/ * ? . { ( [ /; | ||
48 | |||||
49 | sub globmap ($$;) | ||||
50 | { | ||||
51 | my $inputGlob = shift ; | ||||
52 | my $outputGlob = shift ; | ||||
53 | |||||
54 | my $obj = new File::GlobMapper($inputGlob, $outputGlob, @_) | ||||
55 | or croak "globmap: $Error" ; | ||||
56 | return $obj->getFileMap(); | ||||
57 | } | ||||
58 | |||||
59 | sub new | ||||
60 | { | ||||
61 | my $class = shift ; | ||||
62 | my $inputGlob = shift ; | ||||
63 | my $outputGlob = shift ; | ||||
64 | # TODO -- flags needs to default to whatever File::Glob does | ||||
65 | my $flags = shift || $CSH_GLOB ; | ||||
66 | #my $flags = shift ; | ||||
67 | |||||
68 | $inputGlob =~ s/^\s*\<\s*//; | ||||
69 | $inputGlob =~ s/\s*\>\s*$//; | ||||
70 | |||||
71 | $outputGlob =~ s/^\s*\<\s*//; | ||||
72 | $outputGlob =~ s/\s*\>\s*$//; | ||||
73 | |||||
74 | my %object = | ||||
75 | ( InputGlob => $inputGlob, | ||||
76 | OutputGlob => $outputGlob, | ||||
77 | GlobFlags => $flags, | ||||
78 | Braces => 0, | ||||
79 | WildCount => 0, | ||||
80 | Pairs => [], | ||||
81 | Sigil => '#', | ||||
82 | ); | ||||
83 | |||||
84 | my $self = bless \%object, ref($class) || $class ; | ||||
85 | |||||
86 | $self->_parseInputGlob() | ||||
87 | or return undef ; | ||||
88 | |||||
89 | $self->_parseOutputGlob() | ||||
90 | or return undef ; | ||||
91 | |||||
92 | my @inputFiles = globber($self->{InputGlob}, $flags) ; | ||||
93 | |||||
94 | if (GLOB_ERROR) | ||||
95 | { | ||||
96 | $Error = $!; | ||||
97 | return undef ; | ||||
98 | } | ||||
99 | |||||
100 | #if (whatever) | ||||
101 | { | ||||
102 | my $missing = grep { ! -e $_ } @inputFiles ; | ||||
103 | |||||
104 | if ($missing) | ||||
105 | { | ||||
106 | $Error = "$missing input files do not exist"; | ||||
107 | return undef ; | ||||
108 | } | ||||
109 | } | ||||
110 | |||||
111 | $self->{InputFiles} = \@inputFiles ; | ||||
112 | |||||
113 | $self->_getFiles() | ||||
114 | or return undef ; | ||||
115 | |||||
116 | return $self; | ||||
117 | } | ||||
118 | |||||
119 | sub _retError | ||||
120 | { | ||||
121 | my $string = shift ; | ||||
122 | $Error = "$string in input fileglob" ; | ||||
123 | return undef ; | ||||
124 | } | ||||
125 | |||||
126 | sub _unmatched | ||||
127 | { | ||||
128 | my $delimeter = shift ; | ||||
129 | |||||
130 | _retError("Unmatched $delimeter"); | ||||
131 | return undef ; | ||||
132 | } | ||||
133 | |||||
134 | sub _parseBit | ||||
135 | { | ||||
136 | my $self = shift ; | ||||
137 | |||||
138 | my $string = shift ; | ||||
139 | |||||
140 | my $out = ''; | ||||
141 | my $depth = 0 ; | ||||
142 | |||||
143 | while ($string =~ s/(.*?)$noPreBS(,|$matchMetaRE)//) | ||||
144 | { | ||||
145 | $out .= quotemeta($1) ; | ||||
146 | $out .= $mapping{$2} if defined $mapping{$2}; | ||||
147 | |||||
148 | ++ $self->{WildCount} if $wildCount{$2} ; | ||||
149 | |||||
150 | if ($2 eq ',') | ||||
151 | { | ||||
152 | return _unmatched "(" | ||||
153 | if $depth ; | ||||
154 | |||||
155 | $out .= '|'; | ||||
156 | } | ||||
157 | elsif ($2 eq '(') | ||||
158 | { | ||||
159 | ++ $depth ; | ||||
160 | } | ||||
161 | elsif ($2 eq ')') | ||||
162 | { | ||||
163 | return _unmatched ")" | ||||
164 | if ! $depth ; | ||||
165 | |||||
166 | -- $depth ; | ||||
167 | } | ||||
168 | elsif ($2 eq '[') | ||||
169 | { | ||||
170 | # TODO -- quotemeta & check no '/' | ||||
171 | # TODO -- check for \] & other \ within the [] | ||||
172 | $string =~ s#(.*?\])## | ||||
173 | or return _unmatched "[" ; | ||||
174 | $out .= "$1)" ; | ||||
175 | } | ||||
176 | elsif ($2 eq ']') | ||||
177 | { | ||||
178 | return _unmatched "]" ; | ||||
179 | } | ||||
180 | elsif ($2 eq '{' || $2 eq '}') | ||||
181 | { | ||||
182 | return _retError "Nested {} not allowed" ; | ||||
183 | } | ||||
184 | } | ||||
185 | |||||
186 | $out .= quotemeta $string; | ||||
187 | |||||
188 | return _unmatched "(" | ||||
189 | if $depth ; | ||||
190 | |||||
191 | return $out ; | ||||
192 | } | ||||
193 | |||||
194 | sub _parseInputGlob | ||||
195 | { | ||||
196 | my $self = shift ; | ||||
197 | |||||
198 | my $string = $self->{InputGlob} ; | ||||
199 | my $inGlob = ''; | ||||
200 | |||||
201 | # Multiple concatenated *'s don't make sense | ||||
202 | #$string =~ s#\*\*+#*# ; | ||||
203 | |||||
204 | # TODO -- Allow space to delimit patterns? | ||||
205 | #my @strings = split /\s+/, $string ; | ||||
206 | #for my $str (@strings) | ||||
207 | my $out = ''; | ||||
208 | my $depth = 0 ; | ||||
209 | |||||
210 | while ($string =~ s/(.*?)$noPreBS($matchMetaRE)//) | ||||
211 | { | ||||
212 | $out .= quotemeta($1) ; | ||||
213 | $out .= $mapping{$2} if defined $mapping{$2}; | ||||
214 | ++ $self->{WildCount} if $wildCount{$2} ; | ||||
215 | |||||
216 | if ($2 eq '(') | ||||
217 | { | ||||
218 | ++ $depth ; | ||||
219 | } | ||||
220 | elsif ($2 eq ')') | ||||
221 | { | ||||
222 | return _unmatched ")" | ||||
223 | if ! $depth ; | ||||
224 | |||||
225 | -- $depth ; | ||||
226 | } | ||||
227 | elsif ($2 eq '[') | ||||
228 | { | ||||
229 | # TODO -- quotemeta & check no '/' or '(' or ')' | ||||
230 | # TODO -- check for \] & other \ within the [] | ||||
231 | $string =~ s#(.*?\])## | ||||
232 | or return _unmatched "["; | ||||
233 | $out .= "$1)" ; | ||||
234 | } | ||||
235 | elsif ($2 eq ']') | ||||
236 | { | ||||
237 | return _unmatched "]" ; | ||||
238 | } | ||||
239 | elsif ($2 eq '}') | ||||
240 | { | ||||
241 | return _unmatched "}" ; | ||||
242 | } | ||||
243 | elsif ($2 eq '{') | ||||
244 | { | ||||
245 | # TODO -- check no '/' within the {} | ||||
246 | # TODO -- check for \} & other \ within the {} | ||||
247 | |||||
248 | my $tmp ; | ||||
249 | unless ( $string =~ s/(.*?)$noPreBS\}//) | ||||
250 | { | ||||
251 | return _unmatched "{"; | ||||
252 | } | ||||
253 | #$string =~ s#(.*?)\}##; | ||||
254 | |||||
255 | #my $alt = join '|', | ||||
256 | # map { quotemeta $_ } | ||||
257 | # split "$noPreBS,", $1 ; | ||||
258 | my $alt = $self->_parseBit($1); | ||||
259 | defined $alt or return 0 ; | ||||
260 | $out .= "($alt)" ; | ||||
261 | |||||
262 | ++ $self->{Braces} ; | ||||
263 | } | ||||
264 | } | ||||
265 | |||||
266 | return _unmatched "(" | ||||
267 | if $depth ; | ||||
268 | |||||
269 | $out .= quotemeta $string ; | ||||
270 | |||||
271 | |||||
272 | $self->{InputGlob} =~ s/$noPreBS[\(\)]//g; | ||||
273 | $self->{InputPattern} = $out ; | ||||
274 | |||||
275 | #print "# INPUT '$self->{InputGlob}' => '$out'\n"; | ||||
276 | |||||
277 | return 1 ; | ||||
278 | |||||
279 | } | ||||
280 | |||||
281 | sub _parseOutputGlob | ||||
282 | { | ||||
283 | my $self = shift ; | ||||
284 | |||||
285 | my $string = $self->{OutputGlob} ; | ||||
286 | my $maxwild = $self->{WildCount}; | ||||
287 | |||||
288 | if ($self->{GlobFlags} & GLOB_TILDE) | ||||
289 | #if (1) | ||||
290 | { | ||||
291 | $string =~ s{ | ||||
292 | ^ ~ # find a leading tilde | ||||
293 | ( # save this in $1 | ||||
294 | [^/] # a non-slash character | ||||
295 | * # repeated 0 or more times (0 means me) | ||||
296 | ) | ||||
297 | }{ | ||||
298 | $1 | ||||
299 | ? (getpwnam($1))[7] | ||||
300 | : ( $ENV{HOME} || $ENV{LOGDIR} ) | ||||
301 | }ex; | ||||
302 | |||||
303 | } | ||||
304 | |||||
305 | # max #1 must be == to max no of '*' in input | ||||
306 | while ( $string =~ m/#(\d)/g ) | ||||
307 | { | ||||
308 | croak "Max wild is #$maxwild, you tried #$1" | ||||
309 | if $1 > $maxwild ; | ||||
310 | } | ||||
311 | |||||
312 | my $noPreBS = '(?<!\\\)' ; # no preceeding backslash | ||||
313 | #warn "noPreBS = '$noPreBS'\n"; | ||||
314 | |||||
315 | #$string =~ s/${noPreBS}\$(\d)/\${$1}/g; | ||||
316 | $string =~ s/${noPreBS}#(\d)/\${$1}/g; | ||||
317 | $string =~ s#${noPreBS}\*#\${inFile}#g; | ||||
318 | $string = '"' . $string . '"'; | ||||
319 | |||||
320 | #print "OUTPUT '$self->{OutputGlob}' => '$string'\n"; | ||||
321 | $self->{OutputPattern} = $string ; | ||||
322 | |||||
323 | return 1 ; | ||||
324 | } | ||||
325 | |||||
326 | sub _getFiles | ||||
327 | { | ||||
328 | my $self = shift ; | ||||
329 | |||||
330 | my %outInMapping = (); | ||||
331 | my %inFiles = () ; | ||||
332 | |||||
333 | foreach my $inFile (@{ $self->{InputFiles} }) | ||||
334 | { | ||||
335 | next if $inFiles{$inFile} ++ ; | ||||
336 | |||||
337 | my $outFile = $inFile ; | ||||
338 | |||||
339 | if ( $inFile =~ m/$self->{InputPattern}/ ) | ||||
340 | { | ||||
341 | 3 | 157µs | 2 | 52µs | # spent 31µs (11+20) within File::GlobMapper::BEGIN@341 which was called
# once (11µs+20µs) by IO::Compress::Base::Common::BEGIN@9 at line 341 # spent 31µs making 1 call to File::GlobMapper::BEGIN@341
# spent 20µs making 1 call to warnings::unimport |
342 | eval "\$outFile = $self->{OutputPattern};" ; | ||||
343 | |||||
344 | if (defined $outInMapping{$outFile}) | ||||
345 | { | ||||
346 | $Error = "multiple input files map to one output file"; | ||||
347 | return undef ; | ||||
348 | } | ||||
349 | $outInMapping{$outFile} = $inFile; | ||||
350 | push @{ $self->{Pairs} }, [$inFile, $outFile]; | ||||
351 | } | ||||
352 | } | ||||
353 | |||||
354 | return 1 ; | ||||
355 | } | ||||
356 | |||||
357 | sub getFileMap | ||||
358 | { | ||||
359 | my $self = shift ; | ||||
360 | |||||
361 | return $self->{Pairs} ; | ||||
362 | } | ||||
363 | |||||
364 | sub getHash | ||||
365 | { | ||||
366 | my $self = shift ; | ||||
367 | |||||
368 | return { map { $_->[0] => $_->[1] } @{ $self->{Pairs} } } ; | ||||
369 | } | ||||
370 | |||||
371 | 1 | 24µs | 1; | ||
372 | |||||
373 | __END__ | ||||
374 | |||||
375 | =head1 NAME | ||||
376 | |||||
377 | File::GlobMapper - Extend File Glob to Allow Input and Output Files | ||||
378 | |||||
379 | =head1 SYNOPSIS | ||||
380 | |||||
381 | use File::GlobMapper qw( globmap ); | ||||
382 | |||||
383 | my $aref = globmap $input => $output | ||||
384 | or die $File::GlobMapper::Error ; | ||||
385 | |||||
386 | my $gm = new File::GlobMapper $input => $output | ||||
387 | or die $File::GlobMapper::Error ; | ||||
388 | |||||
389 | |||||
390 | =head1 DESCRIPTION | ||||
391 | |||||
392 | This module needs Perl5.005 or better. | ||||
393 | |||||
394 | This module takes the existing C<File::Glob> module as a starting point and | ||||
395 | extends it to allow new filenames to be derived from the files matched by | ||||
396 | C<File::Glob>. | ||||
397 | |||||
398 | This can be useful when carrying out batch operations on multiple files that | ||||
399 | have both an input filename and output filename and the output file can be | ||||
400 | derived from the input filename. Examples of operations where this can be | ||||
401 | useful include, file renaming, file copying and file compression. | ||||
402 | |||||
403 | |||||
404 | =head2 Behind The Scenes | ||||
405 | |||||
406 | To help explain what C<File::GlobMapper> does, consider what code you | ||||
407 | would write if you wanted to rename all files in the current directory | ||||
408 | that ended in C<.tar.gz> to C<.tgz>. So say these files are in the | ||||
409 | current directory | ||||
410 | |||||
411 | alpha.tar.gz | ||||
412 | beta.tar.gz | ||||
413 | gamma.tar.gz | ||||
414 | |||||
415 | and they need renamed to this | ||||
416 | |||||
417 | alpha.tgz | ||||
418 | beta.tgz | ||||
419 | gamma.tgz | ||||
420 | |||||
421 | Below is a possible implementation of a script to carry out the rename | ||||
422 | (error cases have been omitted) | ||||
423 | |||||
424 | foreach my $old ( glob "*.tar.gz" ) | ||||
425 | { | ||||
426 | my $new = $old; | ||||
427 | $new =~ s#(.*)\.tar\.gz$#$1.tgz# ; | ||||
428 | |||||
429 | rename $old => $new | ||||
430 | or die "Cannot rename '$old' to '$new': $!\n; | ||||
431 | } | ||||
432 | |||||
433 | Notice that a file glob pattern C<*.tar.gz> was used to match the | ||||
434 | C<.tar.gz> files, then a fairly similar regular expression was used in | ||||
435 | the substitute to allow the new filename to be created. | ||||
436 | |||||
437 | Given that the file glob is just a cut-down regular expression and that it | ||||
438 | has already done a lot of the hard work in pattern matching the filenames, | ||||
439 | wouldn't it be handy to be able to use the patterns in the fileglob to | ||||
440 | drive the new filename? | ||||
441 | |||||
442 | Well, that's I<exactly> what C<File::GlobMapper> does. | ||||
443 | |||||
444 | Here is same snippet of code rewritten using C<globmap> | ||||
445 | |||||
446 | for my $pair (globmap '<*.tar.gz>' => '<#1.tgz>' ) | ||||
447 | { | ||||
448 | my ($from, $to) = @$pair; | ||||
449 | rename $from => $to | ||||
450 | or die "Cannot rename '$old' to '$new': $!\n; | ||||
451 | } | ||||
452 | |||||
453 | So how does it work? | ||||
454 | |||||
455 | Behind the scenes the C<globmap> function does a combination of a | ||||
456 | file glob to match existing filenames followed by a substitute | ||||
457 | to create the new filenames. | ||||
458 | |||||
459 | Notice how both parameters to C<globmap> are strings that are delimited by <>. | ||||
460 | This is done to make them look more like file globs - it is just syntactic | ||||
461 | sugar, but it can be handy when you want the strings to be visually | ||||
462 | distinctive. The enclosing <> are optional, so you don't have to use them - in | ||||
463 | fact the first thing globmap will do is remove these delimiters if they are | ||||
464 | present. | ||||
465 | |||||
466 | The first parameter to C<globmap>, C<*.tar.gz>, is an I<Input File Glob>. | ||||
467 | Once the enclosing "< ... >" is removed, this is passed (more or | ||||
468 | less) unchanged to C<File::Glob> to carry out a file match. | ||||
469 | |||||
470 | Next the fileglob C<*.tar.gz> is transformed behind the scenes into a | ||||
471 | full Perl regular expression, with the additional step of wrapping each | ||||
472 | transformed wildcard metacharacter sequence in parenthesis. | ||||
473 | |||||
474 | In this case the input fileglob C<*.tar.gz> will be transformed into | ||||
475 | this Perl regular expression | ||||
476 | |||||
477 | ([^/]*)\.tar\.gz | ||||
478 | |||||
479 | Wrapping with parenthesis allows the wildcard parts of the Input File | ||||
480 | Glob to be referenced by the second parameter to C<globmap>, C<#1.tgz>, | ||||
481 | the I<Output File Glob>. This parameter operates just like the replacement | ||||
482 | part of a substitute command. The difference is that the C<#1> syntax | ||||
483 | is used to reference sub-patterns matched in the input fileglob, rather | ||||
484 | than the C<$1> syntax that is used with perl regular expressions. In | ||||
485 | this case C<#1> is used to refer to the text matched by the C<*> in the | ||||
486 | Input File Glob. This makes it easier to use this module where the | ||||
487 | parameters to C<globmap> are typed at the command line. | ||||
488 | |||||
489 | The final step involves passing each filename matched by the C<*.tar.gz> | ||||
490 | file glob through the derived Perl regular expression in turn and | ||||
491 | expanding the output fileglob using it. | ||||
492 | |||||
493 | The end result of all this is a list of pairs of filenames. By default | ||||
494 | that is what is returned by C<globmap>. In this example the data structure | ||||
495 | returned will look like this | ||||
496 | |||||
497 | ( ['alpha.tar.gz' => 'alpha.tgz'], | ||||
498 | ['beta.tar.gz' => 'beta.tgz' ], | ||||
499 | ['gamma.tar.gz' => 'gamma.tgz'] | ||||
500 | ) | ||||
501 | |||||
502 | |||||
503 | Each pair is an array reference with two elements - namely the I<from> | ||||
504 | filename, that C<File::Glob> has matched, and a I<to> filename that is | ||||
505 | derived from the I<from> filename. | ||||
506 | |||||
507 | |||||
508 | |||||
509 | =head2 Limitations | ||||
510 | |||||
511 | C<File::GlobMapper> has been kept simple deliberately, so it isn't intended to | ||||
512 | solve all filename mapping operations. Under the hood C<File::Glob> (or for | ||||
513 | older versions of Perl, C<File::BSDGlob>) is used to match the files, so you | ||||
514 | will never have the flexibility of full Perl regular expression. | ||||
515 | |||||
516 | =head2 Input File Glob | ||||
517 | |||||
518 | The syntax for an Input FileGlob is identical to C<File::Glob>, except | ||||
519 | for the following | ||||
520 | |||||
521 | =over 5 | ||||
522 | |||||
523 | =item 1. | ||||
524 | |||||
525 | No nested {} | ||||
526 | |||||
527 | =item 2. | ||||
528 | |||||
529 | Whitespace does not delimit fileglobs. | ||||
530 | |||||
531 | =item 3. | ||||
532 | |||||
533 | The use of parenthesis can be used to capture parts of the input filename. | ||||
534 | |||||
535 | =item 4. | ||||
536 | |||||
537 | If an Input glob matches the same file more than once, only the first | ||||
538 | will be used. | ||||
539 | |||||
540 | =back | ||||
541 | |||||
542 | The syntax | ||||
543 | |||||
544 | =over 5 | ||||
545 | |||||
546 | =item B<~> | ||||
547 | |||||
548 | =item B<~user> | ||||
549 | |||||
550 | |||||
551 | =item B<.> | ||||
552 | |||||
553 | Matches a literal '.'. | ||||
554 | Equivalent to the Perl regular expression | ||||
555 | |||||
556 | \. | ||||
557 | |||||
558 | =item B<*> | ||||
559 | |||||
560 | Matches zero or more characters, except '/'. Equivalent to the Perl | ||||
561 | regular expression | ||||
562 | |||||
563 | [^/]* | ||||
564 | |||||
565 | =item B<?> | ||||
566 | |||||
567 | Matches zero or one character, except '/'. Equivalent to the Perl | ||||
568 | regular expression | ||||
569 | |||||
570 | [^/]? | ||||
571 | |||||
572 | =item B<\> | ||||
573 | |||||
574 | Backslash is used, as usual, to escape the next character. | ||||
575 | |||||
576 | =item B<[]> | ||||
577 | |||||
578 | Character class. | ||||
579 | |||||
580 | =item B<{,}> | ||||
581 | |||||
582 | Alternation | ||||
583 | |||||
584 | =item B<()> | ||||
585 | |||||
586 | Capturing parenthesis that work just like perl | ||||
587 | |||||
588 | =back | ||||
589 | |||||
590 | Any other character it taken literally. | ||||
591 | |||||
592 | =head2 Output File Glob | ||||
593 | |||||
594 | The Output File Glob is a normal string, with 2 glob-like features. | ||||
595 | |||||
596 | The first is the '*' metacharacter. This will be replaced by the complete | ||||
597 | filename matched by the input file glob. So | ||||
598 | |||||
599 | *.c *.Z | ||||
600 | |||||
601 | The second is | ||||
602 | |||||
603 | Output FileGlobs take the | ||||
604 | |||||
605 | =over 5 | ||||
606 | |||||
607 | =item "*" | ||||
608 | |||||
609 | The "*" character will be replaced with the complete input filename. | ||||
610 | |||||
611 | =item #1 | ||||
612 | |||||
613 | Patterns of the form /#\d/ will be replaced with the | ||||
614 | |||||
615 | =back | ||||
616 | |||||
617 | =head2 Returned Data | ||||
618 | |||||
619 | |||||
620 | =head1 EXAMPLES | ||||
621 | |||||
622 | =head2 A Rename script | ||||
623 | |||||
624 | Below is a simple "rename" script that uses C<globmap> to determine the | ||||
625 | source and destination filenames. | ||||
626 | |||||
627 | use File::GlobMapper qw(globmap) ; | ||||
628 | use File::Copy; | ||||
629 | |||||
630 | die "rename: Usage rename 'from' 'to'\n" | ||||
631 | unless @ARGV == 2 ; | ||||
632 | |||||
633 | my $fromGlob = shift @ARGV; | ||||
634 | my $toGlob = shift @ARGV; | ||||
635 | |||||
636 | my $pairs = globmap($fromGlob, $toGlob) | ||||
637 | or die $File::GlobMapper::Error; | ||||
638 | |||||
639 | for my $pair (@$pairs) | ||||
640 | { | ||||
641 | my ($from, $to) = @$pair; | ||||
642 | move $from => $to ; | ||||
643 | } | ||||
644 | |||||
645 | |||||
646 | |||||
647 | Here is an example that renames all c files to cpp. | ||||
648 | |||||
649 | $ rename '*.c' '#1.cpp' | ||||
650 | |||||
651 | =head2 A few example globmaps | ||||
652 | |||||
653 | Below are a few examples of globmaps | ||||
654 | |||||
655 | To copy all your .c file to a backup directory | ||||
656 | |||||
657 | '</my/home/*.c>' '</my/backup/#1.c>' | ||||
658 | |||||
659 | If you want to compress all | ||||
660 | |||||
661 | '</my/home/*.[ch]>' '<*.gz>' | ||||
662 | |||||
663 | To uncompress | ||||
664 | |||||
665 | '</my/home/*.[ch].gz>' '</my/home/#1.#2>' | ||||
666 | |||||
667 | =head1 SEE ALSO | ||||
668 | |||||
669 | L<File::Glob|File::Glob> | ||||
670 | |||||
671 | =head1 AUTHOR | ||||
672 | |||||
673 | The I<File::GlobMapper> module was written by Paul Marquess, F<pmqs@cpan.org>. | ||||
674 | |||||
675 | =head1 COPYRIGHT AND LICENSE | ||||
676 | |||||
677 | Copyright (c) 2005 Paul Marquess. All rights reserved. | ||||
678 | This program is free software; you can redistribute it and/or | ||||
679 | modify it under the same terms as Perl itself. |