File Coverage

blib/lib/Tie/Mounted.pm
Criterion Covered Total %
statement 21 72 29.1
branch 0 38 0.0
condition 0 6 0.0
subroutine 7 20 35.0
pod n/a
total 28 136 20.5


line stmt bran cond sub pod time code
1             package Tie::Mounted;
2              
3 1     1   73643 use strict;
  1         2  
  1         31  
4 1     1   5 use warnings;
  1         2  
  1         26  
5 1     1   5 use base qw(Tie::Array);
  1         2  
  1         525  
6 1     1   1818 use boolean qw(true false);
  1         3656  
  1         4  
7              
8 1     1   81 use Carp qw(croak);
  1         2  
  1         40  
9 1     1   496 use File::Which ();
  1         1115  
  1         20  
10 1     1   474 use IO::File ();
  1         9072  
  1         1127  
11              
12             our ($VERSION, $FSTAB, $MOUNT_BIN, $UMOUNT_BIN, $NO_FILES);
13              
14             $VERSION = '0.18_02';
15             $FSTAB = '/etc/fstab';
16             $MOUNT_BIN = '/sbin/mount';
17             $UMOUNT_BIN = '/sbin/umount';
18              
19             {
20             sub TIEARRAY
21             {
22 0     0     my $class = shift;
23              
24 0           _gather_paths();
25 0           _validate_node($_[0]);
26              
27 0           return bless _tie(@_), $class;
28             }
29              
30 0     0     sub FETCHSIZE { $#{$_[0]} } # FETCHSIZE, FETCH: Due to the node,
  0            
31 0     0     sub FETCH { $_[0]->[++$_[1]] } # which is being kept hideously, accordingly
32             # subtract (FETCHSIZE) or add (FETCH) 1.
33              
34 0     0     *STORESIZE = *STORE = sub { croak 'Tied array is read-only' };
35              
36 0     0     sub UNTIE { _umount($_[0]->[0]) }
37             }
38              
39             sub _gather_paths
40             {
41             my $locate = sub
42             {
43 0     0     my ($target, $path) = @_;
44              
45 0 0 0       unless (-e $$path && -x _) {
46 0           my $which = File::Which::which($target);
47 0 0         croak "Cannot locate `$target': $!" unless defined $which;
48 0           $$path = $which;
49             }
50 0     0     };
51              
52 0           $locate->('mount', \$MOUNT_BIN);
53 0           $locate->('umount', \$UMOUNT_BIN);
54             }
55              
56             sub _validate_node
57             {
58 0     0     my ($node) = @_;
59              
60 0 0         my $fh = IO::File->new("<$FSTAB") or croak "Cannot open `$FSTAB' for reading: $!";
61 0           my $fstabs = do { local $/; <$fh> };
  0            
  0            
62 0           $fh->close;
63              
64 0 0 0       if (not defined $node && length $node) {
    0          
    0          
    0          
    0          
65 0           croak 'No node supplied';
66             }
67             elsif (!-e $node) {
68 0           croak "$node does not exist";
69             }
70             elsif (!-d $node) {
71 0           croak "$node is not a directory";
72             }
73             elsif ($fstabs =~ /^\#.*?\s$node\s/m) {
74 0           croak "$node is enlisted as disabled in $FSTAB";
75             }
76             elsif ($fstabs !~ /\s$node\s/) {
77 0           croak "$node is not enlisted in $FSTAB";
78             }
79             }
80              
81             sub _tie
82             {
83 0     0     my $node = shift;
84 0 0         my @args = split /\s+/, defined $_[0] ? $_[0] : '';
85              
86 0           _mount($node, grep !/^-[aAd]$/o, @args);
87              
88 0 0         my $items = $NO_FILES ? [] : _read_dir($node);
89              
90             # Invisible node at index 0
91 0           unshift @$items, $node;
92              
93 0           return $items;
94             }
95              
96             sub _mount
97             {
98 0     0     my $node = shift;
99              
100 0 0         unless (_is_mounted($node)) {
101 0 0         system("$MOUNT_BIN @_ $node") == 0 or exit(1);
102             }
103             }
104              
105             sub _is_mounted
106             {
107 0     0     my ($node) = @_;
108              
109 0 0         open(my $pipe, "$MOUNT_BIN |") or croak "Cannot open pipe to `$MOUNT_BIN': $!";
110 0 0         my $ret_val = (scalar grep /\s$node\s/, <$pipe>) ? true : false;
111 0 0         close($pipe) or croak "Cannot close pipe to `$MOUNT_BIN': $!";
112              
113 0           return $ret_val;
114             }
115              
116             sub _read_dir
117             {
118 0     0     my ($node) = @_;
119              
120 0 0         opendir(my $dh, $node) or croak "Cannot open directory `$node': $!";
121 0           my @items = grep !/^\.\.?$/, sort readdir($dh);
122 0 0         closedir($dh) or croak "Cannot close directory `$node': $!";
123              
124 0           return [ @items ];
125             }
126              
127             sub _umount
128             {
129 0     0     my ($node) = @_;
130              
131 0 0         if (_is_mounted($node)) {
132 0 0         system("$UMOUNT_BIN $node") == 0 or exit(1);
133             }
134             }
135              
136             1;
137             __END__