The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

MLUKER / RSH-ConfigFile-1.0.10 / lib / RSH / FileUtil.pm 

            

              
—
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
—
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
—
50
51
52
53
54
55
56
—
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
—
106
107
108
109
110
111
112
—
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134

              
=head1 NAME
RSH::FileUtil - TODO RSH::FileUtil description.
=head1 SYNOPSIS
  use RSH::FileUtil;
  blah blah blah
=head1 DESCRIPTION
Stub documentation for RSH::FileUtil, created by epic. It looks like the
author of the extension was negligent enough to leave the stub
unedited.
Blah blah blah.
=cut
package RSH::FileUtil;
use 5.008;
use strict;
use warnings;
use base qw(Exporter);
# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.
=head2 EXPORT
None by default.
=cut
our @EXPORT_OK = qw(&get_filehandle);
our @EXPORT    = qw(
                                         
                                   );
our $VERSION = '0.0.1';
# use/imports go here
use FileHandle;
# ******************** Class Methods ********************
=head2 FUNCTIONS
=over
=cut
=item get_filehandle($filename, 'READ'|'WRITE'|'RDWR'|'APPEND', [%args]')
Takes care of the logic for getting a filehandle, especially if no_follow => 1.
=cut
sub get_filehandle {
        my $filename = shift;
        my $type = shift;
        my %args = @_;
        my $fh = undef;
        my $flags = undef;
        if ($type eq 'READ') { $flags = O_RDONLY; }
        elsif ($type eq 'WRITE') { $flags = (O_WRONLY | O_CREAT); }
        elsif ($type eq 'RDWR') { $flags = (O_RDWR | O_CREAT); }
        elsif ($type eq 'APPEND') { $flags = (O_WRONLY | O_APPEND | O_CREAT); }
         
        if (defined($args{exclusive}) && ($args{exclusive} eq '1')) {
            $flags = $flags | O_EXCL;
        }
        if (($type eq 'WRITE') and (not defined($args{no_truncate}) or ($args{no_truncate} eq '0'))) {
           # by default, we truncate for writing, to make it work like perl defaults ...  
       $flags = $flags | O_TRUNC;
        }
        if (defined($args{no_follow}) && ($args{no_follow} eq '1')) {
                # Do not follow symlinks--useful for the paranoid in cases of
                # sensitive data that should not be moved.
                eval {
                        $fh = new FileHandle $filename, $flags | O_NOFOLLOW;
                };
                if ($@) {
                        # catches O_NOFOLLOW not being defined--i.e. on filesystems that have
                        # no concept of symlinks or following.  Paranoid or not, if it isn't
                        # supported we have to just make do
                        $fh = new FileHandle $filename, $flags | O_NOFOLLOW;
                }
        } else {
                # Just get a file handle and don't worry about whether we are following
                # symlinks
                $fh = new FileHandle $filename, $flags;
        }
        return $fh;
}
=back
=cut
# #################### RSH::FileUtil.pm ENDS ####################
1;
=head1 SEE ALSO
http://www.rshtech.com/software/
=head1 AUTHOR
Matt Luker  C<< <mluker@cpan.org> >>
=head1 COPYRIGHT AND LICENSE
Copyright 2007-2008 by Matt Luker
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself. 
=cut
__END__
# ---------------------------------------------------------------------
#  $Log$
# ---------------------------------------------------------------------