Description: Patch created from changes on upstream sources.
Author: Dario Minnucci <midget@debian.org>
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 E<lt>fta@oleane.netE<gt>
+Fabien Tassin E<lt>fta+cpan@sofaraway.orgE<gt>
 
 =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 = <MOUNT>)) {
-  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 = <DF>)) {
-  my @tab = split /\s+/, $d;
+  my @tab = split ' ', $d;
   next if $tab[0] eq 'Filesystem';
+  push @tab, split ' ', scalar <DF> 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 = <DF>)) {
-  my @tab = split /\s+/, $d;
+  my @tab = split ' ', $d;
   next if $tab[0] eq 'Filesystem';
+  push @tab, split ' ', scalar <DF> 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 = <MOUNT>)) {
   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 = <DF>)) {
   my @tab = split /\s+/, $d;
   next if $tab[0] eq 'Filesystem';
+  push @tab, split ' ', scalar <DF> 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;
 }