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