File Coverage

blib/lib/RSH/FileUtil.pm
Criterion Covered Total %
statement 30 36 83.3
branch 7 16 43.7
condition 6 12 50.0
subroutine 6 6 100.0
pod 1 1 100.0
total 50 71 70.4


line stmt bran cond sub pod time code
1             =head1 NAME
2              
3             RSH::FileUtil - TODO RSH::FileUtil description.
4              
5             =head1 SYNOPSIS
6              
7             use RSH::FileUtil;
8             blah blah blah
9              
10             =head1 DESCRIPTION
11              
12             Stub documentation for RSH::FileUtil, created by epic. It looks like the
13             author of the extension was negligent enough to leave the stub
14             unedited.
15              
16             Blah blah blah.
17              
18             =cut
19              
20             package RSH::FileUtil;
21              
22 3     3   43 use 5.008;
  3         11  
  3         103  
23 3     3   14 use strict;
  3         5  
  3         811  
24 3     3   23 use warnings;
  3         5  
  3         82  
25              
26 3     3   15 use base qw(Exporter);
  3         6  
  3         527  
27              
28             # Items to export into callers namespace by default. Note: do not export
29             # names by default without a very good reason. Use EXPORT_OK instead.
30             # Do not simply export all your public functions/methods/constants.
31              
32             =head2 EXPORT
33              
34             None by default.
35              
36             =cut
37              
38             our @EXPORT_OK = qw(&get_filehandle);
39              
40             our @EXPORT = qw(
41            
42             );
43              
44             our $VERSION = '0.0.1';
45              
46             # use/imports go here
47 3     3   6555 use FileHandle;
  3         41590  
  3         24  
48              
49             # ******************** Class Methods ********************
50              
51             =head2 FUNCTIONS
52              
53             =over
54              
55             =cut
56              
57              
58             =item get_filehandle($filename, 'READ'|'WRITE'|'RDWR'|'APPEND', [%args]')
59              
60             Takes care of the logic for getting a filehandle, especially if no_follow => 1.
61              
62             =cut
63              
64             sub get_filehandle {
65 19     19 1 37 my $filename = shift;
66 19         219 my $type = shift;
67 19         61 my %args = @_;
68              
69 19         28 my $fh = undef;
70              
71 19         41 my $flags = undef;
72 19 100       70 if ($type eq 'READ') { $flags = O_RDONLY; }
  9 50       20  
    0          
    0          
73 10         18 elsif ($type eq 'WRITE') { $flags = (O_WRONLY | O_CREAT); }
74 0         0 elsif ($type eq 'RDWR') { $flags = (O_RDWR | O_CREAT); }
75 0         0 elsif ($type eq 'APPEND') { $flags = (O_WRONLY | O_APPEND | O_CREAT); }
76            
77 19 100 66     131 if (defined($args{exclusive}) && ($args{exclusive} eq '1')) {
78 7         20 $flags = $flags | O_EXCL;
79             }
80              
81 19 50 33     117 if (($type eq 'WRITE') and (not defined($args{no_truncate}) or ($args{no_truncate} eq '0'))) {
      66        
82             # by default, we truncate for writing, to make it work like perl defaults ...
83 10         18 $flags = $flags | O_TRUNC;
84             }
85              
86 19 50 33     69 if (defined($args{no_follow}) && ($args{no_follow} eq '1')) {
87             # Do not follow symlinks--useful for the paranoid in cases of
88             # sensitive data that should not be moved.
89 0         0 eval {
90 0         0 $fh = new FileHandle $filename, $flags | O_NOFOLLOW;
91             };
92 0 0       0 if ($@) {
93             # catches O_NOFOLLOW not being defined--i.e. on filesystems that have
94             # no concept of symlinks or following. Paranoid or not, if it isn't
95             # supported we have to just make do
96 0         0 $fh = new FileHandle $filename, $flags | O_NOFOLLOW;
97             }
98             } else {
99             # Just get a file handle and don't worry about whether we are following
100             # symlinks
101 19         175 $fh = new FileHandle $filename, $flags;
102             }
103              
104 19         31241 return $fh;
105             }
106              
107             =back
108              
109             =cut
110              
111             # #################### RSH::FileUtil.pm ENDS ####################
112             1;
113              
114             =head1 SEE ALSO
115              
116             http://www.rshtech.com/software/
117              
118             =head1 AUTHOR
119              
120             Matt Luker C<< <mluker@cpan.org> >>
121              
122             =head1 COPYRIGHT AND LICENSE
123              
124             Copyright 2007-2008 by Matt Luker
125              
126             This library is free software; you can redistribute it and/or modify
127             it under the same terms as Perl itself.
128              
129             =cut
130              
131             __END__
132             # ---------------------------------------------------------------------
133             # $Log$
134             # ---------------------------------------------------------------------