Coverage Summary

# File Coverage

blib/lib/Run/Parts/Perl.pm
Criterion | Covered | Total | %
--- | --- | --- | ---
statement | 40 | 40 | 100.0
branch | 1 | 2 | 100.0
condition | 2 | 2 | 100.0
subroutine | 10 | 10 | 100.0
pod | 6 | 6 | 100.0
total | 59 | 60 | 100.0

line | stmt | bran | cond | sub | pod | time | code
--- | --- | --- | --- | --- | --- | --- | ---
1 |  |  |  |  |  |  | package Run::Parts::Perl;
2 |  |  |  |  |  |  |
3 |  |  |  |  |  |  | # ABSTRACT: Pure Perl implementation of Debian's run-parts tool
4 |  |  |  |  |  |  |
5 | 5 |  |  | 5 |  | 13 | use Modern::Perl;
| 5 |  |  |  |  | 5 |
| 5 |  |  |  |  | 12 |
6 | 5 |  |  | 5 |  | 1057 | use autodie;
| 5 |  |  |  |  | 38257 |
| 5 |  |  |  |  | 16 |
7 | 5 |  |  | 5 |  | 14495 | use Taint::Util;
| 5 |  |  |  |  | 1160 |
| 5 |  |  |  |  | 13 |
8 | 5 |  |  | 5 |  | 162 | use Run::Parts::Common;
| 5 |  |  |  |  | 4 |
| 5 |  |  |  |  | 1693 |
9 |  |  |  |  |  |  |
10 |  |  |  |  |  |  | our $VERSION = '0.06_90'; # VERSION generated by DZP::OurPkgVersion
11 |  |  |  |  |  |  |
12 |  |  |  |  |  |  |
13 |  |  |  |  |  |  | # On DOS and Windows, run-parts' regular expressions are not really
14 |  |  |  |  |  |  | # applicable. Allow an arbitrary alphanumerical suffix there.
15 |  |  |  |  |  |  | my $win_suffix = dosish() ? qr/\.[a-z0-9]+/i : qr'';
16 |  |  |  |  |  |  | my $file_re = qr/^[-A-Za-z0-9_]+($win_suffix)?$/;
17 |  |  |  |  |  |  |
18 |  |  |  |  |  |  |
19 |  |  |  |  |  |  | sub new {
20 | 5 |  |  | 5 | 1 | 495 | my $self = {};
21 | 5 |  |  |  |  | 11 | bless($self, shift);
22 | 5 |  |  |  |  | 16 | $self->{dir} = shift;
23 |  |  |  |  |  |  |
24 | 5 |  |  |  |  | 15 | return $self;
25 |  |  |  |  |  |  | }
26 |  |  |  |  |  |  |
27 |  |  |  |  |  |  |
28 |  |  |  |  |  |  | sub run_parts_command {
29 | 26 |  |  | 26 | 1 | 24 | my $self = shift;
30 | 26 |  | 100 |  |  | 74 | my $rp_cmd = shift // 'run';
31 |  |  |  |  |  |  |
32 | 26 |  |  |  |  | 61 | my @result = $self->$rp_cmd(@_);
33 |  |  |  |  |  |  |
34 | 26 |  |  |  |  | 155 | return lines(@result);
35 |  |  |  |  |  |  | }
36 |  |  |  |  |  |  |
37 |  |  |  |  |  |  |
38 |  |  |  |  |  |  | sub list {
39 | 26 |  |  | 26 | 1 | 26 | my $self = shift;
40 | 26 |  |  |  |  | 52 | my $dir = $self->{dir};
41 |  |  |  |  |  |  |
42 | 26 |  |  |  |  | 58 | opendir(my $dh, $dir);
43 | 104 |  |  |  |  | 491 | my @list = sort map {
44 |  |  |  |  |  |  | # $dir can neither be '' nor undef, hence no check necessary
45 | 208 |  |  |  |  | 545 | "$dir/$_";
46 |  |  |  |  |  |  | } grep {
47 | 26 |  |  |  |  | 3394 | /$file_re/
48 |  |  |  |  |  |  | } readdir($dh);
49 |  |  |  |  |  |  | }
50 |  |  |  |  |  |  |
51 |  |  |  |  |  |  |
52 |  |  |  |  |  |  | sub test {
53 | 12 |  |  | 12 | 1 | 18 | my $self = shift;
54 | 12 |  |  |  |  | 17 | my $dir = $self->{dir};
55 |  |  |  |  |  |  |
56 | 12 |  |  |  |  | 21 | return grep { -x } $self->list($dir);
| 48 |  |  |  |  | 118 |
57 |  |  |  |  |  |  | }
58 |  |  |  |  |  |  |
59 |  |  |  |  |  |  |
60 |  |  |  |  |  |  | sub run {
61 | 4 |  |  | 4 | 1 | 7 | my $self = shift;
62 | 4 |  |  |  |  | 7 | my $dir = $self->{dir};
63 |  |  |  |  |  |  |
64 | 8 |  |  |  |  | 12 | return map {
65 | 4 |  |  |  |  | 26 | my $command = $_;
66 | 8 |  |  |  |  | 22 | untaint($command);
67 |  |  |  |  |  |  | # uncoverable branch true
68 | 8 | 50 |  |  |  | 18 | $command =~ s(/)(\\)g if dosish();
69 | 8 |  |  |  |  | 15627 | my $output = `$command`;
70 | 8 |  |  |  |  | 67 | chomp($output);
71 | 8 |  |  |  |  | 94 | $output;
72 |  |  |  |  |  |  | } $self->test($dir);
73 |  |  |  |  |  |  | }
74 |  |  |  |  |  |  |
75 |  |  |  |  |  |  |
76 |  |  |  |  |  |  | sub dosish {
77 | 13 |  |  | 13 | 1 | 92 | return $^O =~ /^(dos|os2|MSWin32)$/;
78 |  |  |  |  |  |  | }
79 |  |  |  |  |  |  |
80 |  |  |  |  |  |  |
81 |  |  |  |  |  |  | qr/\.d$/; # End of Run::Parts::Perl
82 |  |  |  |  |  |  |
83 |  |  |  |  |  |  | __END__
84 |  |  |  |  |  |  |
85 |  |  |  |  |  |  | =pod
86 |  |  |  |  |  |  |
87 |  |  |  |  |  |  | =encoding UTF-8
88 |  |  |  |  |  |  |
89 |  |  |  |  |  |  | =head1 NAME
90 |  |  |  |  |  |  |
91 |  |  |  |  |  |  | Run::Parts::Perl - Pure Perl implementation of Debian's run-parts tool
92 |  |  |  |  |  |  |
93 |  |  |  |  |  |  | =head1 VERSION
94 |  |  |  |  |  |  |
95 |  |  |  |  |  |  | version 0.06_90
96 |  |  |  |  |  |  |
97 |  |  |  |  |  |  | =head1 SYNOPSIS
98 |  |  |  |  |  |  |
99 |  |  |  |  |  |  | Pure Perl reimplementation of basic functionality of Debian's
100 |  |  |  |  |  |  | L<run-parts(8)> tool.
101 |  |  |  |  |  |  |
102 |  |  |  |  |  |  | L<run-parts(8)> runs all the executable files named within constraints
103 |  |  |  |  |  |  | described below, found in the given directory. Other files and
104 |  |  |  |  |  |  | directories are silently ignored.
105 |  |  |  |  |  |  |
106 |  |  |  |  |  |  | Additionally it can just print the names of the all matching files
107 |  |  |  |  |  |  | (not limited to executables, but ignores blacklisted files like
108 |  |  |  |  |  |  | e.g. backup files), but don't actually run them.
109 |  |  |  |  |  |  |
110 |  |  |  |  |  |  | This is useful when functionality or configuration is split over
111 |  |  |  |  |  |  | multiple files in one directory.
112 |  |  |  |  |  |  |
113 |  |  |  |  |  |  | This module is not thought to be used directly and its interface may
114 |  |  |  |  |  |  | change. See L<Run::Parts> for a stable user interface.
115 |  |  |  |  |  |  |
116 |  |  |  |  |  |  | =head1 FILE NAME CONSTRAINTS
117 |  |  |  |  |  |  |
118 |  |  |  |  |  |  | On unix-ish operating systems, the file name (but not the path) must
119 |  |  |  |  |  |  | match ^[-A-Za-z0-9_]+$, i.e. may not contain a dot.
120 |  |  |  |  |  |  |
121 |  |  |  |  |  |  | On dos-ish operating systems, the file name without suffix must match
122 |  |  |  |  |  |  | ^[-A-Za-z0-9_]+$, i.e. may not contain a dot. The suffix may contain
123 |  |  |  |  |  |  | alphanumeric characters and is not mandatory. The full regular
124 |  |  |  |  |  |  | expression the file name including the suffix must match is
125 |  |  |  |  |  |  | ^[-A-Za-z0-9_]+(\.[A-Za-z0-9]+)?$.
126 |  |  |  |  |  |  |
127 |  |  |  |  |  |  | Debian's L<run-parts(8)> tool also offers to use alternative regular
128 |  |  |  |  |  |  | expressions as file name constraints. This is not yet implemented in
129 |  |  |  |  |  |  | L<Run::Parts::Perl>.
130 |  |  |  |  |  |  |
131 |  |  |  |  |  |  | =head1 METHODS
132 |  |  |  |  |  |  |
133 |  |  |  |  |  |  | =head2 new (Constructor)
134 |  |  |  |  |  |  |
135 |  |  |  |  |  |  | Creates a new L<Run::Parts> object. Takes one parameter, the directory
136 |  |  |  |  |  |  | on which run-parts should work.
137 |  |  |  |  |  |  |
138 |  |  |  |  |  |  | =head2 run_parts_command
139 |  |  |  |  |  |  |
140 |  |  |  |  |  |  | Executes the given action with the given parameters
141 |  |  |  |  |  |  |
142 |  |  |  |  |  |  | =head2 list
143 |  |  |  |  |  |  |
144 |  |  |  |  |  |  | Lists all relevant files in the given directory. Equivalent to
145 |  |  |  |  |  |  | "run-parts --list". Returns an array.
146 |  |  |  |  |  |  |
147 |  |  |  |  |  |  | =head2 test
148 |  |  |  |  |  |  |
149 |  |  |  |  |  |  | Lists all relevant executables in the given directory. Equivalent to
150 |  |  |  |  |  |  | "run-parts --tests". Returns an array.
151 |  |  |  |  |  |  |
152 |  |  |  |  |  |  | =head2 run
153 |  |  |  |  |  |  |
154 |  |  |  |  |  |  | Executes all relevant executables in the given directory. Equivalent to
155 |  |  |  |  |  |  | "run-parts --tests". Returns an array.
156 |  |  |  |  |  |  |
157 |  |  |  |  |  |  | =head1 INTERNAL FUNCTIONS
158 |  |  |  |  |  |  |
159 |  |  |  |  |  |  | =head2 dosish
160 |  |  |  |  |  |  |
161 |  |  |  |  |  |  | Returns true if ran on a dos-ish platform, i.e. MS-DOS, Windows or
162 |  |  |  |  |  |  | OS/2.
163 |  |  |  |  |  |  |
164 |  |  |  |  |  |  | =head1 SEE ALSO
165 |  |  |  |  |  |  |
166 |  |  |  |  |  |  | L<Run::Parts>, L<run-parts(8)>
167 |  |  |  |  |  |  |
168 |  |  |  |  |  |  | =head1 BUGS
169 |  |  |  |  |  |  |
170 |  |  |  |  |  |  | Please report any bugs or feature requests to C<bug-run-parts at
171 |  |  |  |  |  |  | rt.cpan.org>, or through the web interface at
172 |  |  |  |  |  |  | L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Run-Parts>. I will
173 |  |  |  |  |  |  | be notified, and then you'll automatically be notified of progress on
174 |  |  |  |  |  |  | your bug as I make changes.
175 |  |  |  |  |  |  |
176 |  |  |  |  |  |  | =head1 AUTHOR
177 |  |  |  |  |  |  |
178 |  |  |  |  |  |  | Axel Beckert <abe@deuxchevaux.org>
179 |  |  |  |  |  |  |
180 |  |  |  |  |  |  | =head1 COPYRIGHT AND LICENSE
181 |  |  |  |  |  |  |
182 |  |  |  |  |  |  | This software is copyright (c) 2014 by Axel Beckert.
183 |  |  |  |  |  |  |
184 |  |  |  |  |  |  | This is free software; you can redistribute it and/or modify it under
185 |  |  |  |  |  |  | the same terms as the Perl 5 programming language system itself.
186 |  |  |  |  |  |  |
187 |  |  |  |  |  |  | =cut