File Coverage

blib/lib/NetSDS/Util/File.pm
Criterion Covered Total %
statement 30 137 21.9
branch 0 52 0.0
condition 0 5 0.0
subroutine 10 23 43.4
pod 13 13 100.0
total 53 230 23.0


line stmt bran cond sub pod time code
1             #===============================================================================
2             #
3             # FILE: File.pm
4             #
5             # DESCRIPTION: NetSDS utilities for file operations
6             #
7             # AUTHOR: Michael Bochkaryov (Rattler),
8             # COMPANY: Net.Style
9             # VERSION: 1.044
10             # CREATED: 16.07.2008 18:25:48 EEST
11             #===============================================================================
12              
13             =head1 NAME
14              
15             NetSDS::Util::File - file related utilities
16              
17             =head1 SYNOPSIS
18              
19             use NetSDS::Util::File qw(file_read);
20              
21             my $passwd = file_read('/etc/passwd');
22              
23             file_move('/etc/passwd', '/tmp/find_this');
24              
25             =head1 DESCRIPTION
26              
27             C module contains some routines for files
28             and directories processing tasks like creating, reading, writing,
29             copying and moving files and catalogs.
30              
31             This module of cource uses such well known things like L,
32             L, L and others.
33              
34             =cut
35              
36             package NetSDS::Util::File;
37              
38 2     2   6888 use 5.8.0;
  2         7  
  2         79  
39 2     2   7 use strict;
  2         3  
  2         51  
40 2     2   7 use warnings;
  2         4  
  2         49  
41              
42 2     2   6 use POSIX;
  2         2  
  2         14  
43 2     2   3360 use File::Spec;
  2         3  
  2         43  
44 2     2   1006 use File::Copy;
  2         3867  
  2         129  
45 2     2   12 use File::Path;
  2         2  
  2         82  
46 2     2   1416 use File::Temp ();
  2         31304  
  2         59  
47              
48 2     2   13 use base 'Exporter';
  2         3  
  2         164  
49              
50 2     2   9 use version; our $VERSION = "1.044";
  2         2  
  2         27  
