File Coverage

blib/lib/FileHandle/Fmode.pm
Criterion Covered Total %
statement 72 89 80.9
branch 49 66 74.2
condition 20 24 83.3
subroutine 9 9 100.0
pod 0 7 0.0
total 150 195 76.9


line stmt bran cond sub pod time code
1             package FileHandle::Fmode;
2 2     2   1314 use Fcntl qw(O_ACCMODE O_RDONLY O_WRONLY O_RDWR O_APPEND F_GETFL);
  2         2  
  2         145  
3 2     2   9 use strict;
  2         3  
  2         2150  
4              
5             require Exporter;
6             require DynaLoader;
7              
8             *is_FH = \&is_arg_ok;
9              
10             our $VERSION = '0.14';
11             #$VERSION = eval $VERSION;
12              
13             @FileHandle::Fmode::ISA = qw(Exporter DynaLoader);
14              
15             @FileHandle::Fmode::EXPORT_OK = qw(is_R is_W is_RO is_WO is_RW is_arg_ok is_A is_FH);
16              
17             %FileHandle::Fmode::EXPORT_TAGS = (all => [qw
18             (is_R is_W is_RO is_WO is_RW is_arg_ok is_A is_FH)]);
19              
20             bootstrap FileHandle::Fmode $VERSION;
21              
22             my $is_win32 = $^O =~ /mswin32/i ? 1 : 0;
23              
24             sub is_arg_ok {
25 80     80 0 18638 my $fileno = eval{fileno($_[0])};
  80         169  
26 80 100       180 if($@) {return 0}
  2         7  
27 78 100       138 if(defined($fileno)) {
28 76 100       144 if($fileno == -1) {
29 20 50       42 if($] < 5.007) {return 0}
  0         0  
30 20         41 return 1;
31             }
32 56         119 return 1;
33             }
34 2         5 return 0;
35             }
36              
37             sub is_RO {
38 88     88 0 288 my $fileno = fileno($_[0]);
39 84 100       165 if(!defined( $fileno)) {die "Not an open filehandle"}
  4         21  
40 80 100       142 if( $fileno == -1) {
41 24 50       46 if($] < 5.007) {die "Illegal fileno() return"}
  0         0  
42 24 100 100     135 if(perliol_readable($_[0]) && !perliol_writable($_[0])) {return 1}
  4         34  
43 20         50 return 0;
44             }
45 56 50       100 if($is_win32) {
46 0 0       0 if(win32_fmode($_[0]) & 1) {return 1}
  0         0  
47 0         0 return 0;
48             }
49 56         189 my $fmode = fcntl($_[0], F_GETFL, my $slush = 0);
50 56 100 66     237 if(defined($fmode) && ($fmode & O_ACCMODE) == O_RDONLY) {return 1}
  16         46  
51 40         128 return 0;
52             }
53              
54             sub is_WO {
55 88     88 0 228 my $fileno = fileno($_[0]);
56 84 100       150 if(!defined( $fileno)) {die "Not an open filehandle"}
  4         18  
57 80 100       134 if( $fileno == -1) {
58 24 50       49 if($] < 5.007) {die "Illegal fileno() return"}
  0         0  
59 24 100 66     110 if(!perliol_readable($_[0]) && perliol_writable($_[0])) {return 1}
  8         16  
60 16         43 return 0;
61             }
62 56 50       97 if($is_win32) {
63 0 0       0 if(win32_fmode($_[0]) & 2) {return 1}
  0         0  
64 0         0 return 0;
65             }
66 56         198 my $fmode = fcntl($_[0], F_GETFL, my $slush = 0);
67 56 100 66     245 if(defined($fmode) && ($fmode & O_ACCMODE) == O_WRONLY) {return 1}
  16         41  
68 40         113 return 0;
69             }
70              
71             sub is_W {
72 44 100 100 44 0 180 if(is_WO($_[0]) || is_RW($_[0])) {return 1}
  30         57  
73 10         24 return 0;
74             }
75              
76             sub is_R {
77 44 100 100 44 0 218 if(is_RO($_[0]) || is_RW($_[0])) {return 1}
  28         51  
78 12         25 return 0;
79             }
80              
81             sub is_RW {
82 102     102 0 223 my $fileno = fileno($_[0]);
83 100 100       181 if(!defined( $fileno)) {die "Not an open filehandle"}
  2         18  
84 98 100       171 if( $fileno == -1) {
85 30 50       59 if($] < 5.007) {die "Illegal fileno() return"}
  0         0  
86 30 100 100     178 if(perliol_readable($_[0]) && perliol_writable($_[0])) {return 1}
  18         61  
87 12         36 return 0;
88             }
89 68 50       114 if($is_win32) {
90 0 0       0 if(win32_fmode($_[0]) & 128) {return 1}
  0         0  
91 0         0 return 0;
92             }
93 68         221 my $fmode = fcntl($_[0], F_GETFL, my $slush = 0);
94 68 100 66     289 if(defined($fmode) && ($fmode & O_ACCMODE) == O_RDWR) {return 1}
  36         111  
95 32         98 return 0;
96             }
97              
98             sub is_A {
99 44     44 0 201 my $fileno = fileno($_[0]);
100 42 100       86 if(!defined( $fileno)) {die "Not an open filehandle"}
  2         16  
101 40 100       86 if( $fileno == -1) {
102 12 50       26 if($] < 5.007) {die "Illegal fileno() return"}
  0         0  
103 12         37 return is_appendable($_[0]);
104             }
105 28 50       53 if($is_win32) {
106 0 0       0 if($] < 5.006001) {die "is_A not currently implemented on Win32 for pre-5.6.1 perl"}
  0         0  
107 0         0 return is_appendable($_[0]);
108             }
109 28         96 my $fmode = fcntl($_[0], F_GETFL, my $slush = 0);
110 28 100       57 if($fmode & O_APPEND) {return 1}
  8         52  
111 20         38 return 0;
112             }
113              
114             1;
115              
116             __END__