File Coverage

lib/App/Fed.pm
Criterion Covered Total %
statement 248 248 100.0
branch 71 78 91.0
condition 34 45 75.5
subroutine 19 19 100.0
pod 0 1 0.0
total 372 391 95.1


(transcode), B

(pipe),

line stmt bran cond sub pod time code
1             package App::Fed;
2             ################################################################################
3             #
4             # fed - File editor.
5             #
6             # Copyright (C) 2011 Bartłomiej /Natanael/ Syguła
7             #
8             # This is free software.
9             # It is licensed, and can be distributed under the same terms as Perl itself.
10             #
11             ################################################################################
12 17     17   1753659 use warnings; use strict;
  17     17   46  
  17         595  
  17         86  
  17         33  
  17         5736  
13              
14             my $VERSION = '0.01_99'; # {{{
15              
16 17     17   964 use English qw( -no_match_vars );
  17         2505  
  17         152  
17 17     17   9464 use File::Slurp qw( read_file write_file read_dir );
  17         14208  
  17         1232  
18 17     17   1320 use File::Temp qw( tempfile );
  17         22786  
  17         937  
19 17     17   22104 use Getopt::Long 2.36 qw( GetOptionsFromArray );
  17         237423  
  17         490  
20             # }}}
21              
22             =encoding UTF-8
23              
24             =head1 NAME
25              
26             fed - file editor for filtering and transforming text, file-wide.
27              
28             =head1 SYNOPSIS
29              
30             fed [OPTION]... [COMMAND]... [input-file]...
31            
32             # Replace first occurance of 'foo' and 'bar' (and all between) with space.
33             fed 's/foo.+?baz/foo baz/' text_*.txt
34            
35             # Strip comments from config files, each time show diff and ask:
36             fed -a -d 'r/\s*#.+?$/m' *.conf
37            
38             # Remove HTML links.
39             fed -c 's{(.+?)<\\\/a>}{$1}sg' page*.html
40              
41             =head1 DISCLAIMER
42              
43             This is an Alpha release. It may be unstable. It may corrupt your files.
44              
45             Use with caution, for evaluation purposes only.
46              
47             =head1 DESCRIPTION
48              
49             Fed is a replace/filter utility, working on per-line or per-file basis, across multiple files,
50             even going recursively into directories.
51              
52             It aims to provide easy access to some functionality of I, I and I.
53              
54             By default it will replace files in-place, so you do not have to pipe/move anything.
55              
56             You can control the edit process either by having changed files written under different name,
57             or by inspecting changes (with F) and accepting them manually.
58              
59             =head1 COMMANDS
60              
61             Following commands are supported: B (substitute), B
62             B (remove), and B (match). Following separators are supported: B, B<{}>, B<[]>.
63              
64             Many commands can be provided in a row, they will all be applied one after another, each working on the output from previous one.
65              
66             Please see App::Fed::Cookbook for how those can be applied to real-life situations.
67              
68             =head2 s/PATTERN/EXPRESSION/MODIFIERS
69              
70             Substitute, according to given expression.
71              
72             =head2 tr/PATTERN/EXPRESSION/MODIFIERS
73              
74             Transcode, according to given expression.
75              
76             =head2 p/PATTERN/COMMAND/MODIFIERS
77              
78             Pipe matched content into shell command, and use it's output as replacement.
79              
80             =head2 r/PATTERN/MODIFIERS
81              
82             Remove parts, that match the regular expression.
83              
84             =head2 m/PATTERN/MODIFIERS
85              
86             Match parts of the filename and remove anything else.
87              
88             =cut
89              
90             my %command_spec = (
91             s => {
92             groupping => 1, # Groups are allowed.
93             replacement => 1, # Replacement is required
94              
95             callback => \&_handle_s,
96             },
97             tr => {
98             groupping => 0,
99             replacement => 1,
100              
101             callback => \&_handle_tr,
102             },
103             p => {
104             groupping => 1,
105             replacement => 1,
106              
107             callback => \&_handle_p,
108             },
109             r => {
110             groupping => 0,
111             replacement => 0,
112              
113             callback => \&_handle_r,
114             },
115             m => {
116             groupping => 0,
117             replacement => 0,
118              
119             callback => \&_handle_m,
120             },
121             );
122              
123             =head1 MODIFIERS
124              
125             =over
126              
127             =item e
128              
129             Evaluate EXPRESSION as Perl code, before replacing.
130              
131             =item g
132              
133             Enable global matching.
134              
135             =item i
136              
137             Do case-insensitive pattern matching.
138              
139             =item m
140              
141             Enable matching in multi-line mode.
142              
143             That is, change "^" and "$" from matching the start or end of file to matching the start or end of any line.
144              
145             =item s
146              
147             Change "." to match any character whatsoever, even a newline, which normally it would not match.
148              
149             =back
150              
151             Enabling 'm' and 's' as "/ms", they let the "." match any character whatsoever, while still allowing "^" and "$" to match, respectively, just after and just before newlines within the string.
152              
153             =head1 COMMAND LINE OPTIONS
154              
155             =over
156              
157             =cut
158              
159             my %options_def;
160             my %options;
161              
162             =item -a --ask
163              
164             Ask, before writing anything.
165              
166             =cut
167              
168             $options_def{ 'a|ask' } = \$options{'ask'};
169              
170             =item -c --changed-only
171              
172             Write anything only, if any changes ware made.
173              
174             =cut
175              
176             $options_def{ 'c|changed-only' } = \$options{'changed-only'};
177              
178             =item -d --diff
179              
180             Show I between original and modified content, before writing changes.
181              
182             By default, program will not ask or wait for confirmation, just describe the changes and continue.
183             If you want to be able to inspect and confirm changes, use with combination with I<-a>.
184              
185             This is useful to be able to quickly inspect - post-mortem - what has been done.
186              
187             =cut
188              
189             $options_def{ 'd|diff' } = \$options{'diff'};
190              
191             =item --diff-command=COMMAND
192              
193             What comparison command to run, defaults to: F.
194              
195             =cut
196              
197             $options_def{ 'diff-command' } = \$options{'diff-command'};
198              
199             =item -h --help
200              
201             Output a short help and exit.
202              
203             =cut
204              
205             $options_def{ 'h|help' } = \$options{'help'};
206              
207             =item -m --move
208              
209             When used with I<-P> or I<-S>, F will move the file first, then copy it to the old name,
210             and finally modify moved file.
211              
212             This preserves hard links, ownership and other attributes.
213              
214             If file is changed in-place, the option is silently ignored.
215              
216             =cut
217              
218             $options_def{ 'm|move' } = \$options{'move'};
219              
220             =item -p --pretend
221              
222             Do not do anything, just pretend and describe what would be done.
223              
224             This option overwrites I<-a> (with a warning).
225              
226             =cut
227              
228             $options_def{ 'p|pretend' } = \$options{'pretend'};
229              
230             =item -q --quiet --silent
231              
232             Output nothing, and if, then only to STDERR.
233              
234             =item -r -R --recursive
235              
236             Process directories recursively. If this option is not enabled, those will be ignored (silently, unless in verbose mode).
237              
238             =cut
239              
240             $options_def{ 'r|R|recursive' } = \$options{'recursive'};
241              
242             =item -P --prefix[=PREFIX]
243              
244             Instead of doing the change in-place, save changed file to a copy with PREFIX added to the name.
245              
246             =cut
247              
248             $options_def{ 'P|prefix=s' } = \$options{'prefix'};
249              
250             =item -S --suffix[=SUFFIX]
251              
252             Instead of doing the change in-place, save changed file to a copy with SUFFIX added to the name.
253              
254             =cut
255              
256             $options_def{ 'S|suffix=s' } = \$options{'suffix'};
257              
258             =item -v --verbose
259              
260             Explain what is being done.
261              
262             =cut
263              
264             $options_def{ 'v|verbose' } = \$options{'verbose'};
265              
266             =item -V --version
267              
268             Display version info and exit.
269              
270             =cut
271              
272             $options_def{ 'V|version' } = \$options{'version'};
273              
274             =back
275              
276             =head1 REGULAR EXPRESSIONS
277              
278             This command uses Perl Regular Expressions. It will understand everything,
279             that the version of Perl on which it runs will accept.
280              
281             =cut
282              
283             sub main { # {{{
284 35     35 0 162143 my ( @params ) = @_;
285              
286             # Display help, if run without parameters.
287 35 100       164 if (not scalar @params) {
288 1         3 @params = q{--help};
289             }
290              
291 35         215 Getopt::Long::Configure("bundling");
292 35         1523 GetOptionsFromArray(
293             \@params,
294             %options_def,
295             );
296              
297             # use Data::Dumper; warn Dumper \%options, @params;
298              
299 35 100       30468 if ($options{'version'}) {
    100          
300 2         138 print "File EDitor v" . $VERSION . "\n";
301              
302 2         13 return 0;
303             }
304             elsif ($options{'help'}) {
305 3         266 print "File EDitor v" . $VERSION ."\n";
306              
307 3         69 print qq{\n};
308 3         34 print qq{Usage:\n};
309 3         32 print qq{ \$ fed [OPTIONS] COMMANDS FILES\n};
310 3         28 print qq{\n};
311 3         30 print qq{Commands:\n};
312 3         27 print qq{\n};
313 3         27 print qq{ s/Pattern/String/eigms Substitute - replace 'Pattern' with 'String'\n};
314 3         27 print qq{ p/Pattern/Command/igms Pipe - replace 'Pattern' with output from 'Command'\n};
315 3         27 print qq{ tr/From/To/ Transcode - Replace letters from 'From' to their pairs from 'To'\n};
316 3         25 print qq{ m/Pattern/irms Match - Remove everything, that does not match the 'Pattern'\n};
317 3         25 print qq{ r/Pattern/igms Remove - Remove every occurance of 'Pattern'\n};
318 3         26 print qq{\n};
319 3         24 print qq{Options:\n};
320 3         23 print qq{\n};
321 3         26 print qq{ -p --pretend Do not do anything, just describe what would be done.\n};
322 3         25 print qq{ -a --ask Ask, before writing anything.\n};
323 3         27 print qq{ -d --diff Show 'diff' between original and modified content.\n};
324 3         48 print qq{ --diff-command=COMMAND What comparison command to run, defaults to: 'diff'.\n};
325 3         27 print qq{ -q --quiet --silent Output nothing.\n};
326 3         24 print qq{ -v --verbose Explain what is being done.\n};
327 3         25 print qq{\n};
328 3         25 print qq{ -c --changed-only Write anything only, if any changes ware made.\n};
329 3         24 print qq{ -m --move Move, then backut, then rename. Preserves attributes.\n};
330 3         23 print qq{ -P --prefix[=PREFIX] Append PREFIX to filename and write there.\n};
331 3         26 print qq{ -S --suffix[=SUFFIX] Append SUFFIX to filename and write there.\n};
332 3         27 print qq{ -r -R --recursive Process directories recursively.\n};
333 3         25 print qq{\n};
334 3         31 print qq{ -h --help Display this usage summary.\n};
335 3         28 print qq{ -V --version Display version info and exit.\n};
336 3         59 print qq{ \n};
337 3         27 print qq{Example:\n};
338 3         27 print qq{ \n};
339 3         30 print qq{ \$ fed -a -d -r -S .new 's/br0k3n/broken/g' my_text_files/\n};
340 3         29 print qq{ | | | | | |\n};
341 3         26 print qq{ | | | | | '-- all files from 'my_text_files'.\n};
342 3         28 print qq{ | | | | '-- Substitute all occurances of 'br0k3n' with 'broken'.\n};
343 3         29 print qq{ | | | '-- Write to new files, with '.new' appended to the name\n};
344 3         27 print qq{ | | '-- Dive into subdirectories.\n};
345 3         25 print qq{ | '-- Display differences after processing each file.\n};
346 3         25 print qq{ '-- Ask for confirmation, before writing changes.\n};
347 3         23 print qq{\n};
348              
349 3         16 return 0;
350             }
351              
352 30 100 100     204 if ($options{'ask'} and $options{'pretend'}) {
353 1         55 print STDERR "Note: 'ask' overwrites 'pretend'!\n";
354              
355 1         4 delete $options{'pretend'};
356             }
357              
358             # Isolate commands from files.
359 30         62 my @commands;
360             my @files;
361              
362 30         73 foreach my $param (@params) {
363 68 100       477 if ($param =~ m{^([stprm]r?)(.+?)([egims]+)?$}s) {
364             # This looks as a command :)
365 36         165 my ( $command, $guts, $modifiers ) = ( $1, $2, $3 );
366              
367             # warn qq{ $command, $guts, $modifiers };
368              
369 36         60 my ( $is_regexp, $pattern, $expression );
370 36 100       376 if ($guts =~ m{^/(.+?)(?
    100          
    50          
371 34         97 ( $is_regexp, $pattern, $expression ) = ( 1, $1, $3 );
372             }
373             elsif ($guts =~ m{^\{(.+?)\}(\{(.*?)\})??$}) {
374 1         3 ( $is_regexp, $pattern, $expression ) = ( 1, $1, $3 );
375             }
376             elsif ($guts =~ m{^\[(.+?)\](\[(.*?)\])?$}) {
377 1         3 ( $is_regexp, $pattern, $expression ) = ( 1, $1, $3 );
378             }
379              
380 36 50 33     249 if ($command_spec{$command} and $is_regexp) {
381             # This IS a command :)
382             # Do sanity-quoting to avoid 'variable injection'
383 36         87 $pattern =~ s{(?
384              
385             # Quote '/' as well...
386 36         79 $pattern =~ s{(?
387              
388 36 100       93 if ($expression) {
389 24         41 $expression =~ s{(?
390 24         58 $expression =~ s{(?
391             }
392 36         205 push @commands, {
393             command => $command,
394             pattern => $pattern,
395             replace => $expression,
396             modifiers => $modifiers,
397             };
398              
399             # Head to next parameter.
400 36         88 next;
401             }
402             }
403              
404             # It was not recognised as regular expression, therefore it must be a file.
405 32 100 33     859 if (-f $param) {
    50          
406 27         83 push @files, $param;
407             }
408             elsif ($options{'recursive'} and -d $param) {
409 5         18 push @files, _recure_into_dir($param);
410             }
411             }
412              
413             # use Data::Dumper; warn Dumper \@files, \@commands;
414              
415 30         120 my $failures = _check_regs(\@commands);
416 30 100       105 if ($failures) {
417 1         7 return 4;
418             }
419              
420 29         51 my $i = 1;
421 29         44 my $count = scalar @files;
422 29         55 foreach my $file (@files) {
423 43         145 my $percent = int 100 * $i / $count;
424 43         201 _verbose("File $i of $count ($percent%)\n");
425 43         64 $i++;
426              
427 43         139 my $continue = _process_file($file, \@commands);
428              
429 43 100       188 if (not $continue) {
430 1         2 last;
431             }
432             }
433              
434 29         154 _verbose("Done.\n");
435              
436 29         379 return 0;
437             } # }}}
438              
439             sub _check_regs { # {{{
440 30     30   262 my ( $commands ) = @_;
441              
442 30         57 my $failures = 0;
443              
444 30         97 foreach my $command (@{ $commands }) {
  30         70  
445 36         56 my $ok = eval {
446 36         76 my $regexp = $command->{'pattern'};
447              
448 36         544 my $re = qr{$regexp};
449              
450 35         88 return $re;
451             };
452              
453 36 100 66     312 if ($EVAL_ERROR or not $ok) {
454 1         54 print STDERR "Invalid REGEXP: (please correct)\n ". $command->{'pattern'} ."\n\n";
455 1 50       5 if ($EVAL_ERROR) {
456 1         12 print STDERR $EVAL_ERROR;
457 1         11 print STDERR "\n";
458             }
459              
460 1         4 $failures++;
461             }
462             }
463              
464 30         74 return $failures;
465             } # }}}
466              
467             sub _recure_into_dir { # {{{
468 16     16   24 my ( $dir ) = @_;
469            
470 16         113 _verbose("Reading " . $dir . "\n");
471              
472 16         21 my @files;
473              
474 16         58 my @fs_items = read_dir($dir);
475 16         1221 foreach my $item (sort @fs_items) {
476 28 100       570 if (-f $dir . q{/} . $item) {
477 17         40 push @files, $dir . q{/} . $item;
478              
479 17         32 next;
480             }
481            
482 11 50       210 if (-d $dir . q{/} . $item) {
483 11         45 push @files, _recure_into_dir($dir . q{/} . $item);
484             }
485             }
486              
487 16         56 return @files;
488             } # }}}
489              
490             sub _process_file { # {{{
491 43     43   84 my ( $file, $commands ) = @_;
492              
493             # If We have printed something, while working with this file,
494             # rise this flag - it will add a separator (newline) in case there will be some
495             # stuff printed later.
496 43         60 my $push_newline = 0;
497              
498 43 100       112 if ($options{'verbose'}) {
499 6         16 $push_newline = _print_file_name($file, $push_newline);
500             }
501              
502             # Read in the file.
503 43         150 my $contents = read_file($file);
504              
505 43         3522 my $something_was_done = 0;
506              
507 43         63 foreach my $command (@{ $commands }) {
  43         105  
508 49         65 my $something_was_done_here;
509              
510 49         128 my $callback = $command_spec{ $command->{'command'} }->{'callback'};
511              
512 49         161 ( $contents, $something_was_done_here ) = $callback->($contents, $command);
513              
514 49 100       163 if ($something_was_done_here) {
515 42         121 $something_was_done++;
516             }
517             }
518              
519             # If We are to write only in case there ware any changes...
520 43 100 100     195 if ($options{'changed-only'} and not $something_was_done) {
521             # ... then bail out, if there ware none.
522            
523 3         8 _verbose(" No changes.\n\n");
524              
525 3         8 return 1;
526             }
527              
528             # Decide, where We will output.
529 40         71 my $file_out = $file;
530 40 100 100     282 if ($options{'prefix'} or $options{'suffix'}) {
531 9         35 $file_out = _rename_file($file, $options{'prefix'}, $options{'suffix'});
532             }
533            
534 40 100       125 if ($file ne $file_out) {
535 9         33 _verbose(" Target: $file_out\n");
536             }
537              
538             # Assumption is, that if regexp returns true, then there ware changes.
539             # If running with --diff, this can actually be verified :)
540 40         62 my $has_changes = $something_was_done;
541              
542             # This is a good place to show differences, if they ware requested.
543 40 100       132 if ($options{'diff'}) {
544 2         7 $push_newline = _print_file_name($file, $push_newline);
545              
546 2         17 print "\n Diff:\n";
547              
548 2   50     18 my $diff_command = ( $options{'diff-command'} or 'diff' );
549              
550 2         8 my ($tmp_fh, $tmp_file) = tempfile();
551              
552 2         581 write_file($tmp_fh, $contents);
553 2         338 my $fh;
554 2         5 $has_changes = 0;
555 2         8858 open $fh, q{-|}, $diff_command, $file, $tmp_file;
556 2         1956 while (my $line = <$fh>) {
557 4         66 print q{ } . $line;
558              
559 4         26 $has_changes = 1;
560             }
561 2         78 close $fh;
562              
563 2         427 unlink $tmp_file;
564            
565 2 100       55 if (not $has_changes) {
566 1         94 print " (no changes)\n";
567             }
568             }
569              
570             # If User wants to confirm - ask Him politely :)
571 40 100 100     261 if ($has_changes and $options{'ask'}) {
572 5         8 my $char = 1;
573              
574 5         15 $push_newline = _print_file_name($file, $push_newline);
575              
576 5         16 while ($char) {
577 5         50 print "\n";
578 5         49 print q{ Write changes? (n = no, q = quit, y = yes, a = all) : };
579              
580 5         56 $char = ;
581 5         11 chomp $char;
582 5         48 print "\n";
583              
584 5         11 $char = lc $char;
585              
586 5 100       15 if ($char eq 'n') {
587 2         7 return 1;
588             }
589              
590 3 100       14 if ($char eq 'q') {
591 1         3 return;
592             }
593              
594 2 100       38 if ($char eq 'a') {
595 1         3 $options{'ask'} = 0;
596              
597 1         3 last;
598             }
599              
600 1 50       11 if ($char eq 'y') {
601 1         2 last;
602             }
603             }
604             }
605              
606             # If running in 'pretend' mode - bail out just before writing anything...
607 37 100 100     216 if ($options{'pretend'} and not $has_changes) {
    100          
608 1         3 $push_newline = _print_file_name($file, $push_newline);
609              
610 1         12 print "\n Would be skipped.\n";
611             }
612             elsif ($options{'pretend'}) {
613 1         5 $push_newline = _print_file_name($file, $push_newline);
614              
615 1         10 print "\n Would be updated.\n";
616             }
617             else {
618             # Write out modified content.
619 35 100 100     144 if ($file ne $file_out and $options{'move'}) {
620 2         272 rename $file, $file_out;
621              
622             # Copy contents to the old name...
623 2         8 write_file($file, read_file($file_out));
624              
625             # Write into new location.
626 2         678 write_file($file_out, $contents);
627             }
628             else {
629             # Write out.
630 33         201 write_file($file_out, $contents);
631             }
632              
633 35         6172 _verbose(" Updated.\n");
634             }
635              
636 37 100       110 if ($push_newline) {
637 10         111 print "\n";
638             }
639            
640 37         140 return 1;
641             } # }}}
642              
643             sub _rename_file { # {{{
644 9     9   16 my ( $path, $prefix, $suffix ) = @_;
645              
646             # warn "( $path, $prefix, $suffix )";
647              
648 9 100       26 if ($prefix) {
649 8         85 $path =~ s{/([^/]+)$}{/$prefix$1}si;
650             }
651              
652 9 100       25 if ($suffix) {
653 1         4 return $path . $suffix;
654             }
655              
656 8         24 return $path;
657             } # }}}
658              
659             sub _print_file_name { # {{{
660 15     15   23 my ($file_name, $omit) = @_;
661              
662 15 50       33 if (not $omit) {
663 15         398 print $file_name . qq{ :\n};
664             }
665              
666 15         32 return 1;
667             } # }}}
668              
669             sub _handle_s { # {{{
670 41     41   71 my ( $contents, $command ) = @_;
671              
672 41   100     286 my ( $match, $replace, $modifiers ) = ( $command->{'pattern'}, ($command->{'replace'} or q{}), ($command->{'modifiers'} or q{}) );
      100        
673              
674             # Eval is not the best option, but I have no better solution for now.
675 41         3470 my $replaced = eval q{ $contents =~ s/} . $match . q{/} . $replace . q{/} . $modifiers;
676              
677 41         209 return ($contents, $replaced);
678             } # }}}
679              
680             sub _handle_tr { # {{{
681 1     1   7 my ( $contents, $command ) = @_;
682              
683 1   50     11 my ( $tr_from, $tr_to, $modifiers ) = ( $command->{'pattern'}, ($command->{'replace'} or q{}), ($command->{'modifiers'} or q{}) );
      50        
684              
685             # Eval is not the best option, but I have no better solution for now.
686 1         94 my $replaced = eval q{ $contents =~ tr/} . $tr_from . q{/} . $tr_to . q{/} . $modifiers;
687              
688 1         5 return ($contents, $replaced);
689             } # }}}
690              
691             sub _handle_p { # {{{
692 1     1   3 my ( $contents, $command ) = @_;
693              
694 1   50     14 my ( $match, $pipe_command, $modifiers ) = ( $command->{'pattern'}, ($command->{'replace'} or q{}), ($command->{'modifiers'} or q{}) );
      50        
695              
696             # FIXME: additional 'e' will probably NOT do what the User expects!
697              
698             # Eval is not the best option, but I have no better solution for now.
699 1         110 my $replaced = eval q{ $contents =~ s/(} . $match . q{)/_p_pipe($pipe_command, $1)/e} . $modifiers;
700              
701 1         27 return ($contents, $replaced);
702             } # }}}
703              
704             sub _p_pipe { # {{{
705 3     3   12 my ( $command, $input ) = @_;
706            
707             # FIXME: Replace with two-way open.
708 3         32 write_file(q{/tmp/fed_} . $PID, $input);
709              
710 3         875 my $fh;
711 3         14982 open $fh, q{-|}, q{cat /tmp/fed_} . $PID . q{ | } . $command;
712 3         154 my $output = read_file($fh);
713 3         31541 close $fh;
714              
715 3         1315 unlink q{/tmp/fed_} . $PID;
716              
717 3         606 return $output;
718             } # }}}
719              
720             sub _handle_m { # {{{
721 3     3   6 my ( $contents, $command ) = @_;
722              
723 3   50     11 my ( $match, $modifiers ) = ( $command->{'pattern'}, ($command->{'modifiers'} or q{}) );
724              
725 3         270 my @matches = eval q{ return ( $contents =~ m/(} . $match . q{)/} . $modifiers .q{ ) };
726              
727 3 100       13 if (scalar @matches) {
728 2         9 return ( (join q{}, @matches), 1);
729             }
730              
731 1         4 return ($contents, 0);
732             } # }}}
733              
734             sub _handle_r { # {{{
735 3     3   5 my ( $contents, $command ) = @_;
736              
737 3   100     27 my ( $match, $modifiers ) = ( $command->{'pattern'}, ($command->{'modifiers'} or q{}) );
738              
739             # Eval is not the best option, but I have no better solution for now.
740 3         304 my $replaced = eval q{ $contents =~ s/} . $match . q{//} . $modifiers;
741              
742 3         15 return ($contents, $replaced);
743             } # }}}
744              
745             sub _verbose { # {{{
746 135     135   228 my ( $msg ) = @_;
747              
748 135 100       332 if (not $options{'verbose'}) {
749 113         191 return;
750             }
751            
752 22         301 print $msg;
753              
754 22         37 return;
755             } # }}}
756              
757             =head1 BUGS
758              
759             Probably. None known at the moment.
760              
761             Please report using CPAN RT or email to the author.
762              
763             =head1 TODO
764              
765             Those are some interesting potential features, that may be implemented in future version.
766             If you need them, please notify the author.
767              
768             =over
769              
770             =item -x --one-file-system
771              
772             Do not cross file system boundaries.
773              
774             =item --color --no-color
775              
776             Enable (or disable) use of color in the output.
777              
778             Requires L.
779              
780             =item --recipe=RECIPY
781              
782             Use recipe named I from the APP::Fed::Coocbook.
783              
784             =item --check=Command
785              
786             Run 'C' after applying changes.
787              
788             If F returns non-zero exit status, changes will be cancelled.
789              
790             F will create a tmp file containing modified content,
791             and use it for test, before changing the original.
792              
793             =item -s --stats --summary
794              
795             On completion, dump summary of what was done.
796              
797             =back
798              
799             =head1 SEE ALSO
800              
801             ack(1), awk(1), ed(1), grep(1), tr(1), perlre(1), sed(1)
802              
803             =head1 COPYRIGHT
804              
805             Copyright (C) 2011 Bartłomiej /Natanael/ Syguła
806              
807             This is free software.
808             It is licensed, and can be distributed under the same terms as Perl itself.
809              
810             =cut
811              
812             # Internal notes:
813             #
814             # o Consider using Regexp::Parser - but it supports up to 5.8.x only :(
815              
816             # vim: fdm=marker
817             1;