File Coverage

blib/lib/Regexp/Functions/chmod_et_al.pm
Criterion Covered Total %
statement 8 8 100.0
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 11 11 100.0


line stmt bran cond sub pod time code
1             package Regexp::Functions::chmod_et_al;
2 2     2   44374 use strict;
  2         4  
  2         45  
3 2     2   19 use 5.6.0;
  2         6  
4              
5             our $VERSION = '0.02';
6             our @ISA = qw(Exporter);
7             our @EXPORT_OK = qw(
8             $qr_chmod_et_al
9             );
10 2     2   10 use Carp;
  2         5  
  2         781  
11              
12             my $qrstring = qr/[^,]+/;
13             my $qrcomma = qr/\s*,\s*/;
14             my $qrarrayref = qr/\[[^]]+\]/;
15             my $qrfalse = qr/(?:0|''|"")/;
16             my $qrfatarrow = qr/\s+=>\s+/;
17             my $funcs = qr/mkdir/;
18             my $qropenparen = qr/\s*\(\s*/;
19             my $qrclosparen = qr/\s*\)\s*/;
20             my $qrmf = qr/[0-7]/;
21             my $qrmodes = qr/\b(?:20${qrmf}${qrmf}|02${qrmf}${qrmf}|00${qrmf}${qrmf}|0${qrmf}${qrmf}|2${qrmf}${qrmf}|00|0)\b/;
22             my $qrspaceoropenparen = qr/(?:\s+|$qropenparen)/;
23             my $qropenbrack = qr/\s*\[\s*/;
24             my $qrclosbrack = qr/\s*\]\s*/;
25             my $qropencurly = qr/\s*\{\s*/;
26             my $qrcloscurly = qr/\s*\}\s*/;
27              
28             # my $cnt = chmod 0755, "foo", "bar";
29             # mkdir FILENAME,MASK
30              
31             my $qrmkdir = qr/
32             mkdir
33             ${qrspaceoropenparen}
34             [^,]+
35             ${qrcomma}
36             ${qrmodes}
37             (?:$qrclosparen)?
38             /x;
39              
40             my $qrchmod = qr/
41             chmod
42             ${qrspaceoropenparen}
43             ${qrmodes}
44             ${qrcomma}
45             [^,]+
46             (?:,[^,]+)*
47             (?:$qrclosparen)?
48             /x;
49              
50             my $qrmkpath = qr/
51             mkpath
52             ${qrspaceoropenparen}
53             [^,]+
54             ${qrcomma}
55             [01]
56             ${qrcomma}
57             ${qrmodes}
58             (?:$qrclosparen)?
59             /x;
60              
61             my $qrmkpath2 = qr/
62             mkpath
63             ${qrspaceoropenparen}
64             ${qropenbrack}
65             [^,]+
66             (?:,[^,]+)*
67             ${qrclosbrack}
68             ${qrcomma}
69             [01]
70             ${qrcomma}
71             ${qrmodes}
72             (?:$qrclosparen)?
73             /x;
74              
75             # make_path('foo/bar/baz', '/zug/zwang', { verbose => 1, mode => 0711 });
76              
77             # q|make_path($somedir, { verbose => 1, mode => 0000 })|,
78              
79             my $qrmakepath = qr/
80             make_path
81             ${qrspaceoropenparen}
82             [^,]+
83             (?:,[^,]+)*
84             ${qrcomma}
85             ${qropencurly}
86             (?:[^,]+${qrcomma})*
87             mode${qrfatarrow}${qrmodes}
88             ${qrcloscurly}
89             (?:$qrclosparen)?
90             /x;
91              
92             ########################################
93              
94             our $qr_chmod_et_al;
95              
96             $qr_chmod_et_al = qr/
97             ( # This should be the only capture!
98             ${qrmkdir} # mkdir
99             |
100             ${qrchmod} # chmod
101             |
102             ${qrmkpath} # mkpath interface 1
103             |
104             ${qrmkpath2} # mkpath interface 2
105             |
106             ${qrmakepath} # make_path
107             )
108             /x;
109              
110             =head1 NAME
111              
112             Regexp::Functions::chmod_et_al - Patterns for matching Perl functions chmod(), mkdir(), File::Path::mkpath(), File::Path::make_path()
113              
114             =head1 SYNOPSIS
115              
116             use Regexp::Functions::chmod_et_al qw( $qr_chmod_et_al );
117              
118             @captures = 'chmod 0000, $somedir' =~ $qr_chmod_et_al;
119              
120             =head1 DESCRIPTION
121              
122             This module exports on request only a single scalar, C<$qr_chmod_et_al>, which
123             is a compiled regular expression. The regex has a B limited focus:
124             Searching Perl source code for instances of the following functions:
125              
126             =over 4
127              
128             =item * Perl built-in C
129              
130             =item * Perl built-in C
131              
132             =item * C
133              
134             =item * C
135              
136             =back
137              
138             ... and only in circumstances where a numerical mode that specifies that the
139             user has neither C nor C is being supplied as an argument.
140             Examples of such modes:
141              
142             0000
143             000
144             00
145             0
146             0200
147             200
148             0222
149              
150             B This is alpha code. This is a developer's tool and is B
151             intended be used in production code.
152              
153             =head1 BUGS
154              
155             None known at this time.
156              
157             =head1 AUTHOR
158              
159             James E Keenan
160             CPAN ID: JKEENAN
161             jkeenan@cpan.org
162             http://thenceforward.net/perl/modules/Regexp-Functions-chmod_et_al
163              
164             =head1 COPYRIGHT
165              
166             This program is free software; you can redistribute
167             it and/or modify it under the same terms as Perl itself.
168              
169             The full text of the license can be found in the
170             LICENSE file included with this module.
171              
172             =head1 SEE ALSO
173              
174             perl(1).
175              
176             =cut
177              
178             1;
179