File Coverage

blib/lib/Sys/Filesystem.pm
Criterion Covered Total %
statement 97 109 88.9
branch 38 58 65.5
condition 22 32 68.7
subroutine 20 25 80.0
pod 7 9 77.7
total 184 233 78.9


line stmt bran cond sub pod time code
1             ############################################################
2             #
3             # Sys::Filesystem - Retrieve list of filesystems and their properties
4             #
5             # Copyright 2004,2005,2006 Nicola Worthington
6             # Copyright 2008-2020 Jens Rehsack
7             #
8             # Licensed under the Apache License, Version 2.0 (the "License");
9             # you may not use this file except in compliance with the License.
10             # You may obtain a copy of the License at
11             #
12             # http://www.apache.org/licenses/LICENSE-2.0
13             #
14             # Unless required by applicable law or agreed to in writing, software
15             # distributed under the License is distributed on an "AS IS" BASIS,
16             # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
17             # See the License for the specific language governing permissions and
18             # limitations under the License.
19             #
20             ############################################################
21              
22             package Sys::Filesystem;
23              
24             # vim:ts=4:sw=4:tw=78
25              
26 6     6   346455 use 5.008001;
  6         64  
27              
28 6     6   40 use strict;
  6         12  
  6         128  
29 6     6   28 use warnings;
  6         11  
  6         232  
30 6     6   38 use vars qw($VERSION $AUTOLOAD $CANONDEV $FSTAB $MTAB);
  6         12  
  6         584  
31 6     6   41 use Carp qw(carp croak cluck confess);
  6         12  
  6         946  
32              
33             my @query_order;
34              
35             use Module::Pluggable
36             require => 1,
37 6 50       69 only => [@query_order = map { __PACKAGE__ . '::' . $_ } (ucfirst(lc $^O), $^O =~ m/Win32/i ? 'Win32' : 'Unix', 'Dummy')],
  18         93  
38             inner => 0,
39             search_path => ['Sys::Filesystem'],
40 6     6   2980 sub_name => '_plugins';
  6         66070  
41 6     6   3695 use Params::Util qw(_INSTANCE);
  6         27412  
  6         423  
42 6     6   44 use Scalar::Util qw(blessed);
  6         11  
  6         285  
43 6     6   38 use List::Util qw(first);
  6         12  
  6         701  
44              
45 6 50   6   46 use constant DEBUG => $ENV{SYS_FILESYSTEM_DEBUG} ? 1 : 0;
  6         13  
  6         756  
46 6 50   6   44 use constant SPECIAL => ('darwin' eq $^O) ? 0 : undef;
  6         12  
  6         818  
