File Coverage

blib/lib/File/Permissions/Unix.pm
Criterion Covered Total %
statement 9 71 12.6
branch 0 24 0.0
condition n/a
subroutine 3 8 37.5
pod 5 5 100.0
total 17 108 15.7


line stmt bran cond sub pod time code
1             package File::Permissions::Unix;
2              
3 1     1   23501 use warnings;
  1         2  
  1         39  
4 1     1   6 use strict;
  1         2  
  1         36  
5 1     1   5 use base 'Error::Helper';
  1         6  
  1         846  
6              
7             =head1 NAME
8              
9             File::Permissions::Unix - A simple object oriented interface to handling file permissions.
10              
11             =head1 VERSION
12              
13             Version 0.0.0
14              
15             =cut
16              
17             our $VERSION = '0.0.0';
18              
19             =head1 SYNOPSIS
20              
21             use File::Permissions::Unix;
22            
23             my $foo=File::Permissions::Unix->new('0640');
24            
25             #chmods a /tmp/foo with 0640
26             $foo->chmod('/tmp/foo');
27              
28             #do the same thing as above, but check if it worked
29             $foo->chmod('/tmp/foo');
30             if( $foo->error ){
31             warn('error:'.$foo->error.': '.$foo->errorString);
32             }
33              
34             #copies the mode from /tmp/foo to /tmp/bar
35             $foo->setModeFromFile('/tmp/foo');
36             $foo->chmod('/tmp/bar');
37              
38             #prints the current mode
39             print $foo->getMode."\n";
40              
41             =head1 METHODS
42              
43             =head2 new
44              
45             This initiates the object.
46              
47             One arguement is accepted. It is the mode
48             to intialize the object with. If not specified
49             it defaults to '0644'.
50              
51             my $foo=File::Permissions::Unix->new($mode);
52             if( $foo->error ){
53             warn('error:'.$foo->error.': '.$foo->errorString);
54             }
55              
56             =cut
57              
58             sub new{
59 0     0 1   my $mode=$_[1];
60            
61 0 0         if ( ! defined( $mode ) ){
62 0           $mode='0644';
63             }
64              
65 0           my $self={
66             mode=>$mode,
67             perror=>undef,
68             error=>undef,
69             errorString=>'',
70             };
71 0           bless $self;
72            
73             # make sure it is a valid mode
74 0 0         if ( $self->{mode} !~ /^[01246][01234567][01234567][01234567]$/ ){
75 0           $self->{error}=1;
76 0           $self->{perror}=1;
77 0           $self->{errorString}='';
78 0           return $self;
79             }
80            
81 0           return $self;
82             }
83              
84             =head2 chmod
85              
86             This chmods a file with the current mode.
87              
88             One argument is required and it the file/directory/etc in question.
89              
90             $foo->chmod($file);
91             if( $foo->error ){
92             warn('error:'.$foo->error.': '.$foo->errorString);
93             }
94              
95             =cut
96              
97             sub chmod{
98 0     0 1   my $self=$_[0];
99 0           my $file=$_[1];
100              
101 0           $self->errorblank;
102 0 0         if ( $self->error ){
103 0           return undef;
104             }
105              
106             #make sure the file is defined
107 0 0         if( ! defined( $file ) ){
108 0           $self->{error}=2;
109 0           $self->{errorString}='No file specified';
110 0           return undef;
111             }
112              
113             #make sure the item exists
114 0 0         if ( ! -e $file ){
115 0           $self->{error}=3;
116 0           $self->{errorString}='"'.$file.'" does not exist';
117 0           return undef;
118             }
119              
120             #try to chmod the file
121 0 0         if( ! chmod( oct($self->{mode}), $file )){
122 0           $self->{error}=4;
123 0           $self->{errorString}='Unable to chmod "'.$file.'" with "'.$self->{mode}.'"';
124 0           return undef;
125             }
126              
127 0           return 1;
128             }
129              
130             =head2 getMode
131              
132             This returns the current mode.
133              
134             my $mode=$foo->getMode;
135              
136             =cut
137              
138             sub getMode{
139 0     0 1   my $self=$_[0];
140              
141 0           $self->errorblank;
142 0 0         if ( $self->error ){
143 0           return undef;
144             }
145              
146 0           return $self->{mode};
147             }
148              
149             =head2 setMode
150              
151             This changes the currently set mode.
152              
153             One argument is accepted and it is the current mode.
154              
155             $foo->setMode('0640')';
156             if($foo->error){
157             warn('error:'.$foo->error.': '.$foo->errorString);
158             }
159              
160             =cut
161              
162             sub setMode{
163 0     0 1   my $self=$_[0];
164 0           my $mode=$_[1];
165              
166 0           $self->errorblank;
167 0 0         if ( $self->error ){
168 0           return undef;
169             }
170            
171             # make sure it is a valid mode
172 0 0         if ( $mode !~ /^[01246][01234567][01234567][01234567]$/ ){
173 0           $self->{error}=1;
174 0           $self->{errorString}='';
175 0           return $self;
176             }
177              
178 0           $self->{mode}=$mode;
179              
180 0           return 1;
181             }
182              
183             =head2 setModeFromFile
184              
185             This sets the current mode from a file.
186              
187             One argument is required and it the file/directory/etc in question.
188              
189             $foo->setModeFromFile($file);
190             if( $foo->error ){
191             warn('error:'.$foo->error.': '.$foo->errorString);
192             }
193              
194             =cut
195              
196             sub setModeFromFile{
197 0     0 1   my $self=$_[0];
198 0           my $file=$_[1];
199            
200 0           $self->errorblank;
201 0 0         if ( $self->error ){
202 0           return undef;
203             }
204              
205             #make sure the file is defined
206 0 0         if( ! defined( $file ) ){
207 0           $self->{error}=2;
208 0           $self->{errorString}='No file specified';
209 0           return undef;
210             }
211              
212             #make sure the item exists
213 0 0         if ( ! -e $file ){
214 0           $self->{error}=3;
215 0           $self->{errorString}='"'.$file.'" does not exist';
216 0           return undef;
217             }
218              
219             #stat the file and get it
220 0           my $mode = (stat($file))[2] & 07777;
221 0           $mode=sprintf("%04o", $mode);
222              
223 0           $self->{mode}=$mode;
224              
225 0           return 1;
226             }
227              
228             =head1 ERROR CODES
229              
230             =head2 1
231              
232             Invalid mode.
233              
234             This means it did not match the regexp below.
235              
236             /^[01246][01234567][01234567][01234567]$/
237              
238             =head2 2
239              
240             No file specified.
241              
242             =head2 3
243              
244             The file does not exist.
245              
246             =head2 4
247              
248             Failed to chmod the file.
249              
250             =head1 AUTHOR
251              
252             Zane C. Bowers-Hadley, C<< >>
253              
254             =head1 BUGS
255              
256             Please report any bugs or feature requests to C, or through
257             the web interface at L. I will be notified, and then you'll
258             automatically be notified of progress on your bug as I make changes.
259              
260              
261              
262              
263             =head1 SUPPORT
264              
265             You can find documentation for this module with the perldoc command.
266              
267             perldoc File::Permissions::Unix
268              
269              
270             You can also look for information at:
271              
272             =over 4
273              
274             =item * RT: CPAN's request tracker
275              
276             L
277              
278             =item * AnnoCPAN: Annotated CPAN documentation
279              
280             L
281              
282             =item * CPAN Ratings
283              
284             L
285              
286             =item * Search CPAN
287              
288             L
289              
290             =back
291              
292              
293             =head1 ACKNOWLEDGEMENTS
294              
295              
296             =head1 LICENSE AND COPYRIGHT
297              
298             Copyright 2011 Zane C. Bowers-Hadley.
299              
300             This program is free software; you can redistribute it and/or modify it
301             under the terms of either: the GNU General Public License as published
302             by the Free Software Foundation; or the Artistic License.
303              
304             See http://dev.perl.org/licenses/ for more information.
305              
306              
307             =cut
308              
309             1; # End of File::Permissions::Unix