Filesys-DiskSpace-0.05/0042755000175000017500000000000006764570722013053 5ustar ftaftaFilesys-DiskSpace-0.05/Makefile.PL0100644000175000017500000000046606711171212015005 0ustar ftafta# -*- mode: Perl -*- use ExtUtils::MakeMaker; WriteMakefile(NAME => "Filesys::DiskSpace", VERSION_FROM => "lib/Filesys/DiskSpace.pm", dist => { COMPRESS => "gzip", SUFFIX => "gz" }, clean => { FILES => '*.bak *.old mibs/*.dump lib/*/*~' }, ); Filesys-DiskSpace-0.05/t/0042755000175000017500000000000006764570722013316 5ustar ftaftaFilesys-DiskSpace-0.05/t/linux-vfat.t0100644000175000017500000000247606764570663015610 0ustar ftafta# -*- Mode: Perl -*- # Test file for linux vfat FS. # inodes are *not* checked for this FS. BEGIN { unshift @INC, "lib", "../lib" } use strict; use Filesys::DiskSpace; local $^W = 1; my $t = 1; unless ($^O eq 'linux') { print "1..0\n"; exit; } my $bindf = '/bin/df'; my $mnttab = '/etc/mtab'; my ($data, $dirs); open (MOUNT, $mnttab) || die "Error: $!\n"; while (defined (my $d = )) { my @tab = split /\s+/, $d; push @$dirs, $tab[1] if $tab[2] eq 'vfat'; } close MOUNT; unless ($dirs) { print "1..1\nok 1\n"; exit; } open (DF, "$bindf -k @$dirs |") || die "Error: $!\n"; while (defined (my $d = )) { my @tab = split /\s+/, $d; next if $tab[0] eq 'Filesystem'; $$data{$tab[5]}{'used'} = $tab[2]; $$data{$tab[5]}{'avail'} = $tab[3]; } close DF; print "1..", scalar keys %$data, "\n"; for my $part (keys %$data) { my ($fs_type, $fs_desc, $used, $avail, $fused, $favail) = df $part; my $res = $fs_type == 19780 && $$data{$part}{'used'} == $used && $$data{$part}{'avail'} == $avail; unless ($res) { print "Value: system_df perl_df\n\n"; print "Used: $$data{$part}{'used'} <> $used\n" unless $$data{$part}{'used'} == $used; print "Avail: $$data{$part}{'avail'} <> $avail\n" unless $$data{$part}{'avail'} == $avail; } print $res ? "" : "not ", "ok ", $t++, "\n"; } Filesys-DiskSpace-0.05/t/freebsd-ufs.t0100644000175000017500000000401406734532017015672 0ustar ftafta# -*- Mode: Perl -*- BEGIN { unshift @INC, "lib", "../lib" } use strict; use Filesys::DiskSpace; local $^W = 1; my $t = 1; unless ($^O eq 'freebsd') { print "1..0\n"; exit; } my $bindf = '/bin/df'; my $mnttab = '/etc/fstab'; my ($data, $dirs); open (MOUNT, $mnttab) || die "Error: $!\n"; while (defined (my $d = )) { my @tab = split /\s+/, $d; push @$dirs, $tab[1] if $tab[2] eq 'ufs'; } close MOUNT; open (DF, "$bindf -i @$dirs |") || die "Error: $!\n"; while (defined (my $d = )) { my @tab = split /\s+/, $d; next if $tab[0] eq 'Filesystem'; $$data{$tab[8]}{'used'} = $tab[2]; $$data{$tab[8]}{'avail'} = $tab[3]; $$data{$tab[8]}{'iused'} = $tab[5]; $$data{$tab[8]}{'ifree'} = $tab[6]; } close DF; print "1..", scalar keys %$data, "\n"; for my $part (keys %$data) { my ($fs_type, $fs_desc, $used, $avail, $iused, $ifree) = df $part; my $res = $fs_desc eq '4.2' && $$data{$part}{'used'} == $used && $$data{$part}{'avail'} == $avail && $$data{$part}{'iused'} == $iused && $$data{$part}{'ifree'} == $ifree; unless ($res) { print "Value: system_df perl_df\n\n"; printf STDERR "Value: system_df perl_df\n\n"; print "Used: $$data{$part}{'used'} <> $used\n" unless $$data{$part}{'used'} == $used; printf STDERR "Used: $$data{$part}{'used'} <> $used\n" unless $$data{$part}{'used'} == $used; print "Avail: $$data{$part}{'avail'} <> $avail\n" unless $$data{$part}{'avail'} == $avail; printf STDERR "Avail: $$data{$part}{'avail'} <> $avail\n" unless $$data{$part}{'avail'} == $avail; print "Iused: $$data{$part}{'iused'} <> $iused\n" unless $$data{$part}{'iused'} == $iused; printf STDERR "Iused: $$data{$part}{'iused'} <> $iused\n" unless $$data{$part}{'iused'} == $iused; print "Iavail: $$data{$part}{'ifree'} <> $ifree\n" unless $$data{$part}{'ifree'} == $ifree; printf STDERR "Iavail: $$data{$part}{'ifree'} <> $ifree\n" unless $$data{$part}{'ifree'} == $ifree; } print $res ? "" : "not ", "ok ", $t++, "\n"; } Filesys-DiskSpace-0.05/t/solaris-ufs.t0100644000175000017500000000344606720630111015731 0ustar ftafta# -*- Mode: Perl -*- # Submited by Lupe Christoph for Solaris 2.6 BEGIN { unshift @INC, "lib", "../lib" } use strict; use Filesys::DiskSpace; local $^W = 1; my $t = 1; unless ($^O eq 'solaris') { print "1..0\n"; exit; } my $bindf = '/usr/sbin/df'; my $mnttab = '/etc/mnttab'; my ($data, $dirs); open (MOUNT, $mnttab) || die "Error: $!\n"; while (defined (my $d = )) { my @tab = split /\s+/, $d; push @$dirs, $tab[1] if $tab[2] eq 'ufs'; } close MOUNT; open (DF, "$bindf -k @$dirs |") || die "Error: $!\n"; while (defined (my $d = )) { my @tab = split /\s+/, $d; next if $tab[0] eq 'Filesystem'; $$data{$tab[5]}{'used'} = $tab[2]; $$data{$tab[5]}{'avail'} = $tab[3]; } close DF; open (DF, "$bindf -o i @$dirs |") || die "Error: $!\n"; while (defined (my $d = )) { my @tab = split /\s+/, $d; next if $tab[0] eq 'Filesystem'; $$data{$tab[4]}{'iused'} = $tab[1]; $$data{$tab[4]}{'iavail'} = $tab[2]; } close DF; print "1..", scalar keys %$data, "\n"; for my $part (keys %$data) { my ($fs_type, $fs_desc, $used, $avail, $iused, $iavail) = df $part; my $res = $fs_desc eq '4.2' && $$data{$part}{'used'} == $used && $$data{$part}{'avail'} == $avail && $$data{$part}{'iused'} == $iused && $$data{$part}{'iavail'} == $iavail; unless ($res) { print "Value: system_df perl_df\n\n"; print "Used: $$data{$part}{'used'} <> $used\n" unless $$data{$part}{'used'} == $used; print "Avail: $$data{$part}{'avail'} <> $avail\n" unless $$data{$part}{'avail'} == $avail; print "Iused: $$data{$part}{'iused'} <> $iused\n" unless $$data{$part}{'iused'} == $iused; print "Iavail: $$data{$part}{'iavail'} <> $iavail\n" unless $$data{$part}{'iavail'} == $iavail; } print $res ? "" : "not ", "ok ", $t++, "\n"; } Filesys-DiskSpace-0.05/t/linux-ext2.t0100644000175000017500000000332506764570645015524 0ustar ftafta# -*- Mode: Perl -*- BEGIN { unshift @INC, "lib", "../lib" } use strict; use Filesys::DiskSpace; local $^W = 1; my $t = 1; unless ($^O eq 'linux') { print "1..0\n"; exit; } my $bindf = '/bin/df'; my $mnttab = '/etc/mtab'; my ($data, $dirs); open (MOUNT, $mnttab) || die "Error: $!\n"; while (defined (my $d = )) { my @tab = split /\s+/, $d; push @$dirs, $tab[1] if $tab[2] eq 'ext2'; } close MOUNT; open (DF, "$bindf -k @$dirs |") || die "Error: $!\n"; while (defined (my $d = )) { my @tab = split /\s+/, $d; next if $tab[0] eq 'Filesystem'; $$data{$tab[5]}{'used'} = $tab[2]; $$data{$tab[5]}{'avail'} = $tab[3]; } close DF; open (DF, "$bindf -i @$dirs |") || die "Error: $!\n"; while (defined (my $d = )) { my @tab = split /\s+/, $d; next if $tab[0] eq 'Filesystem'; $$data{$tab[5]}{'fused'} = $tab[2]; $$data{$tab[5]}{'favail'} = $tab[3]; } close DF; print "1..", scalar keys %$data, "\n"; for my $part (keys %$data) { my ($fs_type, $fs_desc, $used, $avail, $fused, $favail) = df $part; my $res = $fs_type == 61267 && $$data{$part}{'used'} == $used && $$data{$part}{'avail'} == $avail && $$data{$part}{'fused'} == $fused && $$data{$part}{'favail'} == $favail; unless ($res) { print "Value: system_df perl_df\n\n"; print "Used: $$data{$part}{'used'} <> $used\n" unless $$data{$part}{'used'} == $used; print "Avail: $$data{$part}{'avail'} <> $avail\n" unless $$data{$part}{'avail'} == $avail; print "Iused: $$data{$part}{'fused'} <> $fused\n" unless $$data{$part}{'fused'} == $fused; print "Iavail: $$data{$part}{'favail'} <> $favail\n" unless $$data{$part}{'favail'} == $favail; } print $res ? "" : "not ", "ok ", $t++, "\n"; } Filesys-DiskSpace-0.05/t/1st.t0100644000175000017500000000032206734534170014174 0ustar ftafta# -*- Mode: Perl -*- # Pseudo test file. Usefull to avoid a failure when all other test files # are skipped. BEGIN { unshift @INC, "lib", "../lib" } use strict; use Filesys::DiskSpace; print "1..1\nok 1\n"; Filesys-DiskSpace-0.05/MANIFEST.SKIP0100644000175000017500000000012706720630216014727 0ustar ftafta^Makefile(\.old)?$ ^MANIFEST\.bak$ ^doc/ .*~$ (^|/)TAGS$ .*\.tar\.gz$ blib/ pm_to_blib Filesys-DiskSpace-0.05/lib/0042755000175000017500000000000006764570722013621 5ustar ftaftaFilesys-DiskSpace-0.05/lib/Filesys/0042755000175000017500000000000006764570722015237 5ustar ftaftaFilesys-DiskSpace-0.05/lib/Filesys/DiskSpace.pm0100755000175000017500000001736306764570622017452 0ustar ftafta# -*- Mode: Perl -*- package Filesys::DiskSpace; use strict; use vars qw(@ISA @EXPORT $VERSION $DEBUG); use Exporter; use Config; use Carp; require 5.003; @ISA = qw(Exporter); @EXPORT = qw(df); $VERSION = "0.05"; # known FS type numbers my %fs_type = ( 0 => "4.2", # 0x00000000 256 => "UFS", # 0x00000100 2560 => "ADVFS", # 0x00000A00 4989 => "EXT_SUPER_MAGIC", # 0x0000137D 4991 => "MINIX_SUPER_MAGIC", # 0x0000137F 5007 => "MINIX_SUPER_MAGIC2", # 0x0000138F 9320 => "MINIX2_SUPER_MAGIC", # 0x00002468 9336 => "MINIX2_SUPER_MAGIC2", # 0x00002478 19780 => "MSDOS_SUPER_MAGIC", # 0x00004d44 20859 => "SMB_SUPER_MAGIC", # 0x0000517B 22092 => "NCP_SUPER_MAGIC", # 0x0000564c 26985 => "NFS_SUPER_MAGIC", # 0x00006969 38496 => "ISOFS_SUPER_MAGIC", # 0x00009660 40864 => "PROC_SUPER_MAGIC", # 0x00009fa0 44543 => "AFFS_SUPER_MAGIC", # 0x0000ADFF 61265 => "EXT2_OLD_SUPER_MAGIC", # 0x0000EF51 61267 => "EXT2_SUPER_MAGIC", # 0x0000EF53 72020 => "UFS_MAGIC", # 0x00011954 19911021 => "_XIAFS_SUPER_MAGIC", # 0x012FD16D 19920820 => "XENIX_SUPER_MAGIC", # 0x012FF7B4 19920821 => "SYSV4_SUPER_MAGIC", # 0x012FF7B5 19920822 => "SYSV2_SUPER_MAGIC", # 0x012FF7B6 19920823 => "COH_SUPER_MAGIC", # 0x012FF7B7 4187351113 => "HPFS_SUPER_MAGIC", # 0xF995E849 ); sub df ($) { my $dir = shift; my ($fmt, $res, $type, $flags, $osvers, $w); # struct fields for statfs or statvfs.... my ($bsize, $frsize, $blocks, $bfree, $bavail, $files, $ffree, $favail); Carp::croak "Usage: df '\$dir'" unless $dir; Carp::croak "Error: $dir is not a directory" unless -d $dir; # try with statvfs.. eval { # will work for Solaris 2.*, OSF1 v3.2, OSF1 v4.0 and HP-UX 10.*. { package main; require "sys/syscall.ph"; } $fmt = "\0" x 512; $res = syscall (&main::SYS_statvfs, $dir, $fmt) ; ($bsize, $frsize, $blocks, $bfree, $bavail, $files, $ffree, $favail) = unpack "L8", $fmt; # bsize: fundamental file system block size # frsize: fragment size # blocks: total blocks of frsize on fs # bfree: total free blocks of frsize # bavail: free blocks avail to non-superuser # files: total file nodes (inodes) # ffree: total free file nodes # favail: free nodes avail to non-superuser # to stay ok with statfs.. $type = 0; # should we try to read it from the structure ? it looks # possible at least under Solaris. $ffree = $favail; $bsize = $frsize; # $blocks -= $bfree - $bavail; $res == 0 && defined $fs_type{$type}; } # try with statfs.. || eval { # will work for SunOS 4, Linux 2.0.* and 2.2.* { package main; require "sys/syscall.ph"; } $fmt = "\0" x 512; $res = syscall (&main::SYS_statfs, $dir, $fmt); # statfs... if ($^O eq 'freebsd') { # only tested with FreeBSD 3.0. Should also work with 4.0. my ($f1, $f2); ($f1, $bsize, $f2, $blocks, $bfree, $bavail, $files, $ffree) = unpack "L8", $fmt; $type = 0; # read it from 'f_type' field ? } else { ($type, $bsize, $blocks, $bfree, $bavail, $files, $ffree) = unpack "L7", $fmt; } # type: type of filesystem (see below) # bsize: optimal transfer block size # blocks: total data blocks in file system # bfree: free blocks in fs # bavail: free blocks avail to non-superuser # files: total file nodes in file system # ffree: free file nodes in fs $res == 0 && defined $fs_type{$type}; } || eval { { package main; require "sys/syscall.ph"; } # The previous try gives an unknown fs type, it must be a different # structure format.. $fmt = "\0" x 512; # Try this : n2i7L119 $res = syscall (&main::SYS_statfs, $dir, $fmt); ($type, $flags, $bsize, $frsize, $blocks, $bfree, $bavail, $files, $ffree) = unpack "n2i7", $fmt; $res == 0 && defined $fs_type{$type}; } # Neither statfs nor statvfs.. too bad. || eval { $osvers = $Config{'osvers'}; $w = 0; # These system normaly works but there was a problem... # Trying to inform the user... if ($^O eq 'solaris' || $^O eq 'dec_osf') { # Tested. No problem if syscall.ph is present. warn "An error occured. statvfs failed. Did you run h2ph?\n"; $w = 2; } if ($^O eq 'linux' || $^O eq 'freebsd') { # Tested with linux 2.0.0 and 2.2.2 # No problem if syscall.ph is present. warn "An error occured. statfs failed. Did you run h2ph?\n"; } if ($^O eq 'hpux') { if ($osvers == 9) { # Tested. You have to change a line in syscall.ph. warn "An error occured. statfs failed. Did you run h2ph?\n" . "If you are using a hp9000s700, see the Df documentation\n"; } elsif ($osvers == 10) { # Tested. No problem if syscall.ph is present. warn "An error occured. statvfs failed. Did you run h2ph?\n"; } else { # Untested warn "An error occured. df failed. Please, submit a bug report.\n"; } $w = 3; } $w; } || Carp::croak "Cannot use df on this machine (untested or unsupported)."; exit if defined $w && $w > 0; $blocks -= $bfree - $bavail; if ($files == $ffree) { $files = 1; $ffree = 0; } warn "Warning : type $fs_type{$type} untested.. results may be incorrect\n" unless $type != 2560 && defined $fs_type{$type}; if ($DEBUG) { warn "Fs type : [$type] $fs_type{$type}\n" . "total space : ", $blocks * $bsize / 1024, " Kb\n" . "available space : ", $bavail * $bsize / 1024, " Kb\n\n"; if ($files == 1 && $ffree == 0) { warn "inodes : no information available\n"; } else { warn "inodes : $files\nfree inodes : $ffree\n" . "used inodes : ", $files - $ffree, "\n"; } } ($type, $fs_type{$type}, ($blocks - $bavail) * $bsize / 1024, $bavail * $bsize / 1024, $files - $ffree, $ffree); } 1; =head1 NAME Filesys::DiskSpace - Perl df =head1 SYNOPSIS use Filesys::DiskSpace; ($fs_type, $fs_desc, $used, $avail, $fused, $favail) = df $dir; =head1 DESCRIPTION This routine displays information on a file system such as its type, the amount of disk space occupied, the total disk space and the number of inodes. It tries C and C in several ways. If all fails, it Cs. =head1 OPTIONS =over 4 =item $fs_type [number] type of the filesystem. =item $fs_desc [string] description of this fs. =item $used [number] size used (in Kb). =item $avail [number] size available (in Kb). =item $ffree [number] free inodes. =item $fused [number] inodes used. =back =head1 Installation See the INSTALL file. =head1 COPYRIGHT Copyright (c) 1996-1999 Fabien Tassin. All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 AUTHOR Fabien Tassin Efta@oleane.netE =head1 NOTES This module was formerly called File::Df. It has been renamed into Filesys::DiskSpace. It could have be Filesys::Df but unfortunatly another module created in the meantime uses this name. Tested with Perl 5.003 under these systems : - Solaris 2.[4/5] - SunOS 4.1.[2/3/4] - HP-UX 9.05, 10.[1/20] (see below) - OSF1 3.2, 4.0 - Linux 2.0.*, 2.2.* Note for HP-UX users : if you obtain this message : "Undefined subroutine &main::SYS_statfs called at Filesys/DiskSpace.pm line XXX" and if you are using a hp9000s700, then edit the syscall.ph file (in the Perl lib tree) and copy the line containing "SYS_statfs {196;}" outside the "if (defined &__hp9000s800)" block (around line 356). =cut Filesys-DiskSpace-0.05/README0100644000175000017500000000176406711174432013724 0ustar ftafta NAME Filesys::DiskSpace - Perl df DESCRIPTION This routine displays information on a file system such as its type, the amount of disk space occupied, the total disk space and the number of inodes. It tries C and C in several ways. If all fails, it Cs. More information about this module is included in this package. INSTALLATION To install, cd to the directory containing the unpacked distribution and do one of the following: a. Create a makefile by running Makefile.PL using the perl program into whose library you want to install and then run make three times: perl Makefile.PL make make test make install b. To install into a private library, for example your home directory: perl Makefile.PL INSTALLSITELIB=$HOME/lib INSTALLMAN3DIR=$HOME/man make make test make pure_install Filesys-DiskSpace-0.05/MANIFEST0100644000175000017500000000021106734534253014165 0ustar ftaftaMANIFEST MANIFEST.SKIP Makefile.PL README lib/Filesys/DiskSpace.pm t/1st.t t/freebsd-ufs.t t/linux-ext2.t t/linux-vfat.t t/solaris-ufs.t