File Coverage

blib/lib/Sys/Filesystem/Unix.pm
Criterion Covered Total %
statement 43 103 41.7
branch 8 54 14.8
condition 4 27 14.8
subroutine 9 14 64.2
pod 5 6 83.3
total 69 204 33.8


line stmt bran cond sub pod time code
1             ############################################################
2             #
3             # $Id$
4             # Sys::Filesystem - Retrieve list of filesystems and their properties
5             #
6             # Copyright 2004,2005,2006 Nicola Worthington
7             # Copyright 2008-2020 Jens Rehsack
8             #
9             # Licensed under the Apache License, Version 2.0 (the "License");
10             # you may not use this file except in compliance with the License.
11             # You may obtain a copy of the License at
12             #
13             # http://www.apache.org/licenses/LICENSE-2.0
14             #
15             # Unless required by applicable law or agreed to in writing, software
16             # distributed under the License is distributed on an "AS IS" BASIS,
17             # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
18             # See the License for the specific language governing permissions and
19             # limitations under the License.
20             #
21             ############################################################
22              
23             package Sys::Filesystem::Unix;
24              
25             # vim:ts=4:sw=4:tw=78
26              
27 6     6   2566 use 5.008001;
  6         19  
28              
29 6     6   30 use strict;
  6         12  
  6         112  
30 6     6   27 use warnings;
  6         21  
  6         185  
31 6     6   40 use vars qw($VERSION);
  6         11  
  6         249  
32              
33 6     6   36 use Carp qw(croak);
  6         18  
  6         264  
34 6     6   34 use Cwd 'abs_path';
  6         11  
  6         260  
35 6     6   35 use Fcntl qw(:flock);
  6         16  
  6         830  
36 6     6   2619 use IO::File;
  6         49125  
  6         8470  
