File Coverage

blib/lib/File/Find/Rule/UnixPermissions.pm
Criterion Covered Total %
statement 38 40 95.0
branch 12 14 85.7
condition 3 3 100.0
subroutine 8 8 100.0
pod 0 1 0.0
total 61 66 92.4


line stmt bran cond sub pod time code
1             package File::Find::Rule::UnixPermissions;
2              
3 2     2   112574 use 5.006;
  2         15  
4 2     2   10 use strict;
  2         4  
  2         42  
5 2     2   10 use warnings;
  2         2  
  2         60  
6              
7 2     2   881 use File::Find::Rule;
  2         13313  
  2         14  
8 2     2   97 use base qw(File::Find::Rule);
  2         5  
  2         222  
9 2     2   12 use Fcntl qw(:mode);
  2         4  
  2         878  
10              
11             =head1 NAME
12              
13             File::Find::Rule::UnixPermissions - Use unix permissions for searching for files with File::Find.
14              
15             =head1 VERSION
16              
17             Version 0.0.0
18              
19             =cut
20              
21             our $VERSION = '0.0.0';
22              
23              
24             =head1 SYNOPSIS
25              
26              
27             use File::Find::Rule::UnixPermissions;
28             use Fcntl ':mode';
29              
30             # Find all types that are world writable... files, sockets, dirs, etc
31             my @world_writeable_drek=File::Find::Rule::UnixPermissions->UnixPermissions(include=>[S_IWOTH])
32             ->in('.');
33              
34             # Only find files that are world writable
35             my @world_writeable_drek=File::Find::Rule::UnixPermissions->file
36             ->UnixPermissions(include=>[S_IWOTH])
37             ->in('.')
38              
39             # Only find files that are world and group writable
40             my @world_writeable_drek=File::Find::Rule::UnixPermissions->file
41             ->UnixPermissions(include=>[S_IWOTH, S_IWGRP])
42             ->in('.')
43              
44             # Only find files that are world or group writable
45             my @world_writeable_drek=File::Find::Rule::UnixPermissions->file
46             ->UnixPermissions(include=>[S_IWOTH, S_IWGRP], any_include=>1)
47             ->in('.')
48              
49             'include' is a array of octal values to match against. These are most easily supplied via Fcntl.
50              
51             'any_include' is a boolean and setting it to true results in it matching any item in which any
52             the includes hit.
53              
54             In regards to the ones below, it is worth noting these will match ANY
55             permissions even a single one of their respective bits is set.
56              
57             S_IRWXG
58             S_IRWXO
59             S_IRWXU
60              
61             These will safely match just their respective bits
62              
63             S_IRUSR S_IWUSR S_IXUSR
64             S_IRGRP S_IWGRP S_IXGRP
65             S_IROTH S_IWOTH S_IXOTH
66              
67             A quick reference table...
68              
69             S_IRWXU -> User Read, Write, Execute
70             S_IRUSR -> User Read
71             S_IWUSR -> User Write
72             S_IXUSR -> User Execute
73              
74             S_IRWXG -> Group Read, Write, Execute
75             S_IRGRP -> Group Read
76             S_IWGRP -> Group Write
77             S_IXGRP -> Group Execute
78              
79             S_IRWXO -> Other Read, Write, Execute
80             S_IROTH -> Other Read
81             S_IWOTH -> Other Write
82             S_IXOTH -> Other Execute
83              
84             =cut
85              
86             sub UnixPermissions{
87 3     3 0 1125 my $self = shift()->_force_object;
88 3 50       25 my %criteria = ref($_[0]) eq "HASH" ? %{$_[0]} : @_;
  0         0  
89              
90 3 50       10 if ( ! defined( $criteria{include} ) ){
91 0         0 die('File::Find::Rule::UnixPermissions - include not specified');
92             }
93              
94 3 100       19 if ( ! defined( $criteria{any_include} ) ){
95 2         4 $criteria{any_include}=0;
96             }
97              
98             $self->exec(sub{
99 9     9   2192 my $file=shift;
100              
101 9         74 my $mode=(stat($file))[2];
102              
103             #process the include list
104 9         19 my $include_int=0;
105 9         26 my $matched=0;
106 9         26 while( defined( $criteria{include}[$include_int] ) ){
107 15 100       27 if ( $mode & $criteria{include}[$include_int] ){
108 9         13 $matched++;
109             }
110              
111 15         25 $include_int++;
112             }
113             # return on any include matches
114             # this will need to be rewriten post exlude inclusion
115 9 100 100     26 if ( $criteria{any_include} && $matched ){
116 2         35 return 1;
117             }
118             # if none of these are matched, no reason to process the exclude list
119 7 100       17 if ( ! $matched ){
120 1         17 return 0;
121             }
122             #make sure they all matched
123 6 100       11 if ( $matched != $include_int ){
124 2         40 return 0;
125             }
126              
127 4         85 return 1;
128              
129             # Will finish this all bit when I have more time and not on a clock.
130             # #process the exclude list
131             # my $exclude_int=0;
132             # $matched=0; #reset this
133             # while( defined( $criteria{exclude}[$exclude_int] ) ){
134             # if ( $mode & $criteria{exclude}[$exclude_int] ){
135             # $matched++;
136             # }
137              
138             # $exclude_int++;
139             # }
140             # # if any_exclude is set, return false on any exclude matching
141             # if ( $criteria{any_exclude} &&
142             # ( $matched > 0)
143             # ){
144             # return 0;
145             # }
146             # #return false if all exclude match
147             # if ( $matched == $include_int ){
148             # return 0;
149             # }
150              
151             # return 1;
152 3         32 });
153             }
154              
155             =head1 AUTHOR
156              
157             Zane C. Bowers-Hadley, C<< >>
158              
159             =head1 BUGS
160              
161             Please report any bugs or feature requests to C, or through
162             the web interface at L. I will be notified, and then you'll
163             automatically be notified of progress on your bug as I make changes.
164              
165              
166              
167              
168             =head1 SUPPORT
169              
170             You can find documentation for this module with the perldoc command.
171              
172             perldoc File::Find::Rule::UnixPermissions
173              
174              
175             You can also look for information at:
176              
177             =over 4
178              
179             =item * RT: CPAN's request tracker (report bugs here)
180              
181             L
182              
183             =item * AnnoCPAN: Annotated CPAN documentation
184              
185             L
186              
187             =item * CPAN Ratings
188              
189             L
190              
191             =item * Search CPAN
192              
193             L
194              
195             =item * Repository
196              
197             L
198              
199             =back
200              
201              
202             =head1 ACKNOWLEDGEMENTS
203              
204              
205             =head1 LICENSE AND COPYRIGHT
206              
207             Copyright 2019 Zane C. Bowers-Hadley.
208              
209             This program is free software; you can redistribute it and/or modify it
210             under the terms of the the Artistic License (2.0). You may obtain a
211             copy of the full license at:
212              
213             L
214              
215             Any use, modification, and distribution of the Standard or Modified
216             Versions is governed by this Artistic License. By using, modifying or
217             distributing the Package, you accept this license. Do not use, modify,
218             or distribute the Package, if you do not accept this license.
219              
220             If your Modified Version has been derived from a Modified Version made
221             by someone other than you, you are nevertheless required to ensure that
222             your Modified Version complies with the requirements of this license.
223              
224             This license does not grant you the right to use any trademark, service
225             mark, tradename, or logo of the Copyright Holder.
226              
227             This license includes the non-exclusive, worldwide, free-of-charge
228             patent license to make, have made, use, offer to sell, sell, import and
229             otherwise transfer the Package with respect to any patent claims
230             licensable by the Copyright Holder that are necessarily infringed by the
231             Package. If you institute patent litigation (including a cross-claim or
232             counterclaim) against any party alleging that the Package constitutes
233             direct or contributory patent infringement, then this Artistic License
234             to you shall terminate on the date that such litigation is filed.
235              
236             Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
237             AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
238             THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
239             PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
240             YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
241             CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
242             CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
243             EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
244              
245              
246             =cut
247              
248             1; # End of File::Find::Rule::UnixPermissions