File Coverage

blib/lib/File/Open.pm
Criterion Covered Total %
statement 71 71 100.0
branch 70 84 83.3
condition 4 22 18.1
subroutine 19 19 100.0
pod 6 6 100.0
total 170 202 84.1


line stmt bran cond sub pod time code
1             package File::Open;
2              
3 6     6   1408441 use strict;
  6         37  
  6         174  
4 6     6   32 use warnings;
  6         12  
  6         239  
5 6 50   6   560 BEGIN { warnings->import(FATAL => 'layer') if $^V ge v5.8.0; }
6              
7             our $VERSION = '1.0103';
8              
9 6     6   44 use File::Basename qw(basename);
  6         10  
  6         547  
10 6     6   46 use Carp qw(croak);
  6         20  
  6         246  
11 6     6   48 use Fcntl ();
  6         11  
  6         118  
12 6     6   1443 use Errno ();
  6         4056  
  6         133  
13 6     6   33 use Exporter (); BEGIN { our @ISA = 'Exporter'; }
  6     6   12  
  6         204  
  6         6649  
14              
15             our @EXPORT_OK = qw(
16             fopen fopen_nothrow
17             fsysopen fsysopen_nothrow
18             fopendir fopendir_nothrow
19             );
20              
21             sub _mode {
22 36     36   54 map { $_ => $_[0] } @_
  72         216  
23             }
24              
25             my %modemap = (
26             _mode(qw[< r ]),
27             _mode(qw[> w ]),
28             _mode(qw[>> a ]),
29             _mode(qw[+< r+]),
30             _mode(qw[+> w+]),
31             _mode(qw[+>> a+]),
32             );
33              
34             sub _open {
35 112     112   282 my ($func, $file, $mode, $layers) = @_;
36 112 100       511 @_ < 2 and croak "Not enough arguments for $func";
37 110 100       416 @_ > 4 and croak "Too many arguments for $func";
38 108 100       242 $mode = '<' if !defined $mode;
39              
40 108         409 my $binary = $mode =~ s/(?<=.)b//;
41 108 100       2703 my $emode = $modemap{$mode} or croak "Unknown $func() mode '$mode'";
42              
43 80 100       223 if ($file =~ /\0/) {
44 2 50       9 $! = Errno::ENOENT() if exists &Errno::ENOENT;
45 2         22 return undef;
46             }
47              
48 78 100       171 unless (defined $layers) {
49             # grab our caller's 'use open' settings
50 76         458 my $hints = (caller 1)[10];
51 76 100       252 my $key = $emode =~ />/ ? 'open>' : 'open<';
52 76         183 $layers = $hints->{$key};
53             }
54              
55 78 100       3134 open my $fh, $emode . (defined $layers ? " $layers" : ''), $file or return undef;
    100          
56 42 100       463 binmode $fh if $binary;
57 42         260 $fh
58             }
59              
60             sub fopen_nothrow {
61 51     51 1 41015 _open('fopen_nothrow', @_)
62             }
63              
64             my $prog = basename $0;
65              
66             sub fopen {
67 61 100   61 1 62645 _open('fopen', @_) || die "$prog: $_[0]: $!\n"
68             }
69              
70             sub _sysopen {
71 84     84   188 my ($func, $file, $mode, $flags) = @_;
72 84 100       508 @_ < 3 and croak "Not enough arguments for $func";
73 80 100       364 @_ > 4 and croak "Too many arguments for $func";
74              
75 78 100       2039 my $emode =
    100          
    100          
76             $mode eq 'r' ? Fcntl::O_RDONLY() :
77             $mode eq 'w' ? Fcntl::O_WRONLY() :
78             $mode eq 'rw' ? Fcntl::O_RDWR() :
79             croak "Unknown $func() mode '$mode'"
80             ;
81 56 100       162 $flags = {} if !defined $flags;
82              
83 56         77 my $perms = 0;
84              
85 56         182 for my $k (keys %$flags) {
86 61         145 my $v = !!$flags->{$k};
87             $emode |=
88             $k eq 'creat' ?
89 61 50 50     2179 defined $flags->{$k} ? do {
    100 0        
    50 0        
    50 0        
    50 100        
    50 0        
    50 0        
    100 0        
    50 0        
    50 0        
    50 50        
    100          
    100          
90 16         42 $perms = $flags->{$k};
91 16         36 Fcntl::O_CREAT()
92             } :
93             0
94             :
95             $k eq 'append' ? $v && Fcntl::O_APPEND() :
96             $k eq 'async' ? $v && Fcntl::O_ASYNC() :
97             $k eq 'direct' ? $v && Fcntl::O_DIRECT() :
98             $k eq 'directory' ? $v && Fcntl::O_DIRECTORY() :
99             $k eq 'excl' ? $v && Fcntl::O_EXCL() :
100             $k eq 'noatime' ? $v && Fcntl::O_NOATIME() :
101             $k eq 'noctty' ? $v && Fcntl::O_NOCTTY() :
102             $k eq 'nofollow' ? $v && Fcntl::O_NOFOLLOW() :
103             $k eq 'nonblock' ? $v && Fcntl::O_NONBLOCK() :
104             $k eq 'sync' ? $v && Fcntl::O_SYNC() :
105             $k eq 'trunc' ? $v && Fcntl::O_TRUNC() :
106             croak "Unknown $func() flag '$k'"
107             ;
108             }
109              
110 38 100       126 if ($file =~ /\0/) {
111 2 50       6 $! = Errno::ENOENT() if exists &Errno::ENOENT;
112 2         13 return undef;
113             }
114              
115 36 100       1335 sysopen my $fh, $file, $emode, $perms or return undef;
116 20         143 $fh
117             }
118              
119             sub fsysopen_nothrow {
120 42     42 1 16250 _sysopen('fsysopen_nothrow', @_)
121             }
122              
123             sub fsysopen {
124 42 100   42 1 17657 _sysopen('fsysopen', @_) || die "$prog: $_[0]: $!\n"
125             }
126              
127             sub _opendir {
128 8     8   21 my ($func, $dir) = @_;
129 8 100       160 @_ < 2 and croak "Not enough arguments for $func";
130 6 100       211 @_ > 2 and croak "Too many arguments for $func";
131              
132 4 100       15 if ($dir =~ /\0/) {
133 2 50       6 $! = Errno::ENOENT() if exists &Errno::ENOENT;
134 2         16 return undef;
135             }
136              
137 2 50       29 opendir my $dh, $dir or return undef;
138 2         164 $dh
139             }
140              
141             sub fopendir_nothrow {
142 3     3 1 50 _opendir('fopendir_nothrow', @_)
143             }
144              
145             sub fopendir {
146 5 100   5 1 8705 _opendir('fopendir', @_) || die "$prog: $_[0]: $!\n"
147             }
148              
149             'ok'
150              
151             __END__