File Coverage

blib/lib/Filesys/POSIX/Bits/System.pm
Criterion Covered Total %
statement 66 68 97.0
branch 68 76 89.4
condition 1 2 50.0
subroutine 8 8 100.0
pod 3 3 100.0
total 146 157 92.9


line stmt bran cond sub pod time code
1             # Copyright (c) 2014, cPanel, Inc.
2             # All rights reserved.
3             # http://cpanel.net/
4             #
5             # This is free software; you can redistribute it and/or modify it under the same
6             # terms as Perl itself. See the LICENSE file for further details.
7              
8             package Filesys::POSIX::Bits::System;
9              
10 29     29   698 use strict;
  29         30  
  29         604  
11 29     29   110 use warnings;
  29         29  
  29         483  
12              
13 29     29   84 use Fcntl ();
  29         28  
  29         336  
14 29     29   81 use Filesys::POSIX::Bits;
  29         24  
  29         20153  
15              
16             =head1 NAME
17              
18             Filesys::POSIX::Bits::System - Bitfield and constant conversions for file modes
19             and system call flags to system values
20              
21             =head1 DESCRIPTION
22              
23             This file contains functions to convert the values of bitfields and constants
24             from the values defined in C to the values used by the
25             system, defined in C. Only exported values are supported.
26              
27             The following (unexported) functions are provided:
28              
29             =over
30              
31             =item C
32              
33             Converts the constants beginning with 'C<$O_>' to their values on the current
34             system. These constants are generally used in the C<$flags> field of
35             C.
36              
37             Values that are not supported by this system will throw a warning and will be
38             left out of the returned value. The flags must include an access mode (e.g.
39             C<$O_RDONLY>, C<$O_WRONLY>, xor C<$O_RDWR>) in addition to any other values
40             desired. If an access mode is not provided or its value is unknown to
41             C, then the function will die.
42              
43             Note that C<$O_EVTONLY> is specific to this module and unsupported by C.
44             Trying to convert it to a system value will result in a warning.
45              
46             =cut
47              
48             sub convertFlagsToSystem {
49 22     22 1 2569 my $value = shift;
50 22         22 my $out;
51              
52             # Handle access modes first
53 22         26 my $access = $value & $Filesys::POSIX::Bits::O_MODE;
54 22 100       67 if ( $access == $O_RDWR ) {
    100          
    50          
55 1         3 $out = &Fcntl::O_RDWR;
56             }
57             elsif ( $access == $O_WRONLY ) {
58 3         8 $out = &Fcntl::O_WRONLY;
59             }
60             elsif ( $access == $O_RDONLY ) {
61 18         34 $out = &Fcntl::O_RDONLY;
62             }
63             else {
64 0         0 die "Unknown access mode: $access";
65             }
66              
67 22 100       52 $out |= _getOrWarn('O_APPEND') if $value & $O_APPEND;
68 22 100       39 $out |= _getOrWarn('O_CREAT') if $value & $O_CREAT;
69 22 100       45 $out |= _getOrWarn('O_EXCL') if $value & $O_EXCL;
70 22 50       43 $out |= _getOrWarn('O_EXLOCK') if $value & $O_EXLOCK;
71 22 100       36 $out |= _getOrWarn('O_NOFOLLOW') if $value & $O_NOFOLLOW;
72 22 100       48 $out |= _getOrWarn('O_NONBLOCK') if $value & $O_NONBLOCK;
73 22 50       35 $out |= _getOrWarn('O_SHLOCK') if $value & $O_SHLOCK;
74 22 100       35 $out |= _getOrWarn('O_TRUNC') if $value & $O_TRUNC;
75              
76 22 50       32 warn "O_EVTONLY is not supported by Fcntl" if $value & $O_EVTONLY;
77              
78 22         288 return $out;
79             }
80              
81             =item C
82              
83             Converts the constants beginning with 'C<$S_I>' to their values on the current
84             system. These constants are generally used in the C<$mode> field of C
85             and in the C<$mode> field of C.
86              
87             File types that are not supported by this system will throw a warning and will
88             be left out of the returned value. The mode may include zero or one file type
89             (values beginning with C<$S_IF>), but not more. If a file type unknown to
90             C is provided, then the function will die.
91              
92             =cut
93              
94             sub convertModeToSystem {
95 22     22 1 5354 my $value = shift;
96              
97 22         21 my $out = 0;
98              
99             # Convert file types (system support may vary)
100 22         24 my $type = $value & $S_IFMT;
101 22 100       48 if ($type) {
102 10         8 my $name;
103 10 100       18 $name = 'S_IFIFO' if $type == $S_IFIFO;
104 10 100       13 $name = 'S_IFCHR' if $type == $S_IFCHR;
105 10 100       17 $name = 'S_IFDIR' if $type == $S_IFDIR;
106 10 100       13 $name = 'S_IFBLK' if $type == $S_IFBLK;
107 10 100       13 $name = 'S_IFREG' if $type == $S_IFREG;
108 10 100       22 $name = 'S_IFLNK' if $type == $S_IFLNK;
109 10 100       14 $name = 'S_IFSOCK' if $type == $S_IFSOCK;
110 10 50       16 $name = 'S_IFWHT' if $type == $S_IFWHT;
111 10 50       13 die "Unknown file type: $type" if !$name;
112              
113 10         17 $out = _getOrWarn($name);
114             }
115              
116             # Convert permissions
117 22 100       40 $out |= &Fcntl::S_IRUSR if $value & $S_IRUSR;
118 22 100       33 $out |= &Fcntl::S_IWUSR if $value & $S_IWUSR;
119 22 100       31 $out |= &Fcntl::S_IXUSR if $value & $S_IXUSR;
120 22 100       32 $out |= &Fcntl::S_IRGRP if $value & $S_IRGRP;
121 22 100       34 $out |= &Fcntl::S_IWGRP if $value & $S_IWGRP;
122 22 100       30 $out |= &Fcntl::S_IXGRP if $value & $S_IXGRP;
123 22 100       36 $out |= &Fcntl::S_IROTH if $value & $S_IROTH;
124 22 100       31 $out |= &Fcntl::S_IWOTH if $value & $S_IWOTH;
125 22 100       33 $out |= &Fcntl::S_IXOTH if $value & $S_IXOTH;
126              
127             # Convert sticky bits
128 22 100       30 $out |= &Fcntl::S_ISUID if $value & $S_ISUID;
129 22 100       30 $out |= &Fcntl::S_ISGID if $value & $S_ISGID;
130 22 100       28 $out |= &Fcntl::S_ISVTX if $value & $S_ISVTX;
131              
132 22         155 return $out;
133             }
134              
135             =item C
136              
137             Converts the constants beginning with 'C<$SEEK_>' to their values on the
138             current system. These constants are generally used in the C<$whence> field
139             of C.
140              
141             If a value unknown to C is provided, then the function
142             will die.
143              
144             =cut
145              
146             sub convertWhenceToSystem {
147 4     4 1 1011 my $value = shift;
148              
149 4 100       17 if ( $value == $SEEK_SET ) {
    100          
    50          
150 2         13 return &Fcntl::SEEK_SET;
151             }
152             elsif ( $value == $SEEK_CUR ) {
153 1         5 return &Fcntl::SEEK_CUR;
154             }
155             elsif ( $value == $SEEK_END ) {
156 1         4 return &Fcntl::SEEK_END;
157             }
158             else {
159 0         0 die "Unknown whence value: $value";
160             }
161             }
162              
163             =back
164              
165             =cut
166              
167             # Private function that either returns the requested value from Fcntl or
168             # throws a warning. If a warning is thrown, the value 0 is returned.
169             sub _getOrWarn {
170 29     29   36 my $var = shift;
171              
172 29   50     1482 my $value = eval("\&Fcntl::$var") || 0;
173 29 50       79 warn "$var is not supported by this system" if $@;
174              
175 29         40 return $value;
176             }
177              
178             1;
179              
180             =head1 DIAGNOSTICS
181              
182             =over
183              
184             =item I is not supported by this system
185              
186             The system's Fcntl does not have a value defined for the given I and
187             thus it can't (and won't) be converted.
188              
189             =item I is not supported by Fcntl
190              
191             The Fcntl module does not define the given I and thus it can't (and
192             won't) be converted.
193              
194             =item Unknown access mode: I
195              
196             The access mode provided does not match C<$O_RDONLY>, C<$O_WRONLY>, xor
197             C<$O_RDWR>; or an access mode was not provided at all.
198              
199             =item Unknown file type: I
200              
201             The optional file type component that was provided does not match one of:
202             C<$S_IFIFO>, C<$S_IFCHR>, C<$S_IFDIR>, C<$S_IFBLK>, C<$S_IFREG>, C<$S_IFLNK>,
203             C<$S_IFSOCK>, xor C<$S_IFWHT>.
204              
205             =item Unknown whence value: I
206              
207             The whence value provided was not one of: C<$SEEK_SET>, C<$SEEK_CUR>, xor
208             C<$SEEK_END>.
209              
210             =back
211              
212             =head1 KNOWN ISSUES
213              
214             =over
215              
216             =item SEEK_END is assumed to exist
217              
218             The C value C is assumed to exist when it is not specified
219             by POSIX, but is rather an almost ubiquitously supported extension.
220              
221             =back
222              
223             =head1 AUTHORS
224              
225             =over
226              
227             =item Rikus Goodell
228              
229             =item Brian Carlson
230              
231             =back
232              
233             =head1 COPYRIGHT
234              
235             Copyright (c) 2014, cPanel, Inc. Distributed under the terms of the Perl
236             Artistic license.