37              
38             $VERSION = '1.408';
39              
40             sub version()
41             {
42 0     0 1 0 return $VERSION;
43             }
44              
45             # Default fstab and mtab layout
46             my @keys = qw(fs_spec fs_file fs_vfstype fs_mntops fs_freq fs_passno);
47             my %special_fs = (
48             swap => 1,
49             proc => 1
50             );
51              
52             ## no critic (Subroutines::RequireArgUnpacking)
53             sub new
54             {
55 0 0   0 0 0 ref(my $class = shift) && croak 'Class name required';
56 0         0 my %args = @_;
57 0         0 my $self = bless({}, $class);
58 0 0       0 $args{canondev} and $self->{canondev} = 1;
59              
60             # Defaults
61 0   0     0 $args{fstab} ||= '/etc/fstab';
62 0   0     0 $args{mtab} ||= '/etc/mtab';
63              
64 0         0 $self->readFsTab($args{fstab}, \@keys, [0, 1, 2], \%special_fs);
65 0         0 $self->readMntTab($args{mtab}, \@keys, [0, 1, 2], \%special_fs);
66              
67 0         0 delete $self->{canondev};
68              
69 0         0 return $self;
70             }
71              
72             ## no critic (Subroutines::ProhibitSubroutinePrototypes)
73             sub readFsTab($\@\@\%)
74             {
75 0     0 1 0 my ($self, $fstabPath, $fstabKeys, $pridx, $special_fs) = @_;
76              
77             # Read the fstab
78 0         0 local $/ = "\n";
79 0 0       0 if (my $fstab = IO::File->new($fstabPath, 'r'))
80             {
81 0         0 while (<$fstab>)
82             {
83 0 0 0     0 next if (/^\s*#/ || /^\s*$/);
84              
85             # $_ =~ s/#.*$//;
86             # next if( /^\s*$/ );
87              
88 0         0 my @vals = split(' ', $_);
89 0 0 0     0 $self->{canondev} and -l $vals[$pridx->[0]] and $vals[$pridx->[0]] = abs_path($vals[$pridx->[0]]);
90 0         0 $self->{$vals[$pridx->[1]]}->{mount_point} = $vals[$pridx->[1]];
91 0         0 $self->{$vals[$pridx->[1]]}->{device} = $vals[$pridx->[0]];
92             $self->{$vals[$pridx->[1]]}->{unmounted} = 1
93 0 0       0 unless (defined($self->{$vals[$pridx->[1]]}->{mounted}));
94              
95 0 0       0 if (defined($pridx->[2]))
96             {
97 0         0 my $vfs_type = $self->{$vals[$pridx->[1]]}->{fs_vfstype} = $vals[$pridx->[2]];
98             $self->{$vals[$pridx->[1]]}->{special} = 1
99 0 0       0 if (defined($special_fs->{$vfs_type}));
100             }
101             else
102             {
103             $self->{$vals[$pridx->[1]]}->{special} = 0
104 0 0       0 unless (defined($self->{$vals[$pridx->[1]]}->{special}));
105             }
106              
107 0         0 for (my $i = 0; $i < @{$fstabKeys}; ++$i)
  0         0  
108             {
109 0 0       0 $self->{$vals[$pridx->[1]]}->{$fstabKeys->[$i]} =
110             defined($vals[$i]) ? $vals[$i] : '';
111             }
112             }
113              
114 0         0 $fstab->close();
115              
116 0         0 return 1;
117             }
118              
119 0         0 return 0;
120             }
121              
122             sub readMntTab($\@\@\%)
123             {
124 9     9 1 35 my ($self, $mnttabPath, $mnttabKeys, $pridx, $special_fs) = @_;
125              
126             # Read the mtab
127 9         43 local $/ = "\n";
128 9         21 my $mtab;
129 9 50 33     47 if (($mtab = IO::File->new($mnttabPath, 'r')) && flock($mtab, LOCK_SH | LOCK_NB))
130             {
131 9         2052 while (<$mtab>)
132             {
133 333 50 33     1406 next if (/^\s*#/ || /^\s*$/);
134              
135             # $_ =~ s/#.*$//;
136             # next if( /^\s*$/ );
137              
138 333         1652 my @vals = split(/\s+/, $_);
139 333 50 66     1404 $self->{canondev} and -l $vals[$pridx->[0]] and $vals[$pridx->[0]] = abs_path($vals[$pridx->[0]]);
140             delete $self->{$vals[$pridx->[1]]}->{unmounted}
141 333 50       1068 if (exists($self->{$vals[$pridx->[1]]}->{unmounted}));
142 333         669 $self->{$vals[$pridx->[1]]}->{mounted} = 1;
143 333         652 $self->{$vals[$pridx->[1]]}->{mount_point} = $vals[$pridx->[1]];
144 333         624 $self->{$vals[$pridx->[1]]}->{device} = $vals[$pridx->[0]];
145              
146 333 50       560 if (defined($pridx->[2]))
147             {
148 333         667 my $vfs_type = $self->{$vals[$pridx->[1]]}->{fs_vfstype} = $vals[$pridx->[2]];
149             $self->{$vals[$pridx->[1]]}->{special} = 1
150 333 100       731 if (defined($special_fs->{$vfs_type}));
151             }
152             else
153             {
154             $self->{$vals[$pridx->[1]]}->{special} = 0
155 0 0       0 unless (defined($self->{$vals[$pridx->[1]]}->{special}));
156             }
157              
158 333         459 for (my $i = 0; $i < @{$mnttabKeys}; ++$i)
  2331         4826  
159             {
160 1998 50       5116 $self->{$vals[$pridx->[1]]}->{$mnttabKeys->[$i]} =
161             defined($vals[$i]) ? $vals[$i] : '';
162             }
163             }
164              
165 9         177 $mtab->close();
166              
167 9         254 return 1;
168             }
169              
170 0           return 0;
171             }
172              
173             ## no critic (Subroutines::ProhibitManyArgs)
174             sub readMounts
175             {
176 0     0 1   my ($self, $mount_rx, $pridx, $keys, $special, @lines) = @_;
177              
178 0           foreach my $line (@lines)
179             {
180 0 0         if (my @vals = $line =~ $mount_rx)
181             {
182 0 0 0       $self->{canondev} and -l $vals[$pridx->[0]] and $vals[$pridx->[0]] = abs_path($vals[$pridx->[0]]);
183 0           $self->{$vals[$pridx->[1]]}->{mount_point} = $vals[$pridx->[1]];
184 0           $self->{$vals[$pridx->[1]]}->{device} = $vals[$pridx->[0]];
185 0           $self->{$vals[$pridx->[1]]}->{mounted} = 1;
186             delete $self->{$vals[$pridx->[1]]}->{unmounted}
187 0 0         if (exists($self->{$vals[$pridx->[1]]}->{unmounted}));
188              
189 0 0         if (defined($pridx->[2]))
    0          
190             {
191 0           my $vfs_type = $self->{$vals[$pridx->[1]]}->{fs_vfstype} = $vals[$pridx->[2]];
192             $self->{$vals[$pridx->[1]]}->{special} = 1
193 0 0         if (defined($special->{$vfs_type}));
194             }
195             elsif (!defined($self->{$vals[$pridx->[1]]}->{special}))
196             {
197 0           $self->{$vals[$pridx->[1]]}->{special} = 0;
198             }
199              
200 0           for (my $i = 0; $i < @{$keys}; ++$i)
  0            
201             {
202 0 0         $self->{$vals[$pridx->[1]]}->{$keys->[$i]} =
203             defined($vals[$i]) ? $vals[$i] : '';
204             }
205             }
206             }
207              
208 0           return $self;
209             }
210              
211             sub readSwap
212             {
213 0     0 1   my ($self, $swap_rx, @lines) = @_;
214 0           foreach my $line (@lines)
215             {
216 0 0         if (my ($dev) = $line =~ $swap_rx)
217             {
218 0 0 0       $self->{canondev} and -l $dev and $dev = abs_path($dev);
219 0   0       $self->{none}->{mount_point} ||= 'none';
220 0           $self->{none}->{device} = $dev;
221 0           $self->{none}->{fs_vfstype} = 'swap';
222 0           $self->{none}->{mounted} = 1;
223 0           $self->{none}->{special} = 1;
224 0           delete $self->{none}->{unmounted};
225             }
226             }
227              
228 0           return $self;
229             }
230              
231             1;
232              
233             =pod
234              
235             =head1 NAME
236              
237             Sys::Filesystem::Unix - Return generic Unix filesystem information to Sys::Filesystem
238              
239             =head1 SYNOPSIS
240              
241             See L.
242              
243             =head1 INHERITANCE
244              
245             Sys::Filesystem::Unix
246             ISA UNIVERSAL
247              
248             =head1 METHODS
249              
250             =over 4
251              
252             =item version()
253              
254             Return the version of the (sub)module.
255              
256             =item readFsTab
257              
258             This method provides the capability to parse a standard unix fstab file.
259              
260             It expects following arguments:
261              
262             =over 8
263              
264             =item fstabPath
265              
266             Full qualified path to the fstab file to read.
267              
268             =item fstabKeys
269              
270             The column names for the fstab file through an array reference.
271              
272             =item special_fs
273              
274             Hash reference containing the names of all special file systems having a true
275             value as key.
276              
277             =back
278              
279             This method return true in case the specified file could be opened for reading,
280             false otherwise.
281              
282             =item readMntTab
283              
284             This method provides the capability to read abd parse a standard unix
285             mount-tab file. The file is locked using flock after opening it.
286              
287             It expects following arguments:
288              
289             =over 8
290              
291             =item mnttabPath
292              
293             Full qualified path to the mnttab file to read.
294              
295             =item mnttabKeys
296              
297             The column names for the mnttab file through an array reference.
298              
299             =item $special_fs
300              
301             Hash reference containing the names of all special file systems having a true
302             value as key.
303              
304             =back
305              
306             This method return true in case the specified file could be opened for reading
307             and locked, false otherwise.
308              
309             =item readMounts
310              
311             This method is called to parse the information got from C system command.
312             It expects following arguments:
313              
314             =over 8
315              
316             =item mount_rx
317              
318             Regular expression to extract the information from each mount line.
319              
320             =item pridx
321              
322             Array reference containing the index for primary keys of interest in match
323             in following order: device, mount_point, type.
324              
325             =item keys
326              
327             Array reference of the columns of the match - in order of paranteses in
328             regular expression.
329              
330             =item special
331              
332             Array reference containing the names of the special file system types.
333              
334             =item lines
335              
336             Array containing the lines to parse.
337              
338             =back
339              
340             =item readSwap
341              
342             This method is called to parse the information from the swap status.
343             It expects following arguments:
344              
345             =over 8
346              
347             =item swap_rx
348              
349             Regular expression to extract the information from each swap status line.
350             This regular expression should have exact one pair of parantheses to
351             identify the swap device.
352              
353             =item lines
354              
355             Array containing the lines to parse.
356              
357             =back
358              
359             =back
360              
361             =head1 AUTHOR
362              
363             Nicola Worthington - L
364              
365             Jens Rehsack - L
366              
367             =head1 COPYRIGHT
368              
369             Copyright 2004,2005,2006 Nicola Worthington.
370              
371             Copyright 2008-2020 Jens Rehsack.
372              
373             This software is licensed under The Apache Software License, Version 2.0.
374              
375             L
376              
377             =cut