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

package Tie::Mounted;

use strict;
use warnings;
use base qw(Tie::Array);
use boolean qw(true false);

use Carp qw(croak);
use File::Which ();
use IO::File ();

our ($VERSION, $FSTAB, $MOUNT_BIN, $UMOUNT_BIN, $NO_FILES);

$VERSION = '0.18_02';
$FSTAB = '/etc/fstab';
$MOUNT_BIN  = '/sbin/mount';
$UMOUNT_BIN = '/sbin/umount';

{
    sub TIEARRAY
    {
        my $class = shift;

        _gather_paths();
        _validate_node($_[0]);

        return bless _tie(@_), $class;
    }

    sub FETCHSIZE { $#{$_[0]} }           # FETCHSIZE, FETCH: Due to the node,
    sub FETCH     { $_[0]->[++$_[1]] }    # which is being kept hideously, accordingly
                                          # subtract (FETCHSIZE) or add (FETCH) 1.

    *STORESIZE = *STORE = sub { croak 'Tied array is read-only' };

    sub UNTIE { _umount($_[0]->[0]) }
}

sub _gather_paths
{
    my $locate = sub
    {
        my ($target, $path) = @_;

        unless (-e $$path && -x _) {
            my $which = File::Which::which($target);
            croak "Cannot locate `$target': $!" unless defined $which;
            $$path = $which;
        }
    };

    $locate->('mount',  \$MOUNT_BIN);
    $locate->('umount', \$UMOUNT_BIN);
}

sub _validate_node
{
    my ($node) = @_;

    my $fh = IO::File->new("<$FSTAB") or croak "Cannot open `$FSTAB' for reading: $!";
    my $fstabs = do { local $/; <$fh> };
    $fh->close;

    if (not defined $node && length $node) {
        croak 'No node supplied';
    }
    elsif (!-e $node) {
        croak "$node does not exist";
    }
    elsif (!-d $node) {
        croak "$node is not a directory";
    }
    elsif ($fstabs =~ /^\#.*?\s$node\s/m) {
        croak "$node is enlisted as disabled in $FSTAB";
    }
    elsif ($fstabs !~ /\s$node\s/) {
        croak "$node is not enlisted in $FSTAB";
    }
}

sub _tie
{
    my $node = shift;
    my @args = split /\s+/, defined $_[0] ? $_[0] : '';

    _mount($node, grep !/^-[aAd]$/o, @args);

    my $items = $NO_FILES ? [] : _read_dir($node);

    # Invisible node at index 0
    unshift @$items, $node;

    return $items;
}

sub _mount
{
    my $node = shift;

    unless (_is_mounted($node)) {
        system("$MOUNT_BIN @_ $node") == 0 or exit(1);
    }
}

sub _is_mounted
{
    my ($node) = @_;

    open(my $pipe, "$MOUNT_BIN |") or croak "Cannot open pipe to `$MOUNT_BIN': $!";
    my $ret_val = (scalar grep /\s$node\s/, <$pipe>) ? true : false;
    close($pipe) or croak "Cannot close pipe to `$MOUNT_BIN': $!";

    return $ret_val;
}

sub _read_dir
{
    my ($node) = @_;

    opendir(my $dh, $node) or croak "Cannot open directory `$node': $!";
    my @items = grep !/^\.\.?$/, sort readdir($dh);
    closedir($dh) or croak "Cannot close directory `$node': $!";

    return [ @items ];
}

sub _umount
{
    my ($node) = @_;

    if (_is_mounted($node)) {
        system("$UMOUNT_BIN $node") == 0 or exit(1);
    }
}

1;
__END__