51             our @EXPORT = qw(
52             is_handle
53             reset_handle
54             file_open
55             file_read
56             file_write
57             file_copy
58             file_move
59             file_temp
60             dir_create
61             dir_delete
62             dir_read
63             dir_read_recursive
64             exec_external
65             );
66              
67             #***********************************************************************
68              
69             =head1 EXPORTED FUNCTIONS
70              
71             =over
72              
73             =item B - check if argument is a file handle
74              
75             Paramters: some variable
76              
77             Returns: 1 if it's file handle or undef otherwise
78              
79             if (is_handle($var)) {
80              
81             reset_handle($fh);
82              
83             }
84              
85             =cut
86              
87             #-----------------------------------------------------------------------
88              
89             sub is_handle {
90 0     0 1   my ( $fh, @list ) = @_;
91              
92 0           push( @list, qw(IO::Scalar IO::Handle GLOB) );
93 0           foreach my $class (@list) {
94 0 0         if ( UNIVERSAL::isa( $fh, $class ) ) {
95 0           return 1;
96             }
97             }
98              
99 0           return 0;
100             }
101              
102             #***********************************************************************
103              
104             =item B - reset file handle
105              
106             Paramters: file handle
107              
108             Returns: nothing
109              
110             This function tries to set filehandle to begin of file and set binmode on it.
111              
112             my $fh = file_open('/etc/passwd');
113             ...
114             do something with file
115             ...
116             reset_handle($fh); # We can read it from the beginning
117              
118             =cut
119              
120             #-----------------------------------------------------------------------
121              
122             sub reset_handle {
123 0     0 1   my ($fh) = @_;
124              
125 0 0         if ( $fh->can('binmode') ) {
126 0           $fh->binmode;
127             } else {
128 0           binmode($fh);
129             }
130              
131 0 0         if ( $fh->can('seek') ) {
132 0           $fh->seek( 0, 0 );
133             }
134             }
135              
136             #***********************************************************************
137              
138             =item B - open file
139              
140             Paramters: file name or file handle
141              
142             Returns: file handle
143              
144             This function provides unified API for opening files.
145              
146             my $f = file_open('/etc/passwd');
147              
148             =cut
149              
150             #-----------------------------------------------------------------------
151              
152             sub file_open {
153 0     0 1   my $fil = shift;
154              
155 0           my $fh;
156 0           my $st = 1;
157 0 0         if ( ref($fil) ) {
158 0 0         if ( is_handle($fil) ) {
159 0           $fh = $fil;
160             } else {
161 0           require IO::File;
162 0           $fh = IO::File->new;
163 0           $st = $fh->fdopen( $fil, @_ );
164             }
165             } else {
166 0           require IO::File;
167 0           $fh = IO::File->new;
168 0           $st = $fh->open( $fil, @_ );
169             }
170              
171 0 0         if ($st) {
172 0           reset_handle($fh);
173             } else {
174 0           return undef;
175             }
176              
177 0           return $fh;
178             } ## end sub file_open
179              
180             #***********************************************************************
181              
182             =item B - read file to scalar
183              
184             Paramters: file name or file handle
185              
186             Returns: scalar content of file
187              
188             This function provides ability to read file content to scalar variable.
189              
190             my $data = file_read('/etc/passwd');
191              
192             print "Passwords file: $data\n";
193              
194             =cut
195              
196             #-----------------------------------------------------------------------
197              
198             sub file_read {
199 0     0 1   my $fil = shift;
200              
201 0           my $bin = undef;
202              
203 0 0         my $fh = file_open( $fil, ( scalar(@_) > 0 ) ? @_ : 'r' );
204              
205 0 0         if ( defined($fh) ) {
206 0           local $/ = undef;
207 0           $bin = <$fh>;
208 0           $fh->close;
209 0           $/ = "\n";
210             }
211              
212 0           return $bin;
213             }
214              
215             #***********************************************************************
216              
217             =item B - write scalar data to file
218              
219             Paramters: file name or open file handle
220              
221             Returns: length of written data or undef in case of error
222              
223             my $data = 'This should be file';
224              
225             file_write('/tmp/file.dat', $data);
226              
227             =cut
228              
229             #-----------------------------------------------------------------------
230              
231             sub file_write {
232 0     0 1   my $fil = shift;
233 0           my $bin = shift;
234              
235 0 0         my $fh = file_open( $fil, ( scalar(@_) > 0 ) ? @_ : 'w+' );
236              
237 0 0         if ( defined($fh) ) {
238 0           $fh->print($bin);
239 0           $fh->close;
240 0           return bytes::length($bin);
241             } else {
242 0           return undef;
243             }
244             }
245              
246             #***********************************************************************
247              
248             =item B - copy file
249              
250             Paramters: input file name, output file name
251              
252             Returns:
253              
254             This function copy file to new location.
255              
256             =cut
257              
258             #-----------------------------------------------------------------------
259              
260             sub file_copy {
261 0     0 1   my ( $ifl, $ofl ) = @_;
262              
263 0 0         if ( is_handle($ifl) ) {
264 0           reset_handle($ifl);
265             }
266              
267 0 0         if ( copy( $ifl, $ofl ) ) {
268 0           return 1;
269             } else {
270 0           return undef;
271             }
272             }
273              
274             #***********************************************************************
275              
276             =item B - move file
277              
278             Paramters: input file name, output file name
279              
280             Returns: 1 or undef
281              
282             This function moves old file to new location.
283              
284             =cut
285              
286             #-----------------------------------------------------------------------
287              
288             sub file_move {
289 0     0 1   my ( $ifl, $ofl ) = @_;
290              
291 0 0         if ( is_handle($ifl) ) {
292 0           reset_handle($ifl);
293             }
294              
295 0 0         if ( move( $ifl, $ofl ) ) {
296 0           return 1;
297             } else {
298 0           return undef;
299             }
300             }
301              
302             #***********************************************************************
303              
304             =item B - create temporary file
305              
306             Creates new temp file and return its handle
307              
308             =cut
309              
310             #-----------------------------------------------------------------------
311              
312             sub file_temp {
313              
314 0     0 1   my ($dir) = @_;
315              
316 0           my %params = ();
317 0 0         if ($dir) { $params{DIR} = $dir; }
  0            
318              
319 0           my $fh = File::Temp->new(%params);
320              
321 0           return $fh;
322              
323             }
324              
325             #***********************************************************************
326              
327             =item B - create directory with parents
328              
329             Paramters: directory name
330              
331             Returns: directory name or undef
332              
333             # Will create all parent catalogs if necessary
334              
335             dir_create('/var/log/NetSDS/xxx');
336              
337             =cut
338              
339             #-----------------------------------------------------------------------
340              
341             sub dir_create {
342 0     0 1   my ( $dir, $mode ) = @_;
343 0   0       $mode ||= 0777 & ~umask();
344              
345 0           my $ret = '';
346 0           eval { $ret = mkpath( $dir, 0, $mode ); };
  0            
347 0 0         if ($@) {
348 0           return undef;
349             }
350              
351 0           return $dir;
352             }
353              
354             #***********************************************************************
355              
356             =item B - remove directory recursive
357              
358             Paramters: directory name
359              
360             Returns: dir name or undef if error
361              
362             print "We need no libs!";
363              
364             dir_delete('/usr/lib');
365              
366             =cut
367              
368             #-----------------------------------------------------------------------
369              
370             sub dir_delete {
371 0     0 1   my ($dir) = @_;
372              
373 0           my $ret = '';
374 0           eval { $ret = rmtree( $dir, 0, 1 ); };
  0            
375 0 0         if ($@) {
376 0           return undef;
377             }
378              
379 0           return $dir;
380             }
381              
382             #***********************************************************************
383              
384             =item B - read files list from catalog
385              
386             Paramters: directory name, extension of files to read
387              
388             Returns: list of files in catalog
389              
390             my @logs = @{ dir_read('/var/log/httpd', 'log') };
391              
392             print "Logs are: " . join (', ', @logs);
393              
394             =cut
395              
396             #-----------------------------------------------------------------------
397              
398             sub dir_read {
399 0     0 1   my ( $dir, $end ) = @_;
400              
401 0 0         if ( opendir( DIR, $dir ) ) {
402 0 0         my @con =
403             ( defined($end) )
404 0           ? sort grep { $_ !~ m/^[.]{1,2}$/ and $_ =~ m/^.+\.$end$/i } readdir(DIR)
405 0 0         : sort grep { $_ !~ m/^[.]{1,2}$/ } readdir(DIR);
406              
407 0           closedir(DIR);
408              
409 0           return \@con;
410             } else {
411 0           return undef;
412             }
413             }
414              
415             #***********************************************************************
416              
417             =item B - read all files list recursive
418              
419             Paramters: $start catalog, $extension
420              
421             Returns: list of files with extension from parameters
422              
423             my $tpls = dir_read_recursive('/etc/NetSDS', 'tmpl');
424              
425             foreach my $tpl (@$tpls) {
426              
427             pritn "Template: $tpl\n";
428              
429             }
430              
431             =cut
432              
433             #-----------------------------------------------------------------------
434              
435             sub dir_read_recursive {
436 0     0 1   my ( $dir, $ext, $res ) = @_;
437 0   0       $res ||= [];
438              
439 0           my $con = dir_read($dir);
440 0 0         if ( defined($con) ) {
441 0           foreach my $nam ( @{$con} ) {
  0            
442 0           my $fil = "$dir/$nam";
443 0 0         if ( -d $fil ) {
    0          
444 0           dir_read_recursive( $fil, $ext, $res );
445             } elsif ( $nam =~ m/^.+\.$ext$/i ) {
446 0           push( @{$res}, $fil );
  0            
447             }
448             }
449              
450 0           return $res;
451             } else {
452 0           return undef;
453             }
454             } ## end sub dir_read_recursive
455              
456             #***********************************************************************
457              
458             =item B - execute external program
459              
460             Paramters: pragram name, arguments list (see perldoc -f system)
461              
462             Returns: 1 if ok, undef otherwise
463              
464             This function calls system() with given parameters and returns 1 if everything
465             happened correctly (program executed and returned correct result).
466              
467             if (exec_external('/bin/rm', '-rf', '/')) {
468              
469             print "Hey! We removed the world!";
470              
471             }
472              
473             =cut
474              
475             #-----------------------------------------------------------------------
476              
477             sub exec_external {
478              
479 0     0 1   my $rc = system(@_);
480              
481 0 0         if ( $rc == -1 ) {
    0          
482 0           return undef;
483             } elsif ( $rc & 127 ) {
484 0           return undef;
485             } else {
486 0           my $cd = $rc >> 8;
487 0 0         if ( $cd == 0 ) {
488 0           return 1;
489             } else {
490 0           return undef;
491             }
492             }
493             }
494             #-----------------------------------------------------------------------
495              
496             1;
497              
498             __END__