File Coverage

blib/lib/FileHandle/Fmode.pm
Criterion Covered Total %
statement 81 86 94.1
branch 47 54 87.0
condition 26 30 86.6
subroutine 12 12 100.0
pod 0 7 0.0
total 166 189 87.8


line stmt bran cond sub pod time code
1             package FileHandle::Fmode;
2 2     2   12761 use Fcntl qw(O_ACCMODE O_RDONLY O_WRONLY O_RDWR O_APPEND F_GETFL);
  2         5  
  2         205  
3 2     2   15 use strict;
  2         17  
  2         75  
4 2     2   12 use Config;
  2         3  
  2         258  
5              
6 2 50   2   14 use constant IS_WIN32 => $^O =~ /mswin32/i ? 1 : 0;
  2         6  
  2         407  
7 2 50   2   14 use constant LIBC_IS_UCRT => $Config{libc} =~ /\-lucrt$|ucrt\.lib$/i ? 1 : 0;
  2         5  
  2         2937  
8              
9             require Exporter;
10             require DynaLoader;
11              
12             *is_FH = \&is_arg_ok;
13              
14             our $VERSION = '0.15';
15             #$VERSION = eval $VERSION;
16              
17             @FileHandle::Fmode::ISA = qw(Exporter DynaLoader);
18              
19             @FileHandle::Fmode::EXPORT_OK = qw(is_R is_W is_RO is_WO is_RW is_arg_ok is_A is_FH);
20              
21             %FileHandle::Fmode::EXPORT_TAGS = (all => [qw
22             (is_R is_W is_RO is_WO is_RW is_arg_ok is_A is_FH)]);
23              
24             FileHandle::Fmode->DynaLoader::bootstrap($VERSION);
25              
26             sub is_arg_ok {
27 80     80 0 431594 my $fileno = eval{fileno($_[0])};
  80         179  
28 80 100       197 if($@) {return 0}
  2         8  
29 78 100       184 if(defined($fileno)) {
30 76 100       165 if($fileno == -1) {
31 20 50       46 if($] < 5.007) {return 0}
  0         0  
32 20         49 return 1;
33             }
34 56         146 return 1;
35             }
36 2         6 return 0;
37             }
38              
39             sub is_RO {
40 88     88 0 355 my $fileno = fileno($_[0]);
41 84 100       190 if(!defined( $fileno)) {die "Not an open filehandle"}
  4         22  
42 80 100 100     286 if( $fileno == -1 || (IS_WIN32 && LIBC_IS_UCRT)) {
43 24 50       51 if($] < 5.007) {die "Illegal fileno() return"}
  0         0  
44 24 100 100     123 if(perliol_readable($_[0]) && !perliol_writable($_[0])) {return 1}
  4         15  
45 20         65 return 0;
46             }
47 56         82 if(IS_WIN32 && !LIBC_IS_UCRT) {
48             if(win32_fmode($_[0]) & 1) {return 1}
49             return 0;
50             }
51 56         203 my $fmode = fcntl($_[0], F_GETFL, my $slush = 0);
52 56 100 66     224 if(defined($fmode) && ($fmode & O_ACCMODE) == O_RDONLY) {return 1}
  16         76  
53 40         119 return 0;
54             }
55              
56             sub is_WO {
57 88     88 0 232 my $fileno = fileno($_[0]);
58 84 100       203 if(!defined( $fileno)) {die "Not an open filehandle"}
  4         17  
59 80 100 100     301 if( $fileno == -1 || (IS_WIN32 && LIBC_IS_UCRT)) {
60 24 50       82 if($] < 5.007) {die "Illegal fileno() return"}
  0         0  
61 24 100 66     104 if(!perliol_readable($_[0]) && perliol_writable($_[0])) {return 1}
  8         25  
62 16         46 return 0;
63             }
64 56         78 if(IS_WIN32 && !LIBC_IS_UCRT) {
65             if(win32_fmode($_[0]) & 2) {return 1}
66             return 0;
67             }
68 56         187 my $fmode = fcntl($_[0], F_GETFL, my $slush = 0);
69 56 100 66     213 if(defined($fmode) && ($fmode & O_ACCMODE) == O_WRONLY) {return 1}
  16         47  
70 40         112 return 0;
71             }
72              
73             sub is_W {
74 44 100 100 44 0 174 if(is_WO($_[0]) || is_RW($_[0])) {return 1}
  30         74  
75 10         28 return 0;
76             }
77              
78             sub is_R {
79 44 100 100 44 0 227 if(is_RO($_[0]) || is_RW($_[0])) {return 1}
  28         71  
80 12         27 return 0;
81             }
82              
83             sub is_RW {
84 102     102 0 316 my $fileno = fileno($_[0]);
85 100 100       268 if(!defined( $fileno)) {die "Not an open filehandle"}
  2         10  
86 98 100 100     352 if( $fileno == -1 || (IS_WIN32 && LIBC_IS_UCRT)) {
87 30 50       67 if($] < 5.007) {die "Illegal fileno() return"}
  0         0  
88 30 100 100     141 if(perliol_readable($_[0]) && perliol_writable($_[0])) {return 1}
  18         56  
89 12         35 return 0;
90             }
91 68         100 if(IS_WIN32 && !LIBC_IS_UCRT) {
92             if(win32_fmode($_[0]) & 128) {return 1}
93             return 0;
94             }
95 68         227 my $fmode = fcntl($_[0], F_GETFL, my $slush = 0);
96 68 100 66     259 if(defined($fmode) && ($fmode & O_ACCMODE) == O_RDWR) {return 1}
  36         122  
97 32         92 return 0;
98             }
99              
100             sub is_A {
101 44     44 0 466 my $fileno = fileno($_[0]);
102 42 100       92 if(!defined( $fileno)) {die "Not an open filehandle"}
  2         15  
103 40 100       89 if( $fileno == -1) {
104 12 50       37 if($] < 5.007) {die "Illegal fileno() return"}
  0         0  
105 12         41 return is_appendable($_[0]);
106             }
107 28         43 if(IS_WIN32) {
108             if($] < 5.006001) {die "is_A not currently implemented on Win32 for pre-5.6.1 perl"}
109             return is_appendable($_[0]);
110             }
111 28         89 my $fmode = fcntl($_[0], F_GETFL, my $slush = 0);
112 28 100       65 if($fmode & O_APPEND) {return 1}
  8         21  
113 20         42 return 0;
114             }
115              
116             1;
117              
118             __END__