File Coverage

blib/lib/Filesys/Df.pm

Criterion	Covered	Total	%
statement	66	92	71.7
branch	16	42	38.1
condition	2	6	33.3
subroutine	4	4	100.0
pod	0	1	0.0
total	88	145	60.6

package Filesys::Df;

use strict;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
use Carp;
require Exporter;
require DynaLoader;
require 5.006;

@ISA = qw(Exporter DynaLoader);
@EXPORT = qw(df);
$VERSION = '0.92';
bootstrap Filesys::Df $VERSION;

sub df {
my ($dir, $block_size) = @_;
my ($used, $fused);
my ($per, $fper);
my ($user_blocks, $user_used);
my ($user_files, $user_fused);
my %fs = ();


	(defined($dir)) ||
		(croak "Usage: df\(\$dir\) or df\(\$dir\, \$block_size)");

	#### If no requested block size then we will return the values in bytes
	($block_size) ||
		($block_size = 1024);

	my ($frsize, $blocks, $bfree, $bavail, $files, $ffree, $favail);

	#### If open filehandle call fstatvfs or fstatfs
	if(defined(fileno($dir))) {
		($frsize, $blocks, $bfree, $bavail, $files, $ffree, $favail) = _df_fh(fileno($dir));
	}

	else {
		($frsize, $blocks, $bfree, $bavail, $files, $ffree, $favail) = _df($dir);
	}


	#### Some system or XS failure, something like /proc, or bad $dir
	if($frsize == 0 || $blocks == 0) {
		return();
	}

	#### Change to requested or default block size
	if($block_size > $frsize) {
		my $result = $block_size / $frsize;
		$blocks /= $result;
		($bfree != 0) &&
			($bfree /= $result);
		#### Keep bavail -
		($bavail < 0) &&
			($result *= -1);

		($bavail != 0) &&
			($bavail /= $result);
	}

	elsif($block_size < $frsize) {
		my $result = $frsize / $block_size;
		$blocks *= $result;
		$bfree *= $result;
		#### Keep bavail -
		($bavail < 0) &&
			($result *= -1);
		$bavail *= $result;
	}

	$used = $blocks - $bfree;

	#### There is a reserved amount for the su
	#### or there are disk quotas
        if($bfree > $bavail) {
                $user_blocks = $blocks - ($bfree - $bavail);
                $user_used = $user_blocks - $bavail;
                if($bavail < 0) {
                        #### over 100%
                        my $tmp_bavail = $bavail;
                        $per = ($tmp_bavail *= -1) / $user_blocks;
                }

                else {
			if($user_used == 0) {
				$per = 0;
			}

			else {
                        	$per = $user_used / $user_blocks;
			}
                }
        }

        #### No reserved amount or quotas
        else {
                if($used == 0)  {
                        $per = 0;
                }

                else {
                        $per = $used / $blocks;
			$user_blocks = $blocks;
			$user_used = $used;
                }
        }

	#### round
        $per *= 100;
        $per += .5;

        #### over 100%
        ($bavail < 0) &&
                ($per += 100);

        $fs{per}         = int($per);
	$fs{blocks}      = $blocks;
	$fs{bfree}       = $bfree;
	$fs{bavail}      = $bavail;
	$fs{used}        = $used;
	#### These are undocumented but kept for backwards compatibility
	$fs{user_blocks} = $user_blocks;
	$fs{user_bavail} = $bavail;
	$fs{user_used}   = $user_used;
	$fs{su_bavail}   = $bfree;
	$fs{su_blocks}   = $blocks;



	#### Handle inodes if system supports them
	if(defined $files && $files > 0) {
		$fused = $files - $ffree;
                #### There is a reserved amount
                if($ffree > $favail) {
                        $user_files = $files - ($ffree - $favail);
                        $user_fused = $user_files - $favail;
                        if($favail < 0)  {
                                #### over 100%
                                my $tmp_favail = $favail;
                                $fper = ($tmp_favail *= -1) / $user_files;
                        }

                        else {
				if($user_fused == 0) {
					$fper = 0;
				}

				else {
                                	$fper = $user_fused / $user_files;
				}
                        }
                }

                #### su and user amount are the same
                else {
                        if($fused == 0) {
                                $fper = 0;
                        }

                        else {
                                $fper = $fused / $files;
                        }

                        $user_files = $files;
                        $user_fused = $fused;
                }

                #### round
                $fper *= 100;
                $fper += .5;

                #### over 100%
                ($favail < 0) &&
                        ($fper += 100);

		$fs{fper}        = int($fper);
                $fs{files}       = $files;
                $fs{ffree}       = $ffree;
                $fs{favail}      = $favail;
                $fs{fused}       = $fused;
		#### These are undocumented but kept for backwards compatibility
                $fs{user_fused}  = $user_fused;
                $fs{user_files}  = $user_files;
                $fs{su_favail}   = $ffree;
                $fs{su_files}    = $files;
                $fs{user_favail} = $favail;
        }

        #### No valid inode info. Probably NFS.
	#### Instead of undefing, just have the user call exists().
        #else {
        #        $fs{fper}        = undef;
        #        $fs{files}       = undef;
        #        $fs{ffree}       = undef;
        #        $fs{favail}      = undef;
        #        $fs{fused}       = undef;
        #        $fs{user_fused}  = undef;
        #        $fs{user_files}  = undef;
        #}


	return(\%fs);
}

1;
__END__