File Coverage

lib/Sys/Filesystem/MountPoint.pm

Criterion	Covered	Total	%
statement	37	40	92.5
branch	16	24	66.6
condition	5	11	45.4
subroutine	11	11	100.0
pod	4	5	80.0
total	73	91	80.2

package Sys::Filesystem::MountPoint;
use strict;
use vars qw($VERSION @EXPORT_OK %EXPORT_TAGS @ISA $DEBUG $errstr $_f);
use Exporter;
use Carp;
use Sys::Filesystem;
$VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)/g;
@ISA = qw/Exporter/;
@EXPORT_OK = qw(path_to_mount_point is_mount_point dev_to_mount_point to_mount_point);
%EXPORT_TAGS = ( all => \@EXPORT_OK );

sub debug { $DEBUG or return 1; print STDERR "@_" }

# Sys::Filesystem object
sub _f { $_f ||= (Sys::Filesystem->new or confess("Can't init Sys::Filesystem???")) }


sub is_mount_point {
   $_[0] or confess('missing arg');
   ( grep { $_[0] eq $_ } _f->filesystems ) ? $_[0] : undef;
}



sub path_to_mount_point {
   my $arg = $_[0] or confess("missing arg");

   require Cwd; # deffinitely resolve symlinks!!!
   my $abs = Cwd::abs_path($arg)
      or $errstr = "Cant resolve '$arg' with Cwd::abs_path()"
      and return;

   debug("resolved to '$abs'");


   my $subpath = $abs;
   while($subpath){
      debug("testing subpath : $subpath");

      is_mount_point($subpath) and return $subpath;

      last if $subpath eq '/'; # we hit root but not FS mnt (just in case).

      $subpath=~s/^\/[^\/]+$/\// # change /this to /
         or $subpath=~s/\/[^\/]+$// ;# change /this/that to /this
   }

   $errstr="Can't get mount point for $abs";
   return;
}


sub dev_to_mount_point {
   my $arg = $_[0] or confess("missing arg");

   for my $mnt ( _f->filesystems ){
      (_f->device($mnt) eq $arg) and return $mnt;
   }
   $errstr="Can't find mount point for $arg";
   return;
}



sub to_mount_point {
   my $arg = $_[0] or confess("missing arg");
   is_mount_point($arg) || dev_to_mount_point($arg) || path_to_mount_point($arg);
}





1;

__END__