r4384 - in /packages/libfilesys-df-perl: ./ branches/
branches/upstream/ branches/upstream/current/ tags/
gregoa-guest at users.alioth.debian.org
gregoa-guest at users.alioth.debian.org
Fri Nov 24 21:40:59 CET 2006
Author: gregoa-guest
Date: Fri Nov 24 21:40:59 2006
New Revision: 4384
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=4384
Log:
[svn-inject] Installing original source of libfilesys-df-perl
Added:
packages/libfilesys-df-perl/
packages/libfilesys-df-perl/branches/
packages/libfilesys-df-perl/branches/upstream/
packages/libfilesys-df-perl/branches/upstream/current/
packages/libfilesys-df-perl/branches/upstream/current/Changes
packages/libfilesys-df-perl/branches/upstream/current/Df.pm
packages/libfilesys-df-perl/branches/upstream/current/MANIFEST
packages/libfilesys-df-perl/branches/upstream/current/META.yml
packages/libfilesys-df-perl/branches/upstream/current/Makefile.PL
packages/libfilesys-df-perl/branches/upstream/current/README
packages/libfilesys-df-perl/branches/upstream/current/XS_statfs
packages/libfilesys-df-perl/branches/upstream/current/XS_statvfs
packages/libfilesys-df-perl/branches/upstream/current/test.pl
packages/libfilesys-df-perl/branches/upstream/current/typemap
packages/libfilesys-df-perl/tags/
Added: packages/libfilesys-df-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libfilesys-df-perl/branches/upstream/current/Changes?rev=4384&op=file
==============================================================================
--- packages/libfilesys-df-perl/branches/upstream/current/Changes (added)
+++ packages/libfilesys-df-perl/branches/upstream/current/Changes Fri Nov 24 21:40:59 2006
@@ -1,0 +1,11 @@
+Revision history for Perl extension Filesys::Df
+
+0.90 Sat May 15 01:29:11 2006
+ - Rewrote most of the module
+
+0.91 Fri Jun 23 10:25:11 2006
+ - Cleaned up documentation a little. No
+ code changes.
+
+0.92 Sat Jun 24 11:02:11 2006
+ - More documentation changes. No code changes.
Added: packages/libfilesys-df-perl/branches/upstream/current/Df.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libfilesys-df-perl/branches/upstream/current/Df.pm?rev=4384&op=file
==============================================================================
--- packages/libfilesys-df-perl/branches/upstream/current/Df.pm (added)
+++ packages/libfilesys-df-perl/branches/upstream/current/Df.pm Fri Nov 24 21:40:59 2006
@@ -1,0 +1,334 @@
+package Filesys::Df;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+use Carp;
+require Exporter;
+require DynaLoader;
+require 5.006;
+
+ at ISA = qw(Exporter DynaLoader);
+ at 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__
+
+=head1 NAME
+
+Filesys::Df - Perl extension for filesystem disk space information.
+
+=head1 SYNOPSIS
+
+
+ use Filesys::Df;
+
+ #### Get information by passing a scalar directory/filename value
+ my $ref = df("/tmp"); # Default output is 1K blocks
+ if(defined($ref)) {
+ print "Total 1k blocks: $ref->{blocks}\n";
+ print "Total 1k blocks free: $ref->{bfree}\n";
+ print "Total 1k blocks avail to me: $ref->{bavail}\n";
+ print "Total 1k blocks used: $ref->{used}\n";
+ print "Percent full: $ref->{per}\n";
+
+ if(exists($ref->{files})) {
+ print "Total inodes: $ref->{files}\n";
+ print "Total inodes free: $ref->{ffree}\n";
+ print "Inode percent full: $ref->{fper}\n";
+ }
+ }
+
+ #### Get information by passing a filehandle
+ open(FILE, "some_file"); # Get information for filesystem at "some_file"
+ my $ref = df(\*FILE);
+ #### or
+ my $ref = df(*FILE);
+ #### or
+ my $fhref = \*FILE;
+ my $ref = df($fhref);
+
+ #### Get information in other than 1k blocks
+ my $ref = df("/tmp", 8192); # output is 8K blocks
+ my $ref = df("/tmp", 1); # output is bytes
+
+=head1 DESCRIPTION
+
+This module provides a way to obtain filesystem disk space
+information. This is a Unix only distribution. If you want to
+gather this information for Unix and Windows, use C<Filesys::DfPortable>.
+The only major benefit of using C<Filesys::Df> over C<Filesys::DfPortable>,
+is that C<Filesys::Df> supports the use of open filehandles as arguments.
+
+The module should work with all flavors of Unix that implement the
+C<statvfs()> and C<fstatvfs()> calls, or the C<statfs()> and C<fstatfs()> calls.
+This would include Linux, *BSD, HP-UX, AIX, Solaris, Mac OS X, Irix,
+Cygwin, etc ...
+
+C<df()> requires a argument that represents the filesystem you want to
+query. The argument can be either a scalar directory/file name or a
+open filehandle. There is also an optional block size argument so
+you can tailor the size of the values returned. The default block
+size is 1024. This will cause the function to return the values in 1k
+blocks. If you want bytes, set the block size to 1.
+
+C<df()> returns a reference to a hash. The keys available in
+the hash are as follows:
+
+C<{blocks}> = Total blocks on the filesystem.
+
+C<{bfree}> = Total blocks free on the filesystem.
+
+C<{bavail}> = Total blocks available to the user executing the Perl
+application. This can be different than C<{bfree}> if you have per-user
+quotas on the filesystem, or if the super user has a reserved amount.
+C<{bavail}> can also be a negative value because of this. For instance
+if there is more space being used then you have available to you.
+
+C<{used}> = Total blocks used on the filesystem.
+
+C<{per}> = Percent of disk space used. This is based on the disk space
+available to the user executing the application. In other words, if
+the filesystem has 10% of its space reserved for the superuser, then
+the percent used can go up to 110%.
+
+You can obtain inode information through the module as well, but you
+must call C<exists()> on the C<{files}> key first, to make sure the information
+is available. Some filesystems may not return inode information, for example
+some NFS filesystems.
+
+Here are the available inode keys:
+
+C<{files}> = Total inodes on the filesystem.
+
+C<{ffree}> = Total inodes free on the filesystem.
+
+C<{favail}> = Total inodes available to the user executing the application.
+See the rules for the C<{bavail}> key.
+
+C<{fused}> = Total inodes used on the filesystem.
+
+C<{fper}> = Percent of inodes used on the filesystem. See rules for the C<{per}>
+key.
+
+There are some undocumented keys that are defined to maintain backwards
+compatibilty: C<{su_blocks}>, C<{user_blocks}>, etc ...
+
+If the C<df()> call fails for any reason, it will return
+undef. This will probably happen if you do anything crazy like try
+to get information for /proc, or if you pass an invalid filesystem name,
+or if there is an internal error. C<df()> will C<croak()> if you pass
+it a undefined value.
+
+Requirements:
+Your system must contain C<statvfs()> and C<fstatvfs()>, or C<statfs()> and C<fstatfs()>
+You must be running Perl 5.6 or higher.
+
+=head1 AUTHOR
+
+Ian Guthrie
+IGuthrie at aol.com
+
+Copyright (c) 2006 Ian Guthrie. All rights reserved.
+ This program is free software; you can redistribute it and/or
+ modify it under the same terms as Perl itself.
+
+=head1 SEE ALSO
+
+statvfs(2), fstatvfs(2), statfs(2), fstatfs(2), df(1), Filesys::DfPortable
+
+perl(1).
+
+=cut
Added: packages/libfilesys-df-perl/branches/upstream/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libfilesys-df-perl/branches/upstream/current/MANIFEST?rev=4384&op=file
==============================================================================
--- packages/libfilesys-df-perl/branches/upstream/current/MANIFEST (added)
+++ packages/libfilesys-df-perl/branches/upstream/current/MANIFEST Fri Nov 24 21:40:59 2006
@@ -1,0 +1,10 @@
+Makefile.PL
+MANIFEST
+README
+Df.pm
+XS_statvfs
+XS_statfs
+test.pl
+typemap
+Changes
+META.yml Module meta-data (added by MakeMaker)
Added: packages/libfilesys-df-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libfilesys-df-perl/branches/upstream/current/META.yml?rev=4384&op=file
==============================================================================
--- packages/libfilesys-df-perl/branches/upstream/current/META.yml (added)
+++ packages/libfilesys-df-perl/branches/upstream/current/META.yml Fri Nov 24 21:40:59 2006
@@ -1,0 +1,10 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Filesys-Df
+version: 0.92
+version_from: Df.pm
+installdirs: site
+requires:
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.30
Added: packages/libfilesys-df-perl/branches/upstream/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libfilesys-df-perl/branches/upstream/current/Makefile.PL?rev=4384&op=file
==============================================================================
--- packages/libfilesys-df-perl/branches/upstream/current/Makefile.PL (added)
+++ packages/libfilesys-df-perl/branches/upstream/current/Makefile.PL Fri Nov 24 21:40:59 2006
@@ -1,0 +1,186 @@
+use ExtUtils::MakeMaker;
+use Config qw(%Config);
+
+#### Build information
+my $statvfs_header = "sys/statvfs.h";
+my $statfs_header = "sys/statfs.h";
+my $statvfs_symbol = "d_statvfs";
+my $statvfs_header_def = "i_sysstatvfs";
+my $statfs_symbol = "d_statfs_s"; #### Really the struct def, we equate it to statfs being defined
+my $statfs_header_def = "i_sysstatfs";
+my $define = "";
+my $statfs_use_mount = 0;
+my $xs_file = 'Df.xs';
+
+
+print "OS = $Config{osname}\n";
+
+#### Windows
+if($Config{osname} =~ /^MSWin/i) {
+ print "This module does not support Windows.\n";
+ die "You might try Filesys::DfPortable instead.\n";
+}
+
+#### Check for the existance of statvfs
+if(check_statvfs()) {
+ ####$define .= "-DDF_STATVFS ";
+ copy_xs("XS_statvfs", $xs_file);
+ print "Building with statvfs ....\n";
+}
+
+#### Check for the existance of statfs
+elsif(check_statfs()) {
+ #### use_mount needed for headers
+ ($statfs_use_mount) &&
+ ($define .= "-DDF_STATFS_USE_MOUNT ") ||
+ ($define .= "-DDF_STATFS ");
+
+ #### Needed for 4 arg statfs
+ ($Config{osname} =~ /^solaris$/i) &&
+ ($define .= "-DDF_SOLARIS ");
+
+ copy_xs("XS_statfs", $xs_file);
+ print "Building with statfs ....\n";
+}
+
+#### OS/2, old Mac, etc
+else {
+ print "We could not find statvfs, or statfs.\n";
+ die "You need at least one of these to build this module.\n";
+}
+
+
+
+sub check_statvfs {
+ print "Checking for statvfs .....\n";
+ if(exists $Config{$statvfs_symbol} && defined $Config{$statvfs_symbol}) {
+ print "$statvfs_symbol is defined.\n";
+ if(exists $Config{$statvfs_header_def} && defined $Config{$statvfs_header_def}) {
+ print "$statvfs_header_def is defined.\n";
+ return(1);
+ }
+
+ else {
+ print "Weird, $statvfs_header_def is not defined.\n";
+ #### Have never seen a system with statvfs and no sys/statvfs.h header
+ #### Lets see if we can find one
+ if(look_for_header($statvfs_header)) {
+ return(1);
+ }
+
+ else {
+ #### no idea what header would be
+ print "Cannot find a $statvfs_header file\n";
+ print "We will not try to build with statvfs\n";
+ return(0);
+ }
+ }
+ }
+
+ else {
+ print "$statvfs_symbol is not defined\n";
+
+ ### OK if we find a header should we build with it?
+ if(look_for_header($statvfs_header)) {
+ return(1);
+ }
+
+ else {
+ #### don't use statvfs
+ print "Cannot find a $statvfs_header file\n";
+ print "We will not try to build with statvfs\n";
+ return(0);
+ }
+ }
+
+ return(0);
+}
+
+
+sub check_statfs {
+ print "Checking for statfs .....\n";
+ if(exists $Config{$statfs_symbol} && defined $Config{$statfs_symbol}) {
+ print "Good, $statfs_symbol is defined.\n";
+ if(exists $Config{$statfs_header_def} && defined $Config{$statfs_header_def}) {
+ print "$statfs_header_def is defined.\n";
+ return(1);
+ }
+
+ else {
+ print "$statfs_header_def not defined.\n";
+ #### check for BSD and Darwin
+ if($Config{osname} =~ /^darwin|^bsd|bsd$/i) {
+ print "You are running Darwin or BSD.\n";
+ print "Will assume you need the mount.h and param.h headers.\n";
+ $statfs_use_mount = 1;
+ return(1);
+ }
+
+ elsif(look_for_header($statfs_header)) {
+ return(1);
+ }
+
+ else {
+ #### don't use statfs
+ print "Cannot find a $statfs_header file\n";
+ print "We will not try to build Statfs\n";
+ }
+ }
+ }
+
+ else {
+ print "$statfs_symbol is not defined\n";
+
+ if(look_for_header($statfs_header)) {
+ return(1);
+ }
+
+ else {
+ print "Cannot find a $statfs_header file\n";
+ print "We will not try to build Statfs\n";
+ return(0);
+ }
+ }
+
+ return(0);
+}
+
+
+sub copy_xs {
+my $source = shift;
+my $dest = shift;
+
+ open(SOURCE, "$source") or die "$! $source\n";
+ open(DEST, ">$dest") or die "$! $dest\n";
+ @contents = <SOURCE>;
+ print DEST @contents;
+ close(DEST);
+ close(SOURCE);
+}
+
+
+sub look_for_header {
+my $header = shift;
+
+ #my @header_inc = split(/\s+/, join(" ", $Config{usrinc}, $Config{locincpth}));
+ my @header_inc = split(/\s+/, join(" ", $Config{usrinc}));
+ foreach $header_path (@header_inc) {
+ if(-f $header_path . '/' . $header) {
+ print "Header found:" , $header_path . '/' . $header, "\n";
+ return(1);
+ }
+ }
+
+ return(0);
+}
+
+
+WriteMakefile(
+ 'NAME' => 'Filesys::Df',
+ 'VERSION_FROM' => 'Df.pm', # finds $VERSION
+ 'LIBS' => [''], # e.g., '-lm'
+ 'DEFINE' => $define, # e.g., '-DHAVE_SOMETHING'
+ 'INC' => '', # e.g., '-I/usr/include/other'
+ 'clean' => {FILES => 'Df.xs'},
+ 'XSPROTOARG' => '-prototypes'
+);
Added: packages/libfilesys-df-perl/branches/upstream/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libfilesys-df-perl/branches/upstream/current/README?rev=4384&op=file
==============================================================================
--- packages/libfilesys-df-perl/branches/upstream/current/README (added)
+++ packages/libfilesys-df-perl/branches/upstream/current/README Fri Nov 24 21:40:59 2006
@@ -1,0 +1,149 @@
+INSTALL
+TO INSTALL RUN:
+
+ perl Makefile.PL
+ make
+ make test
+ make install
+
+
+During the build process, the makefile will try to figure out which
+system calls to use to obtain filesystem information. It will look
+for statvfs() first via the Config module and a include directory
+search. If it locates statvfs(), it will assume the system also has
+fstatvfs(). If it cannot find statvfs(), it will then begin the same
+search for statfs(). If statfs() is found it will assume fstatfs()
+is also available.
+
+During the 'make test', test.pl will try to test with '/' and then
+open test.pl in the current directory and use that for a filehandle
+test.
+
+Once installed, run 'perldoc Filesys::Df' for more information.
+
+If you have any problems or questions please email me at IGuthrie at aol.com
+with "Filesys::Df" in the subject line. If you run into a build problem,
+please include the output of the install commands, the version of Perl
+you are using (perl -v), and what operating system you are using.
+
+
+Module Documentation:
+This distribution contains the module Filesys::Df
+
+Filesys::Df - Perl extension for filesystem disk space information.
+
+SYNOPSIS
+
+ use Filesys::Df;
+
+ #### Get information by passing a scalar directory/filename value
+ my $ref = df("/tmp"); # Default output is 1K blocks
+ if(defined($ref)) {
+ print "Total 1k blocks: $ref->{blocks}\n";
+ print "Total 1k blocks free: $ref->{bfree}\n";
+ print "Total 1k blocks avail to me: $ref->{bavail}\n";
+ print "Total 1k blocks used: $ref->{used}\n";
+ print "Percent full: $ref->{per}\n";
+
+ if(exists($ref->{files})) {
+ print "Total inodes: $ref->{files}\n";
+ print "Total inodes free: $ref->{ffree}\n";
+ print "Inode percent full: $ref->{fper}\n";
+ }
+ }
+
+ #### Get information by passing a filehandle
+ open(FILE, "some_file"); # Get information for filesystem at "some_file"
+ my $ref = df(\*FILE);
+ #### or
+ my $ref = df(*FILE);
+ #### or
+ my $fhref = \*FILE;
+ my $ref = df($fhref);
+
+ #### Get information in other than 1k blocks
+ my $ref = df("/tmp", 8192); # output is 8K blocks
+ my $ref = df("/tmp", 1); # output is bytes
+
+
+DESCRIPTION
+
+This module provides a way to obtain filesystem disk space
+information. This is a Unix only distribution. If you want to
+gather this information for Unix and Windows, use Filesys::DfPortable.
+The only major benefit of using Filesys::Df over Filesys::DfPortable,
+is that Filesys::Df supports the use of open filehandles as arguments.
+
+The module should work with all flavors of Unix that implement the
+statvfs() and fstatvfs() calls, or the statfs() and fstatfs() calls.
+This would include Linux, *BSD, HP-UX, AIX, Solaris, Mac OS X, Irix,
+Cygwin, etc ...
+
+df() requires a argument that represents the filesystem you want to
+query. The argument can be either a scalar directory/file name or a
+open filehandle. There is also an optional block size argument so
+you can tailor the size of the values returned. The default block
+size is 1024. This will cause the function to return the values in 1k
+blocks. If you want bytes, set the block size to 1.
+
+df() returns a reference to a hash. The keys available in
+the hash are as follows:
+
+{blocks} = Total blocks on the filesystem.
+
+{bfree} = Total blocks free on the filesystem.
+
+{bavail} = Total blocks available to the user executing the Perl
+application. This can be different than bfree if you have per-user
+quotas on the filesystem, or if the super user has a reserved amount.
+{bavail} can also be a negative value because of this. For instance
+if there is more space being used then you have available to you.
+
+{used} = Total blocks used on the filesystem.
+
+{per} = Percent of disk space used. This is based on the disk space
+available to the user executing the application. In other words, if
+the filesystem has 10% of its space reserved for the superuser, then
+the percent used can go up to 110%.
+
+You can obtain inode information through the module as well. But you
+must call exists() on the {files} key to make sure the information is
+available:
+if(exists($ref->{files})) {
+ #### Inode info is available
+}
+Some filesystems may not return inode information, for
+example some NFS filesystems.
+
+Here are the available inode keys:
+
+{files} = Total inodes on the filesystem.
+
+{ffree} = Total inodes free on the filesystem.
+
+{favail} = Total inodes available to the user executing the application.
+See the rules for the {bavail} key.
+
+{fused} = Total inodes used on the filesystem.
+
+{fper} = Percent of inodes used on the filesystem. See rules for the {per}
+key.
+
+There are some undocumented keys that are defined to maintain backwards
+compatibility: {su_blocks}, {user_blocks}, etc ...
+
+If the df() call fails for any reason, it will return
+undef. This will probably happen if you do anything crazy like try
+to get information for /proc, or if you pass an invalid filesystem name,
+or if there is an internal error. df() will croak() if you pass
+it a undefined value.
+
+
+Requirements:
+Your system must contain statvfs() and fstatvfs(), or statfs() and fstatfs()
+You must be running Perl 5.6 or higher.
+
+Copyright (c) 2006 Ian Guthrie. All rights reserved.
+ This program is free software; you can redistribute it and/or
+ modify it under the same terms as Perl itself.
+
Added: packages/libfilesys-df-perl/branches/upstream/current/XS_statfs
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libfilesys-df-perl/branches/upstream/current/XS_statfs?rev=4384&op=file
==============================================================================
--- packages/libfilesys-df-perl/branches/upstream/current/XS_statfs (added)
+++ packages/libfilesys-df-perl/branches/upstream/current/XS_statfs Fri Nov 24 21:40:59 2006
@@ -1,0 +1,100 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#ifdef DF_STATFS_USE_MOUNT
+#include <sys/param.h>
+#include <sys/mount.h>
+#endif
+#ifdef DF_STATFS
+#include <sys/statfs.h>
+#endif
+#ifdef __cplusplus
+}
+#endif
+
+
+typedef struct statfs Statfs;
+
+
+MODULE = Filesys::Df PACKAGE = Filesys::Df
+
+void
+_df(dir)
+ char *dir
+ PREINIT:
+ Statfs st;
+ PPCODE:
+ EXTEND(sp, 7);
+#ifdef DF_SOLARIS
+ if(statfs(dir, &st, 0, 0) == 0) {
+#else
+ if(statfs(dir, &st) == 0) {
+#endif
+ PUSHs(sv_2mortal(newSVnv((double)st.f_bsize)));
+ PUSHs(sv_2mortal(newSVnv((double)st.f_blocks)));
+ PUSHs(sv_2mortal(newSVnv((double)st.f_bfree)));
+#ifdef DF_SOLARIS
+ PUSHs(sv_2mortal(newSVnv((double)st.f_bfree)));
+#else
+ PUSHs(sv_2mortal(newSVnv((double)st.f_bavail)));
+#endif
+ PUSHs(sv_2mortal(newSVnv((double)st.f_files)));
+ PUSHs(sv_2mortal(newSVnv((double)st.f_ffree)));
+ /* No favail */
+ PUSHs(sv_2mortal(newSVnv((double)st.f_ffree)));
+ }
+
+ else {
+ PUSHs(sv_2mortal(newSVuv(0)));
+ PUSHs(sv_2mortal(newSVuv(0)));
+ PUSHs(sv_2mortal(newSVuv(0)));
+ PUSHs(sv_2mortal(newSVuv(0)));
+
+ PUSHs(sv_2mortal(newSVuv(0)));
+ PUSHs(sv_2mortal(newSVuv(0)));
+ PUSHs(sv_2mortal(newSVuv(0)));
+ }
+
+void
+_df_fh(fd)
+ int fd
+ PREINIT:
+ Statfs st;
+ PPCODE:
+ EXTEND(sp, 7);
+#ifdef DF_SOLARIS
+ if(fstatfs(fd, &st, 0, 0) == 0) {
+#else
+ if(fstatfs(fd, &st) == 0) {
+#endif
+ PUSHs(sv_2mortal(newSVnv((double)st.f_bsize)));
+ PUSHs(sv_2mortal(newSVnv((double)st.f_blocks)));
+ PUSHs(sv_2mortal(newSVnv((double)st.f_bfree)));
+#ifdef DF_SOLARIS
+ PUSHs(sv_2mortal(newSVnv((double)st.f_bfree)));
+#else
+ PUSHs(sv_2mortal(newSVnv((double)st.f_bavail)));
+#endif
+ PUSHs(sv_2mortal(newSVnv((double)st.f_files)));
+ PUSHs(sv_2mortal(newSVnv((double)st.f_ffree)));
+ /* No favail */
+ PUSHs(sv_2mortal(newSVnv((double)st.f_ffree)));
+ }
+
+ else {
+ PUSHs(sv_2mortal(newSVuv(0)));
+ PUSHs(sv_2mortal(newSVuv(0)));
+ PUSHs(sv_2mortal(newSVuv(0)));
+ PUSHs(sv_2mortal(newSVuv(0)));
+
+ PUSHs(sv_2mortal(newSVuv(0)));
+ PUSHs(sv_2mortal(newSVuv(0)));
+ PUSHs(sv_2mortal(newSVuv(0)));
+ }
+
+
+
+
Added: packages/libfilesys-df-perl/branches/upstream/current/XS_statvfs
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libfilesys-df-perl/branches/upstream/current/XS_statvfs?rev=4384&op=file
==============================================================================
--- packages/libfilesys-df-perl/branches/upstream/current/XS_statvfs (added)
+++ packages/libfilesys-df-perl/branches/upstream/current/XS_statvfs Fri Nov 24 21:40:59 2006
@@ -1,0 +1,77 @@
+#ifdef __cplusplus
+extern "C" {
+#endif
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include <sys/statvfs.h>
+#ifdef __cplusplus
+}
+#endif
+
+typedef struct statvfs Statvfs;
+
+
+MODULE = Filesys::Df PACKAGE = Filesys::Df
+
+
+void
+_df(dir)
+ char *dir
+ PREINIT:
+ Statvfs st;
+ PPCODE:
+ EXTEND(sp, 7);
+ if(statvfs(dir, &st) == 0) {
+ /* Push values as doubles because we don't know size */
+ PUSHs(sv_2mortal(newSVnv((double)st.f_frsize)));
+ PUSHs(sv_2mortal(newSVnv((double)st.f_blocks)));
+ PUSHs(sv_2mortal(newSVnv((double)st.f_bfree)));
+ PUSHs(sv_2mortal(newSVnv((double)st.f_bavail)));
+
+ PUSHs(sv_2mortal(newSVnv((double)st.f_files)));
+ PUSHs(sv_2mortal(newSVnv((double)st.f_ffree)));
+ PUSHs(sv_2mortal(newSVnv((double)st.f_favail)));
+ }
+
+ else {
+ PUSHs(sv_2mortal(newSVuv(0)));
+ PUSHs(sv_2mortal(newSVuv(0)));
+ PUSHs(sv_2mortal(newSVuv(0)));
+ PUSHs(sv_2mortal(newSVuv(0)));
+
+ PUSHs(sv_2mortal(newSVuv(0)));
+ PUSHs(sv_2mortal(newSVuv(0)));
+ PUSHs(sv_2mortal(newSVuv(0)));
+ }
+
+void
+_df_fh(fd)
+ int fd;
+ PREINIT:
+ Statvfs st;
+ PPCODE:
+ EXTEND(sp, 7);
+ if(fstatvfs(fd, &st) == 0) {
+ /* Push values as doubles because we don't know size */
+ PUSHs(sv_2mortal(newSVnv((double)st.f_frsize)));
+ PUSHs(sv_2mortal(newSVnv((double)st.f_blocks)));
+ PUSHs(sv_2mortal(newSVnv((double)st.f_bfree)));
+ PUSHs(sv_2mortal(newSVnv((double)st.f_bavail)));
+
+ PUSHs(sv_2mortal(newSVnv((double)st.f_files)));
+ PUSHs(sv_2mortal(newSVnv((double)st.f_ffree)));
+ PUSHs(sv_2mortal(newSVnv((double)st.f_favail)));
+ }
+
+ else {
+ PUSHs(sv_2mortal(newSVuv(0)));
+ PUSHs(sv_2mortal(newSVuv(0)));
+ PUSHs(sv_2mortal(newSVuv(0)));
+ PUSHs(sv_2mortal(newSVuv(0)));
+
+ PUSHs(sv_2mortal(newSVuv(0)));
+ PUSHs(sv_2mortal(newSVuv(0)));
+ PUSHs(sv_2mortal(newSVuv(0)));
+ }
+
Added: packages/libfilesys-df-perl/branches/upstream/current/test.pl
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libfilesys-df-perl/branches/upstream/current/test.pl?rev=4384&op=file
==============================================================================
--- packages/libfilesys-df-perl/branches/upstream/current/test.pl (added)
+++ packages/libfilesys-df-perl/branches/upstream/current/test.pl Fri Nov 24 21:40:59 2006
@@ -1,0 +1,62 @@
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..2\n"; }
+END {print "not ok 1\n" unless $loaded;}
+require 5.006;
+use Config qw(%Config);
+use Filesys::Df;
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+my $dir = "/";
+
+my $ref = Filesys::Df::df($dir);
+
+defined($ref) and
+ print"ok 2\n" or
+ die "not ok 2\ndf\(\) call failed for \"$dir\" $!\n";
+
+open(FILE, "./test.pl") or die "$! ./test.pl\n";
+my $fh_ref = Filesys::Df::df(\*FILE);
+close(FILE);
+
+defined($fh_ref) and
+ print"ok 3\n\n" or
+ die "not ok 3\ndf\(\) call failed for \"test.pl\" $!\n";
+
+print"Results for directory: \"$dir\" in 1K blocks:\n";
+print "Total: $ref->{blocks}\n";
+print "Free: $ref->{bfree}\n";
+print "Available: $ref->{bavail}\n";
+print "Used: $ref->{used}\n";
+print "Percent Full: $ref->{per}\n";
+if(exists($ref->{files})) {
+ print "Total Inodes: $ref->{files}\n";
+ print "Free Inodes: $ref->{ffree}\n";
+ print "Inode Percent Full: $ref->{fper}\n";
+}
+
+
+print "\nResults for \"test.pl\" filehandle in 1K blocks:\n";
+print "Total: $fh_ref->{blocks}\n";
+print "Free: $fh_ref->{bfree}\n";
+print "Available: $fh_ref->{bavail}\n";
+print "Used: $fh_ref->{used}\n";
+print "Percent Full: $fh_ref->{per}\n";
+if(exists($fh_ref->{files})) {
+ print "Total Inodes: $fh_ref->{files}\n";
+ print "Free Inodes: $fh_ref->{ffree}\n";
+ print "Inode Percent Full: $fh_ref->{fper}\n\n";
+}
+
+
+print"All tests successful!\n\n";
+
Added: packages/libfilesys-df-perl/branches/upstream/current/typemap
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libfilesys-df-perl/branches/upstream/current/typemap?rev=4384&op=file
==============================================================================
--- packages/libfilesys-df-perl/branches/upstream/current/typemap (added)
+++ packages/libfilesys-df-perl/branches/upstream/current/typemap Fri Nov 24 21:40:59 2006
@@ -1,0 +1,3 @@
+TYPEMAP
+Statvfs T_PTRREF
+Statfs T_PTRREF
More information about the Pkg-perl-cvs-commits
mailing list