File Coverage

blib/lib/Linux/Proc/Mounts.pm

Criterion	Covered	Total	%
statement	48	69	69.5
branch	9	18	50.0
condition	3	6	50.0
subroutine	7	18	38.8
pod	4	4	100.0
total	71	115	61.7

package Linux::Proc::Mounts;

our $VERSION = '0.02';

use strict;
use warnings;
use Carp;

sub read {
    my ($class, %opts) = @_;
    my $mnt = delete $opts{mnt};
    my $pid = delete $opts{pid};
    my $file = delete $opts{file};
    %opts and croak "Unknown option(s) ". join(", ", sort keys %opts);

    unless (defined $file) {
        $mnt = "/proc" unless defined $mnt;
        croak "$mnt is not a proc filesystem" unless -d $mnt and (stat _)[12] == 0;
        $mnt .= "/$pid" if defined $pid;
        $file = "$mnt/mounts";
    }
    open my $fh, '<', $file
        or croak "Unable to open '$file': $!";

    my @entries;
    while (<$fh>) {
        chomp;
        my @entry = split;
        if (@entry != 6) {
            warn "invalid number of entries in $file line $.";
            next;
        }
        $#entry = 3; # ignore the two dummy values at the end
        s/\\([0-7]{1,3})/chr oct $1/g for @entry;
        push @entry, _key($entry[1]);
        push @entry, $.;
        my $entry = \@entry;
        bless $entry, 'Linux::Proc::Mounts::Entry';
        push @entries, $entry;
    }

    for my $i (1..$#entries) {
        my $shadow = $entries[$i];
        # my $re = quotemeta $shadow->[4];
        # $re = qr/^$re/;
        # for my $e (@entries[0..$i-1]) {
        #    $e->[6] = $shadow if $e->[4] =~ $re and not $e->[6];
        # }
        for my $e (@entries[0..$i-1]) {
            $e->[6] = $shadow if $e->[4] eq $shadow->[4] and not $e->[6];
        }
    }
    bless \@entries, $class;
}

sub _key {
    my $mnt = shift;
    $mnt =~ s|/+|/|g;
    $mnt =~ s|/?$|/|;
    $mnt =~ s|([\0/])|\0$1|g;
    $mnt;
}

sub at {
    my ($self, $at) = @_;
    my $key = _key $at;
    bless [grep { $_->[4] eq $key } @$self], ref $self;
}

sub under {
    my ($self, $under) = @_;
    my $key = quotemeta _key $under;
    my $re = qr/^$key/;
    bless [grep $_->[4] =~ $re, @$self], ref $self;
}

sub visible {
    my $self = shift;
    bless [grep !$_->[6], @$self], ref $self;
}

package Linux::Proc::Mounts::Entry;

sub _key     { shift->[4] }
sub spec     { shift->[0] }
sub file     { shift->[1] }
sub fstype   { shift->[2] }
sub opts     { shift->[3] }
sub ix       { shift->[5] }
sub shadower { shift->[6] }

sub opts_hash {
    my %h;
    for (split /,/, shift->[3]) {
        if (/(.*)=(.*)/) {
            $h{$1} = $2;
        }
        else {
            $h{$_} = 1;
        }
    }
    \%h;
}

sub is_ro { shift->[3] =~ /(?:^|,)ro(?:,|$)/ }

sub is_rw { shift->[3] =~ /(?:^|,)rw(?:,|$)/ }


__END__