File Coverage

blib/lib/Run/Parts/Perl.pm
Criterion Covered Total %
statement 40 41 97.5
branch 2 4 50.0
condition 3 5 60.0
subroutine 10 10 100.0
pod 6 6 100.0
total 61 66 92.4


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