File Coverage

blib/lib/App/PTP.pm
Criterion Covered Total %
statement 75 78 96.1
branch 20 30 66.6
condition 2 3 66.6
subroutine 13 13 100.0
pod 0 3 0.0
total 110 127 86.6


line stmt bran cond sub pod time code
1             package App::PTP;
2              
3 13     13   186623 use 5.022;
  13         99  
4 13     13   54 use strict;
  13         19  
  13         200  
5 13     13   49 use warnings;
  13         33  
  13         249  
6              
7 13     13   5156 use App::PTP::Args;
  13         42  
  13         494  
8 13     13   84 use App::PTP::Commands 'warn_or_die_if_needed';
  13         22  
  13         609  
9 13     13   72 use App::PTP::Files;
  13         26  
  13         691  
10 13     13   76 use Data::Dumper;
  13         30  
  13         456  
11 13     13   68 use File::Find;
  13         26  
  13         546  
12 13     13   65 use Safe;
  13         23  
  13         8447  
13              
14             our $VERSION = '1.04';
15              
16             $Data::Dumper::Terse = 1; # Don't output variable names.
17             $Data::Dumper::Sortkeys = 1; # Sort the content of the hash variables.
18             $Data::Dumper::Useqq = 1; # Use double quote for string (better escaping).
19              
20             my $safe = Safe->new();
21             $safe->deny_only(':subprocess', ':ownprocess', ':others', ':dangerous');
22             $safe->reval('use App::PTP::PerlEnv;');
23             $safe->reval('use File::Spec::Functions qw(:ALL);');
24              
25             # maybe_expand_dirs(filepath)
26             # If filepath is a normal file, then returns it as, is.
27             # If filepath does not exist, then terminates the program with an error.
28             # If filepath is a directory and the $recursive option is not set then
29             # terminates the program with an error, otherwise returns the list of all files
30             # that it contains.
31             sub maybe_expand_dirs {
32 135     135 0 231 my ($f, $options) = @_;
33 135 100       591 if (ref $f) {
    50          
    100          
34             # This will be the $stdin_marker reference.
35 113 50       258 if ($options->{in_place}) {
36 0         0 die "Reading from STDIN is incompatible with the --in-place option.\n";
37             }
38 113         353 return $f;
39             } elsif (not -e $f) {
40 0         0 die "File does not exist: ${f}\n";
41             } elsif (-d _) {
42 1 50       5 if (not $options->{recursive}) {
43 0         0 die "Input is a directory (did you forget the -R option?): ${f}\n";
44             }
45 1         3 my @files;
46             my $filter;
47 1 50       4 if (defined $options->{input_filter}) {
48 1         8 $filter = $safe->reval("sub { $options->{input_filter} }");
49 1 50       780 die "FATAL: Cannot wrap code for --input_filter: ${@}" if $@;
50             }
51             find({
52             # Because of the follow option, a stat has already been done on the file,
53             # so the '_' magic is guaranteed to work.
54             wanted => sub {
55 11 100   11   194 if (-f _) {
56 9         12 my $f = $_;
57 9 50       14 if (defined $filter) {
58 9         26 my $r = $filter->();
59 9 100 66     3880 return if warn_or_die_if_needed(
60             'Perl code failed while filtering input') || !$r;
61             }
62 2         45 push @files, $f;
63             }
64             } ,
65 1         141 follow => 1,
66             no_chdir => 1,
67             }, $f);
68 1         24 return sort @files;
69             } else {
70             # We assume that everything else is a file.
71 21         88 return $f;
72             }
73             }
74              
75             sub process_all {
76 120     120 0 233 my ($inputs, $pipeline, $options, $stdin) = @_;
77 120         402 $App::PTP::Commands::I_setter->set(1);
78 120 100       259 if ($options->{merge}) {
79 2 50       7 print "Merging all the inputs.\n" if $options->{debug_mode};
80 2         3 my $missing_final_separator = 0;
81 2         3 my @content;
82 2         4 for my $input (@$inputs) {
83 4         9 my ($content, $missing_separator) =
84             read_input($input, $options);
85 4         10 push @content, @$content;
86 4         9 $missing_final_separator = $missing_separator;
87             }
88             App::PTP::Commands::process(
89 2         9 \$App::PTP::Files::merged_marker, $pipeline, $options, \@content,
90             $missing_final_separator);
91 2         59 write_output(\$App::PTP::Files::merged_marker, \@content,
92             $missing_final_separator, $options);
93             } else {
94 118         217 for my $file_name (@$inputs) {
95 132         302 my ($content, $missing_final_separator) =
96             read_input($file_name, $options, $stdin);
97             # Note that process can modify the input $file_name variable.
98 132         524 App::PTP::Commands::process($file_name, $pipeline, $options, $content,
99             $missing_final_separator);
100 130         1512 write_output($file_name, $content, $missing_final_separator, $options);
101 130         331 $App::PTP::Commands::I_setter->inc();
102             }
103             }
104             }
105              
106             sub Run {
107 120     120 0 673 my ($stdin, $stdout, $stderr, $argv) = @_;
108 120         257 select($stderr); # All debug output, this applies inside the safe too.
109 120         418 my ($inputs, $pipeline, $options) =
110             App::PTP::Args::parse_command_line($argv);
111              
112 120 50       312 if ($options->{debug_mode}) {
113 120         326 print 'options = '.Dumper($options)."\n";
114 120         12322 print 'inputs = '.Dumper($inputs)."\n";
115 120         4829 print 'pipeline = '.Dumper($pipeline)."\n";
116             }
117              
118 120         9817 @$inputs = map { maybe_expand_dirs($_, $options) } @$inputs;
  135         275  
119 120 50       362 print 'expanded @inputs = '.Dumper($inputs)."\n" if $options->{debug_mode};
120              
121 120 50       4549 return if $options->{abort};
122              
123 120         364 init_global_output($options, $stdout);
124 120         14000 process_all($inputs, $pipeline, $options, $stdin);
125 118         274 close_global_output($options);
126             }
127              
128             1;