Description: Patch created from changes on upstream sources. Author: Dario Minnucci Last-Update: 2012-04-12 --- libfilesys-diskspace-perl-0.05.orig/lib/Filesys/DiskSpace.pm +++ libfilesys-diskspace-perl-0.05/lib/Filesys/DiskSpace.pm @@ -33,18 +33,29 @@ 61265 => "EXT2_OLD_SUPER_MAGIC", # 0x0000EF51 61267 => "EXT2_SUPER_MAGIC", # 0x0000EF53 72020 => "UFS_MAGIC", # 0x00011954 + 16914836 => "TMPFS_MAGIC", # 0x01021994 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 + 827541066 => "JFS_SUPER_MAGIC", # 0x3153464a + 1382369651 => "REISERFS_SUPER_MAGIC", # 0x52654973 + 1397118030 => "NTFS_SB_MAGIC", # 0x5346544e + 1481003842 => "XFS_SUPER_MAGIC", # 0x58465342 4187351113 => "HPFS_SUPER_MAGIC", # 0xF995E849 ); +if (0) { + printf "%10u 0x%010x %s\n", $_, $_, $fs_type{$_} + for sort { $a <=> $b } keys %fs_type; + exit 1; +} sub df ($) { my $dir = shift; - my ($fmt, $res, $type, $flags, $osvers, $w); + my ($fmt, $res, $type, $flags); + local $SIG{__DIE__}; # struct fields for statfs or statvfs.... my ($bsize, $frsize, $blocks, $bfree, $bavail, $files, $ffree, $favail); @@ -52,16 +63,18 @@ 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.*. - { + my $have_syscall_ph = eval { package main; require "sys/syscall.ph"; - } + }; + # try even if it's missing, maybe SYS_stat*() was defined by hand + + # try with statvfs.. + eval { # will work for Solaris 2.*, OSF1 v3.2, OSF1 v4.0 and HP-UX 10.*. $fmt = "\0" x 512; $res = syscall (&main::SYS_statvfs, $dir, $fmt) ; ($bsize, $frsize, $blocks, $bfree, $bavail, $files, $ffree, $favail) = - unpack "L8", $fmt; + unpack "L!8", $fmt; # bsize: fundamental file system block size # frsize: fragment size # blocks: total blocks of frsize on fs @@ -77,14 +90,12 @@ $ffree = $favail; $bsize = $frsize; # $blocks -= $bfree - $bavail; + warn "statvfs: res=$res type=$type\n" if $DEBUG; $res == 0 && defined $fs_type{$type}; } + || do { warn "statvfs failed: ", $@ if $DEBUG; 0 } # 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... @@ -93,12 +104,14 @@ # 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; + unpack "L!8", $fmt; $type = 0; # read it from 'f_type' field ? } else { + printf "raw L7 %s\n", join " ", unpack "L!7", $fmt + if $DEBUG && $DEBUG > 1; ($type, $bsize, $blocks, $bfree, $bavail, $files, $ffree) = - unpack "L7", $fmt; + unpack "L!7", $fmt; } # type: type of filesystem (see below) # bsize: optimal transfer block size @@ -108,59 +121,62 @@ # files: total file nodes in file system # ffree: free file nodes in fs + warn "statfs: res=$res type=$type\n" if $DEBUG; $res == 0 && defined $fs_type{$type}; } + || do { warn "statfs L7 failed: ", $@ if $DEBUG; 0 } || 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); + printf "raw n2i7 %s\n", join " ", unpack "n2i7", $fmt + if $DEBUG && $DEBUG > 1; ($type, $flags, $bsize, $frsize, $blocks, $bfree, $bavail, $files, $ffree) = unpack "n2i7", $fmt; + warn "statfs n2i7: res=$res type=$type\n" if $DEBUG; $res == 0 && defined $fs_type{$type}; } + || do { warn "statfs n2i7 failed: ", $@ if $DEBUG; 0 } # Neither statfs nor statvfs.. too bad. - || eval { - $osvers = $Config{'osvers'}; - $w = 0; + || do { + if (!$have_syscall_ph) { + if ($Config{'d_syscall'} eq 'define') { + Carp::croak "sys/syscall.ph is missing, see the h2ph man page"; + } + } + my $syscall; + my $extra = ''; + my $osvers = $Config{'osvers'}; # 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; + $syscall = 'statvfs'; } - if ($^O eq 'linux' || $^O eq 'freebsd') { + elsif ($^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"; + $syscall = 'statfs'; } - if ($^O eq 'hpux') { + elsif ($^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"; + $syscall = 'statfs'; + $extra = " (if you are using a hp9000s700, see the " + . __PACKAGE__ . " documentation)"; } 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"; + $syscall = 'statvfs'; } - $w = 3; } - $w; - } - || Carp::croak "Cannot use df on this machine (untested or unsupported)."; - - exit if defined $w && $w > 0; + if ($syscall) { + Carp::croak "$syscall failed on $dir (new filesystem type?)$extra"; + } + Carp::croak "Cannot use df on this machine (untested or unsupported)."; + }; $blocks -= $bfree - $bavail; @@ -249,7 +265,7 @@ =head1 AUTHOR -Fabien Tassin Efta@oleane.netE +Fabien Tassin Efta+cpan@sofaraway.orgE =head1 NOTES --- libfilesys-diskspace-perl-0.05.orig/t/freebsd-ufs.t +++ libfilesys-diskspace-perl-0.05/t/freebsd-ufs.t @@ -9,7 +9,7 @@ my $t = 1; unless ($^O eq 'freebsd') { - print "1..0\n"; + print "1..0 # skip not applicable on this platform\n"; exit; } --- libfilesys-diskspace-perl-0.05.orig/t/linux-ext2.t +++ libfilesys-diskspace-perl-0.05/t/linux-ext2.t @@ -7,34 +7,58 @@ local $^W = 1; my $t = 1; +my %fs = ( + ext2 => 0x0000EF53, + ext3 => 0x0000EF53, + ntfs => 0x5346544e, + tmpfs => 0x01021994, +); +my %dir_fs_type; unless ($^O eq 'linux') { - print "1..0\n"; + print "1..0 # skip not applicable on this platform\n"; exit; } my $bindf = '/bin/df'; my $mnttab = '/etc/mtab'; +my $procmounts = '/proc/mounts'; my ($data, $dirs); -open (MOUNT, $mnttab) || die "Error: $!\n"; +if (!open MOUNT, $mnttab) { + my $err1 = $!; + if (!open MOUNT, $procmounts) { + print "1..0 # skip can't open $mnttab ($err1) or $procmounts ($!)\n"; + exit; + } +} while (defined (my $d = )) { - my @tab = split /\s+/, $d; - push @$dirs, $tab[1] if $tab[2] eq 'ext2'; + my @tab = split ' ', $d; + #printf "%-10s %s\n", $tab[2], $tab[1]; + my $fs_type = $fs{$tab[2]}; + $dir_fs_type{$tab[1]} = $fs_type if $fs_type; } +@$dirs = keys %dir_fs_type if %dir_fs_type; close MOUNT; -open (DF, "$bindf -k @$dirs |") || die "Error: $!\n"; +unless ($dirs) { + print "1..0 # skip no filesystems for this test\n"; + exit; +} +my $q_dirs = join " ", map { quotemeta } @$dirs; +open (DF, "$bindf -k $q_dirs |") || die "can't fork df: $!\n"; while (defined (my $d = )) { - my @tab = split /\s+/, $d; + my @tab = split ' ', $d; next if $tab[0] eq 'Filesystem'; + push @tab, split ' ', scalar if @tab == 1; # long device name $$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; + my @tab = split ' ', $d; next if $tab[0] eq 'Filesystem'; + push @tab, split ' ', scalar if @tab == 1; # long device name $$data{$tab[5]}{'fused'} = $tab[2]; $$data{$tab[5]}{'favail'} = $tab[3]; } @@ -44,7 +68,7 @@ for my $part (keys %$data) { my ($fs_type, $fs_desc, $used, $avail, $fused, $favail) = df $part; - my $res = $fs_type == 61267 && + my $res = $fs_type == $dir_fs_type{$part} && $$data{$part}{'used'} == $used && $$data{$part}{'avail'} == $avail && $$data{$part}{'fused'} == $fused && @@ -60,5 +84,5 @@ print "Iavail: $$data{$part}{'favail'} <> $favail\n" unless $$data{$part}{'favail'} == $favail; } - print $res ? "" : "not ", "ok ", $t++, "\n"; + print $res ? "" : "not ", "ok ", $t++, " # $part\n"; } --- libfilesys-diskspace-perl-0.05.orig/t/linux-vfat.t +++ libfilesys-diskspace-perl-0.05/t/linux-vfat.t @@ -12,28 +12,38 @@ my $t = 1; unless ($^O eq 'linux') { - print "1..0\n"; + print "1..0 # skip not applicable on this platform\n"; exit; } my $bindf = '/bin/df'; my $mnttab = '/etc/mtab'; +my $procmounts = '/proc/mounts'; my ($data, $dirs); -open (MOUNT, $mnttab) || die "Error: $!\n"; +if (!open MOUNT, $mnttab) { + my $err1 = $!; + if (!open MOUNT, $procmounts) { + print "1..0 # skip can't open $mnttab ($err1) or $procmounts ($!)\n"; + exit; + } +} while (defined (my $d = )) { my @tab = split /\s+/, $d; + #printf "%-10s %s\n", $tab[2], $tab[1]; push @$dirs, $tab[1] if $tab[2] eq 'vfat'; } close MOUNT; unless ($dirs) { - print "1..1\nok 1\n"; + print "1..0 # skip no vfat filesystems to test\n"; exit; } -open (DF, "$bindf -k @$dirs |") || die "Error: $!\n"; +my $q_dirs = join " ", map { quotemeta } @$dirs; +open (DF, "$bindf -k $q_dirs |") || die "can't fork df: $!\n"; while (defined (my $d = )) { my @tab = split /\s+/, $d; next if $tab[0] eq 'Filesystem'; + push @tab, split ' ', scalar if @tab == 1; # long device name $$data{$tab[5]}{'used'} = $tab[2]; $$data{$tab[5]}{'avail'} = $tab[3]; } --- libfilesys-diskspace-perl-0.05.orig/t/solaris-ufs.t +++ libfilesys-diskspace-perl-0.05/t/solaris-ufs.t @@ -11,7 +11,7 @@ my $t = 1; unless ($^O eq 'solaris') { - print "1..0\n"; + print "1..0 # skip not applicable on this platform\n"; exit; }