File Coverage

blib/lib/Quota.pm

Criterion	Covered	Total	%
statement	9	50	18.0
branch	0	38	0.0
condition	0	36	0.0
subroutine	3	5	60.0
pod	2	2	100.0
total	14	131	10.6

# ------------------------------------------------------------------------ #
# Quota.pm - Copyright (C) 1995-2020 T. Zoerner
# ------------------------------------------------------------------------ #
# This program is free software: you can redistribute it and/or modify
# it either under the terms of the Perl Artistic License or the GNU
# General Public License as published by the Free Software Foundation.
# (Either version 1 of the GPL, or any later version.)
# For a copy of these licenses see .
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# Perl Artistic License or GNU General Public License for more details.
# ------------------------------------------------------------------------ #

package Quota;

require Exporter;
use AutoLoader;
require DynaLoader;

@ISA = qw(Exporter DynaLoader);
@EXPORT = ();

$VERSION = '1.8.0';

bootstrap Quota;

use Carp;
use strict;

##
##  Get block device for locally mounted file system
##  !! Do not use this to get the argument for the quota-functions in this
##  !! module, since not all operating systems use the device path for the
##  !! quotactl system call and e.g. Solaris doesn't even use a system call
##  !! Always use getqcarg() instead.
##

sub getdev {
  ($#_ > 0) && croak("Usage: Quota::getdev(path)");
  my($target) = (($#_ == -1) ? "." : $_[0]);
  my($dev) = (stat($target))[0];
  my($ret) = undef;
  my($fsname,$path);

  if($dev && ($target ne "") && !Quota::setmntent()) {
    while(($fsname,$path) = Quota::getmntent()) {
      ($ret=$fsname, last) if ($dev == (stat($path))[0]);
    }
    $! = 0;
  }
  Quota::endmntent();
  $ret;
}

##
##  Get "device" argument for this module's Quota-functions
##

sub getqcarg {
  ($#_ > 0) && croak("Usage: Quota::getqcarg(path)");
  my($target) = (($#_ == -1) ? "." : $_[0]);
  my($dev) = (stat($target))[0];
  my($ret) = undef;
  my($argtyp,$fsupp) = (Quota::getqcargtype() =~ /([^,]*)(,.*)?/);
  my($fsname,$path,$fstyp,$fsopt);

  if(defined($dev) && ($target ne "") && !Quota::setmntent()) {
    while(($fsname,$path,$fstyp,$fsopt) = Quota::getmntent()) {
      next if $fstyp =~ /^(lofs|ignore|auto.*|proc|rootfs)$/;
      my($pdev) = (stat($path))[0];
      if (defined($pdev) && ($dev == $pdev)) {
        if ($fsname =~ m|^[^/]+:/|) {
          $ret = $fsname;  #NFS host:/path
        } elsif (($fstyp =~ /^nfs/i) && ($fsname =~ m#^(/.*)\@([^/]+)$#)) {
          $ret = "$2:$1";  #NFS /path@host
        } elsif ($argtyp eq "dev") {
          if ($fsopt =~ m#(^|,)loop=(/dev/[^,]+)#) {
            $ret = $2;  # Linux mount -o loop
          } else {
            $ret = $fsname;
          }
        } elsif ($argtyp eq "qfile") {
          $ret = "$path/quotas";
        } elsif ($argtyp eq "any") {
          $ret = $target;
        } else { #($argtyp eq "mntpt")
          $ret = $path;
        }

        # XFS, VxFS and AFS quotas require separate access methods
        # (optional for VxFS: later versions use 'normal' quota interface)
        if   (($fstyp eq "xfs") && ($fsupp =~ /,XFS/)) { $ret = "(XFS)$ret" }
        elsif(($fstyp eq "vxfs") &&
              defined($fsupp) && ($fsupp =~ /,VXFS/)) { $ret = "(VXFS)$ret" }
        elsif((($fstyp eq "afs") || ($fsname eq "AFS")) &&
              ($fsupp =~ /,AFS/)) { $ret = "(AFS)$target"; }
        if   (($fstyp eq "jfs2") && ($fsupp =~ /,JFS2/)) { $ret = "(JFS2)$ret" }
        last;
      }
    }
    $! = 0;
  }
  Quota::endmntent();
  $ret;
}

package Quota; # return to package Quota so AutoSplit is happy
1;
__END__