47              
48             $VERSION = '1.407_001';
49              
50             my ($FsPlugin, $Supported);
51              
52             BEGIN
53             {
54             ## no critic (Subroutines::ProtectPrivateSubs)
55 6     6   52 Sys::Filesystem->_plugins();
56              
57 6         18835 foreach my $qo (@query_order)
58             {
59 6 50       14 next unless (eval { $qo->isa($qo) });
  6         102  
60 6         17 $FsPlugin = $qo;
61 6         13 last;
62             }
63              
64 6 50       7640 $Supported = $FsPlugin ne 'Sys::Filesystem::Unix' and $FsPlugin ne 'Sys::Filesystem::Dummy';
65             }
66              
67             ## no critic (Subroutines::RequireArgUnpacking)
68             sub new
69             {
70             # Check we're being called correctly with a class name
71 12 100   12 1 3448 ref(my $class = shift) and croak 'Class name required';
72              
73             # Check we've got something sane passed
74 11 100       180 croak 'Odd number of elements passed when even number was expected' if (@_ % 2);
75 10         32 my %args = @_;
76              
77 10 50 33     45 exists $args{xtab} and carp("Using xtab is depreciated") and delete $args{xtab};
78 10 50 33     53 defined $FSTAB and not exists $args{fstab} and $args{fstab} = $FSTAB;
79 10 50 33     37 defined $MTAB and not exists $args{mtab} and $args{mtab} = $MTAB;
80 10 100 66     37 defined $CANONDEV and not exists $args{canondev} and $args{canondev} = $CANONDEV;
81              
82             # Double check the key pairs for stuff we recognise
83 10         43 my @sane_keys = qw(aliases canondev fstab mtab);
84 10         19 my %sane_args;
85 10         57 @sane_args{@sane_keys} = delete @args{@sane_keys};
86 10 100       149 scalar keys %args and croak("Unrecognised parameter(s) '" . join("', '", sort keys %args) . "' passed to module $class");
87              
88 9         37 my $self = {%sane_args};
89              
90             # Filesystem property aliases - unless caller knows better ...
91             defined $self->{aliases}
92             or $self->{aliases} = {
93 9 50       181 device => [qw(fs_spec dev)],
94             filesystem => [qw(fs_file mount_point)],
95             mount_point => [qw(fs_file filesystem)],
96             type => [qw(fs_vfstype vfs)],
97             format => [qw(fs_vfstype vfs vfstype)],
98             options => [qw(fs_mntops)],
99             check_frequency => [qw(fs_freq)],
100             check_order => [qw(fs_passno)],
101             boot_order => [qw(fs_mntno)],
102             volume => [qw(fs_volume fs_vol vol)],
103             label => [qw(fs_label)],
104             };
105              
106             # Debug
107 9         24 DUMP('$self', $self) if (DEBUG);
108              
109 9         88 $self->{filesystems} = $FsPlugin->new(%sane_args);
110              
111             # Maybe upchuck a little
112 9 50       40 croak "Unable to create object for OS type '$self->{osname}'" unless ($self->{filesystems});
113              
114             # Bless and return
115 9         34 bless($self, $class);
116 9         154 return $self;
117             }
118              
119             sub filesystems
120             {
121 14     14 1 653 my $self = shift;
122 14 100       131 unless (defined(_INSTANCE($self, __PACKAGE__)))
123             {
124 1 50       8 unshift @_, $self unless (0 == (scalar(@_) % 2));
125 1         7 $self = __PACKAGE__->new();
126             }
127              
128             # Check we've got something sane passed
129 14 50       50 @_ % 2 and croak 'Odd number of elements passed when even number was expected';
130              
131 14         38 my $params = {@_};
132 14         24 for my $param (keys %{$params})
  14         49  
133             {
134             croak "Illegal paramater '$param' passed to filesystems() method"
135 9 50       23 unless grep { m/^$param$/ } qw(mounted unmounted special device regular);
  45         239  
136             }
137              
138             # Invert logic for regular
139 14 50       44 if (exists $params->{regular})
140             {
141 0         0 delete $params->{regular};
142             exists($params->{special})
143 0 0       0 and carp("Mutual exclusive parameters 'special' and 'regular' specified together");
144 0         0 $params->{special} = SPECIAL;
145             }
146              
147 14         30 my @filesystems = ();
148              
149             # Return list of all filesystems
150             ## no critic (Subroutines::ProhibitReturnSort)
151 14 100       23 keys %{$params} or return sort(keys(%{$self->{filesystems}}));
  5         149  
  14         39  
152              
153 9         16 for my $fsname (sort(keys(%{$self->{filesystems}})))
  9         166  
154             {
155 333         449 for my $requirement (keys(%{$params}))
  333         584  
156             {
157 333         468 my $fs = $self->{filesystems}->{$fsname};
158             my $fsreqname =
159             (not exists $fs->{$requirement} and exists $self->{aliases}->{$requirement})
160 333 50 66 0   807 ? first { exists $fs->{$_} } @{$self->{aliases}->{$requirement}}
  0         0  
  0         0  
161             : $requirement;
162              
163             defined $params->{$requirement}
164             and exists $fs->{$fsreqname}
165 333 100 100     1371 and $fs->{$fsreqname} eq $params->{$requirement}
      100        
      66        
166             and push(@filesystems, $fsname)
167             and last;
168             push(@filesystems, $fsname) and last
169             unless defined($params->{$requirement})
170 183 100 50     498 or exists($fs->{$fsreqname});
      100        
171             }
172             }
173              
174             # Return
175 9         131 return @filesystems;
176             }
177              
178             sub supported
179             {
180 0     0 1 0 return $Supported;
181             }
182              
183             sub mounted_filesystems
184             {
185 1     1 1 567 return $_[0]->filesystems(mounted => 1);
186             }
187              
188             sub unmounted_filesystems
189             {
190 1     1 1 346 return $_[0]->filesystems(unmounted => 1);
191             }
192              
193             sub special_filesystems
194             {
195 2     2 1 569 return $_[0]->filesystems(special => 1);
196             }
197              
198             sub regular_filesystems
199             {
200 2     2 1 30 return $_[0]->filesystems(special => SPECIAL);
201             }
202              
203       0     sub DESTROY { }
204              
205             ## no critic (ClassHierarchies::ProhibitAutoloading)
206             sub AUTOLOAD
207             {
208 482     482   123394 my ($self, $fsname) = @_;
209              
210 482 50       1800 croak "$self is not an object" unless (blessed($self));
211 482 50       968 croak "No filesystem passed where expected" unless ($fsname);
212              
213 482         2420 (my $name = $AUTOLOAD) =~ s/.*://;
214              
215             # No such filesystem
216 482 50       1299 exists $self->{filesystems}->{$fsname} or croak "No such filesystem";
217              
218             # Found the property
219 482         754 my $fs = $self->{filesystems}->{$fsname};
220              
221 482 100       1378 exists $fs->{$name} and return $fs->{$name};
222              
223             # Didn't find the property, but check any aliases
224             exists $self->{aliases}->{$name}
225 259     259   1094 and $name = first { exists $fs->{$_} } @{$self->{aliases}->{$name}}
  185         671  
226 221 100 100     1057 and return $fs->{$name};
227              
228 110         339 return;
229             }
230              
231             ## no critic (Subroutines::RequireFinalReturn)
232             sub TRACE
233             {
234 0     0 0   return unless DEBUG;
235 0           carp($_[0]);
236             }
237              
238             sub DUMP
239             {
240 0     0 0   return unless DEBUG;
241             ## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
242 0           eval {
243 0           require Data::Dumper;
244 0           carp(shift() . ': ' . Data::Dumper::Dumper(shift()));
245             };
246             }
247              
248             1;
249              
250             =pod
251              
252             =head1 NAME
253              
254             Sys::Filesystem - Retrieve list of filesystems and their properties
255              
256             =head1 SYNOPSIS
257              
258             use strict;
259             use Sys::Filesystem ();
260            
261             # Method 1
262             my $fs = Sys::Filesystem->new();
263             my @filesystems = $fs->filesystems();
264             for (@filesystems)
265             {
266             printf("%s is a %s filesystem mounted on %s\n",
267             $fs->mount_point($_),
268             $fs->format($_),
269             $fs->device($_)
270             );
271             }
272            
273             # Method 2
274             my $weird_fs = Sys::Filesystem->new(
275             fstab => '/etc/weird/vfstab.conf',
276             mtab => '/etc/active_mounts',
277             xtab => '/etc/nfs/mounts'
278             );
279             my @weird_filesystems = $weird_fs->filesystems();
280            
281             # Method 3 (nice but naughty)
282             my @filesystems = Sys::Filesystem->filesystems();
283              
284             =head1 DESCRIPTION
285              
286             Sys::Filesystem is intended to be a portable interface to list and query
287             filesystem names and their properties. At the time of writing there were only
288             Solaris and Win32 modules available on CPAN to perform this kind of operation.
289             This module hopes to provide a consistent API to list all, mounted, unmounted
290             and special filesystems on a system, and query as many properties as possible
291             with common aliases wherever possible.
292              
293             =head1 INHERITANCE
294              
295             Sys::Filesystem
296             ISA UNIVERSAL
297              
298             =head1 METHODS
299              
300             =over 4
301              
302             =item new
303              
304             Creates a new Sys::Filesystem object. C accepts following optional key
305             value pairs to help or force where mount information is gathered from. These
306             values are not otherwise defaulted by the main Sys::Filesystem object, but
307             left to the platform specific helper modules to determine as an exercise of
308             common sense.
309              
310             =over 4
311              
312             =item canondev
313              
314             Specify whether device path's shall be resolved when they're a symbolic
315             link.
316              
317             C<$Sys::Filesystem::CANONDEV> is used when no key C is passed.
318              
319             =item fstab
320              
321             Specify the full path and filename of the filesystem table (or fstab for
322             short). Not all platforms have such a file and so this option may be
323             ignored on some systems.
324              
325             C<$Sys::Filesystem::FSTAB> is used when no key C is passed.
326              
327             =item mtab
328              
329             Specify the full path and filename of the mounted filesystem table (or mtab
330             for short). Not all platforms have such a file and so this option may be
331             ignored on some systems.
332              
333             C<$Sys::Filesystem::MTAB> is used when no key C is passed.
334              
335             =item xtab
336              
337             B Specify the full path and filename of the mounted NFS
338             filesystem table (or xtab for short). This is usually only pertinent
339             to Unix bases systems. Not all helper modules will query NFS mounts
340             as a separate exercise, and therefore this option may be ignored on
341             some systems.
342              
343             B of the OS plugins use that tunable (anymore?), so now a warning
344             is raised when it's used. The entire support will be removed not before
345             2015. Once that happened, using C will raise an exception.
346              
347             =item aliases
348              
349             Overrides internal aliasing table used to match queries against OS
350             plugin. This should be used only when dealing with closed source platform
351             helper module(s).
352              
353             =back
354              
355             =item supported
356              
357             Returns true if the operating system is supported by Sys::Filesystem.
358             Unsupported operating systems may get less information, e.g. the mount
359             state couldn't determined or which file system type is special isn't
360             known.
361              
362             =back
363              
364             =head2 Listing Filesystems
365              
366             =over 4
367              
368             =item filesystems()
369              
370             Returns a list of all filesystem. May accept an optional list of key pair
371             values in order to filter/restrict the results which are returned. The
372             restrictions are evaluated to match as much as possible, so asking for
373             regular and special file system (or mounted and special file systems),
374             you'll get all.
375              
376             For better understanding, please imagine the parameters like:
377              
378             @fslist = $fs->filesystems( mounted => 1, special => 1 );
379             # results similar as
380             SELECT mountpoint FROM filesystems WHERE mounted = 1 OR special = 1
381              
382             If you need other selection choices, please take a look at L.
383              
384             Valid values are as follows:
385              
386             =over 4
387              
388             =item device => "string"
389              
390             Returns only filesystems that are mounted using the device of "string".
391             For example:
392              
393             my $fdd_filesytem = Sys::Filesystem->filesystems(device => "/dev/fd0");
394              
395             =item mounted => 1
396              
397             Returns only filesystems which can be confirmed as actively mounted.
398             (Filesystems which are mounted).
399              
400             The mounted_filesystems() method is an alias for this syntax.
401              
402             =item unmounted => 1
403              
404             Returns only filesystems which cannot be confirmed as actively mounted.
405             (Filesystems which are not mounted).
406              
407             The unmounted_filesystems() method is an alias for this syntax.
408              
409             =item special => 1
410              
411             Returns only filesystems which are regarded as special in some way. A
412             filesystem is marked as special by the operating specific helper
413             module. For example, a tmpfs type filesystem on one operating system
414             might be regarded as a special filesystem, but not on others. Consult
415             the documentation of the operating system specific helper module for
416             further information about your system. (Sys::Filesystem::Linux for Linux
417             or Sys::Filesystem::Solaris for Solaris etc).
418              
419             This parameter is mutually exclusive to C.
420              
421             The special_filesystems() method is an alias for this syntax.
422              
423             =item regular => 1
424              
425             Returns only fileystems which are not regarded as special. (Normal
426             filesystems).
427              
428             This parameter is mutually exclusive to C.
429              
430             The regular_filesystems() method is an alias for this syntax.
431              
432             =back
433              
434             =item mounted_filesystems()
435              
436             Returns a list of all filesystems which can be verified as currently
437             being mounted.
438              
439             =item unmounted_filesystems()
440              
441             Returns a list of all filesystems which cannot be verified as currently
442             being mounted.
443              
444             =item special_filesystems()
445              
446             Returns a list of all fileystems which are considered special. This will
447             usually contain meta and swap partitions like /proc and /dev/shm on Linux.
448              
449             =item regular_filesystems()
450              
451             Returns a list of all filesystems which are not considered to be special.
452              
453             =back
454              
455             =head2 Filesystem Properties
456              
457             Available filesystem properties and their names vary wildly between platforms.
458             Common aliases have been provided wherever possible. You should check the
459             documentation of the specific platform helper module to list all of the
460             properties which are available for that platform. For example, read the
461             Sys::Filesystem::Linux documentation for a list of all filesystem properties
462             available to query under Linux.
463              
464             =over 4
465              
466             =item mount_point() or filesystem()
467              
468             Returns the friendly name of the filesystem. This will usually be the same
469             name as appears in the list returned by the filesystems() method.
470              
471             =item mounted()
472              
473             Returns boolean true if the filesystem is mounted.
474              
475             =item label()
476              
477             Returns the fileystem label.
478              
479             This functionality may need to be retrofitted to some original OS specific
480             helper modules as of Sys::Filesystem 1.12.
481              
482             =item volume()
483              
484             Returns the volume that the filesystem belongs to or is mounted on.
485              
486             This functionality may need to be retrofitted to some original OS specific
487             helper modules as of Sys::Filesystem 1.12.
488              
489             =item device()
490              
491             Returns the physical device that the filesystem is connected to.
492              
493             =item special()
494              
495             Returns boolean true if the filesystem type is considered "special".
496              
497             =item type() or format()
498              
499             Returns the type of filesystem format. fat32, ntfs, ufs, hpfs, ext3, xfs etc.
500              
501             =item options()
502              
503             Returns the options that the filesystem was mounted with. This may commonly
504             contain information such as read-write, user and group settings and
505             permissions.
506              
507             =item mount_order()
508              
509             Returns the order in which this filesystem should be mounted on boot.
510              
511             =item check_order()
512              
513             Returns the order in which this filesystem should be consistency checked
514             on boot.
515              
516             =item check_frequency()
517              
518             Returns how often this filesystem is checked for consistency.
519              
520             =back
521              
522             =head1 OS SPECIFIC HELPER MODULES
523              
524             =head2 Dummy
525              
526             The Dummy module is there to provide a default failover result to the main
527             Sys::Filesystem module if no suitable platform specific module can be found
528             or successfully loaded. This is the last module to be tried, in order of
529             platform, Unix (if not on Win32), and then Dummy.
530              
531             =head2 Unix
532              
533             The Unix module is intended to provide a "best guess" failover result to the
534             main Sys::Filesystem module if no suitable platform specific module can be
535             found, and the platform is not 'MSWin32'.
536              
537             This module requires additional work to improve it's guestimation abilities.
538              
539             =head2 Darwin
540              
541             First written by Christian Renz .
542              
543             =head2 Win32
544              
545             Provides C and C of mounted filesystems on Windows.
546              
547             =head2 AIX
548              
549             Please be aware that the AIX /etc/filesystems file has both a "type" and
550             "vfs" field. The "type" field should not be confused with the filesystem
551             format/type (that is stored in the "vfs" field). You may wish to use the
552             "format" field when querying for filesystem types, since it is aliased to
553             be more reliable accross different platforms.
554              
555             =head2 Other
556              
557             Linux, Solaris, Cygwin, FreeBSD, NetBSD, HP-UX.
558              
559             =head2 OS Identifiers
560              
561             The following list is taken from L. Please refer to the original
562             source for the most up to date version. This information should help anyone
563             who wishes to write a helper module for a new platform. Modules should have
564             the same name as ^O in title caps. Thus 'openbsd' becomes 'Openbsd.pm'.
565              
566             =head1 REQUIREMENTS
567              
568             Sys::Filesystem requires Perl >= 5.6 to run.
569              
570             =head1 TODO
571              
572             Add support for Tru64, MidnightBSD, Haiku, Minix, DragonflyBSD and OpenBSD.
573             Please contact me if you would like to provide code for these operating
574             systems.
575              
576             =head1 SUPPORT
577              
578             You can find documentation for this module with the perldoc command.
579              
580             perldoc Sys::Filesystem
581              
582             You can also look for information at:
583              
584             =over 4
585              
586             =item * RT: CPAN's request tracker
587              
588             L
589              
590             =item * AnnoCPAN: Annotated CPAN documentation
591              
592             L
593              
594             =item * CPAN Ratings
595              
596             L
597              
598             =item * Search CPAN
599              
600             L
601              
602             =back
603              
604             =head1 SEE ALSO
605              
606             L, L, L, L
607              
608             =head1 AUTHOR
609              
610             Nicola Worthington - L
611              
612             Jens Rehsack - L
613              
614             =head1 ACKNOWLEDGEMENTS
615              
616             See CREDITS in the distribution tarball.
617              
618             =head1 COPYRIGHT
619              
620             Copyright 2004,2005,2006 Nicola Worthington.
621              
622             Copyright 2008-2020 Jens Rehsack.
623              
624             This software is licensed under The Apache Software License, Version 2.0.
625              
626             L
627              
628             =cut