1package Filesys::Df;
2
3use strict;
4use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
5use Carp;
6require Exporter;
7require DynaLoader;
8require 5.006;
9
10@ISA = qw(Exporter DynaLoader);
11@EXPORT = qw(df);
12$VERSION = '0.92';
13bootstrap Filesys::Df $VERSION;
14
15sub df {
16my ($dir, $block_size) = @_;
17my ($used, $fused);
18my ($per, $fper);
19my ($user_blocks, $user_used);
20my ($user_files, $user_fused);
21my %fs = ();
22
23
24	(defined($dir)) ||
25		(croak "Usage: df\(\$dir\) or df\(\$dir\, \$block_size)");
26
27	#### If no requested block size then we will return the values in bytes
28	($block_size) ||
29		($block_size = 1024);
30
31	my ($frsize, $blocks, $bfree, $bavail, $files, $ffree, $favail);
32
33	#### If open filehandle call fstatvfs or fstatfs
34	if(defined(fileno($dir))) {
35		($frsize, $blocks, $bfree, $bavail, $files, $ffree, $favail) = _df_fh(fileno($dir));
36	}
37
38	else {
39		($frsize, $blocks, $bfree, $bavail, $files, $ffree, $favail) = _df($dir);
40	}
41
42
43	#### Some system or XS failure, something like /proc, or bad $dir
44	if($frsize == 0 || $blocks == 0) {
45		return();
46	}
47
48	#### Change to requested or default block size
49	if($block_size > $frsize) {
50		my $result = $block_size / $frsize;
51		$blocks /= $result;
52		($bfree != 0) &&
53			($bfree /= $result);
54		#### Keep bavail -
55		($bavail < 0) &&
56			($result *= -1);
57
58		($bavail != 0) &&
59			($bavail /= $result);
60	}
61
62	elsif($block_size < $frsize) {
63		my $result = $frsize / $block_size;
64		$blocks *= $result;
65		$bfree *= $result;
66		#### Keep bavail -
67		($bavail < 0) &&
68			($result *= -1);
69		$bavail *= $result;
70	}
71
72	$used = $blocks - $bfree;
73
74	#### There is a reserved amount for the su
75	#### or there are disk quotas
76        if($bfree > $bavail) {
77                $user_blocks = $blocks - ($bfree - $bavail);
78                $user_used = $user_blocks - $bavail;
79                if($bavail < 0) {
80                        #### over 100%
81                        my $tmp_bavail = $bavail;
82                        $per = ($tmp_bavail *= -1) / $user_blocks;
83                }
84
85                else {
86			if($user_used == 0) {
87				$per = 0;
88			}
89
90			else {
91                        	$per = $user_used / $user_blocks;
92			}
93                }
94        }
95
96        #### No reserved amount or quotas
97        else {
98                if($used == 0)  {
99                        $per = 0;
100                }
101
102                else {
103                        $per = $used / $blocks;
104			$user_blocks = $blocks;
105			$user_used = $used;
106                }
107        }
108
109	#### round
110        $per *= 100;
111        $per += .5;
112
113        #### over 100%
114        ($bavail < 0) &&
115                ($per += 100);
116
117        $fs{per}         = int($per);
118	$fs{blocks}      = $blocks;
119	$fs{bfree}       = $bfree;
120	$fs{bavail}      = $bavail;
121	$fs{used}        = $used;
122	#### These are undocumented but kept for backwards compatibility
123	$fs{user_blocks} = $user_blocks;
124	$fs{user_bavail} = $bavail;
125	$fs{user_used}   = $user_used;
126	$fs{su_bavail}   = $bfree;
127	$fs{su_blocks}   = $blocks;
128
129
130
131	#### Handle inodes if system supports them
132	if(defined $files && $files > 0) {
133		$fused = $files - $ffree;
134                #### There is a reserved amount
135                if($ffree > $favail) {
136                        $user_files = $files - ($ffree - $favail);
137                        $user_fused = $user_files - $favail;
138                        if($favail < 0)  {
139                                #### over 100%
140                                my $tmp_favail = $favail;
141                                $fper = ($tmp_favail *= -1) / $user_files;
142                        }
143
144                        else {
145				if($user_fused == 0) {
146					$fper = 0;
147				}
148
149				else {
150                                	$fper = $user_fused / $user_files;
151				}
152                        }
153                }
154
155                #### su and user amount are the same
156                else {
157                        if($fused == 0) {
158                                $fper = 0;
159                        }
160
161                        else {
162                                $fper = $fused / $files;
163                        }
164
165                        $user_files = $files;
166                        $user_fused = $fused;
167                }
168
169                #### round
170                $fper *= 100;
171                $fper += .5;
172
173                #### over 100%
174                ($favail < 0) &&
175                        ($fper += 100);
176
177		$fs{fper}        = int($fper);
178                $fs{files}       = $files;
179                $fs{ffree}       = $ffree;
180                $fs{favail}      = $favail;
181                $fs{fused}       = $fused;
182		#### These are undocumented but kept for backwards compatibility
183                $fs{user_fused}  = $user_fused;
184                $fs{user_files}  = $user_files;
185                $fs{su_favail}   = $ffree;
186                $fs{su_files}    = $files;
187                $fs{user_favail} = $favail;
188        }
189
190        #### No valid inode info. Probably NFS.
191	#### Instead of undefing, just have the user call exists().
192        #else {
193        #        $fs{fper}        = undef;
194        #        $fs{files}       = undef;
195        #        $fs{ffree}       = undef;
196        #        $fs{favail}      = undef;
197        #        $fs{fused}       = undef;
198        #        $fs{user_fused}  = undef;
199        #        $fs{user_files}  = undef;
200        #}
201
202
203	return(\%fs);
204}
205
2061;
207__END__
208
209=head1 NAME
210
211Filesys::Df - Perl extension for filesystem disk space information.
212
213=head1 SYNOPSIS
214
215
216  use Filesys::Df;
217
218  #### Get information by passing a scalar directory/filename value
219  my $ref = df("/tmp");  # Default output is 1K blocks
220  if(defined($ref)) {
221     print "Total 1k blocks: $ref->{blocks}\n";
222     print "Total 1k blocks free: $ref->{bfree}\n";
223     print "Total 1k blocks avail to me: $ref->{bavail}\n";
224     print "Total 1k blocks used: $ref->{used}\n";
225     print "Percent full: $ref->{per}\n";
226
227     if(exists($ref->{files})) {
228        print "Total inodes: $ref->{files}\n";
229        print "Total inodes free: $ref->{ffree}\n";
230	print "Inode percent full: $ref->{fper}\n";
231     }
232  }
233
234  #### Get information by passing a filehandle
235  open(FILE, "some_file");  # Get information for filesystem at "some_file"
236  my $ref = df(\*FILE);
237  #### or
238  my $ref = df(*FILE);
239  #### or
240  my $fhref = \*FILE;
241  my $ref = df($fhref);
242
243  #### Get information in other than 1k blocks
244  my $ref = df("/tmp", 8192);  # output is 8K blocks
245  my $ref = df("/tmp", 1);     # output is bytes
246
247=head1 DESCRIPTION
248
249This module provides a way to obtain filesystem disk space
250information. This is a Unix only distribution. If you want to
251gather this information for Unix and Windows, use C<Filesys::DfPortable>.
252The only major benefit of using C<Filesys::Df> over C<Filesys::DfPortable>,
253is that C<Filesys::Df> supports the use of open filehandles as arguments.
254
255The module should work with all flavors of Unix that implement the
256C<statvfs()> and C<fstatvfs()> calls, or the C<statfs()> and C<fstatfs()> calls.
257This would include Linux, *BSD, HP-UX, AIX, Solaris, Mac OS X, Irix,
258Cygwin, etc ...
259
260C<df()> requires a argument that represents the filesystem you want to
261query. The argument can be either a scalar directory/file name or a
262open filehandle. There is also an optional block size argument so
263you can tailor the size of the values returned. The default block
264size is 1024. This will cause the function to return the values in 1k
265blocks. If you want bytes, set the block size to 1.
266
267C<df()> returns a reference to a hash. The keys available in
268the hash are as follows:
269
270C<{blocks}> = Total blocks on the filesystem.
271
272C<{bfree}> = Total blocks free on the filesystem.
273
274C<{bavail}> = Total blocks available to the user executing the Perl
275application. This can be different than C<{bfree}> if you have per-user
276quotas on the filesystem, or if the super user has a reserved amount.
277C<{bavail}> can also be a negative value because of this. For instance
278if there is more space being used then you have available to you.
279
280C<{used}> = Total blocks used on the filesystem.
281
282C<{per}> = Percent of disk space used. This is based on the disk space
283available to the user executing the application. In other words, if
284the filesystem has 10% of its space reserved for the superuser, then
285the percent used can go up to 110%.
286
287You can obtain inode information through the module as well, but you
288must call C<exists()> on the C<{files}> key first, to make sure the information
289is available. Some filesystems may not return inode information, for example
290some NFS filesystems.
291
292Here are the available inode keys:
293
294C<{files}> = Total inodes on the filesystem.
295
296C<{ffree}> = Total inodes free on the filesystem.
297
298C<{favail}> = Total inodes available to the user executing the application.
299See the rules for the C<{bavail}> key.
300
301C<{fused}> = Total inodes used on the filesystem.
302
303C<{fper}> = Percent of inodes used on the filesystem. See rules for the C<{per}>
304key.
305
306There are some undocumented keys that are defined to maintain backwards
307compatibilty: C<{su_blocks}>, C<{user_blocks}>, etc ...
308
309If the C<df()> call fails for any reason, it will return
310undef. This will probably happen if you do anything crazy like try
311to get information for /proc, or if you pass an invalid filesystem name,
312or if there is an internal error. C<df()> will C<croak()> if you pass
313it a undefined value.
314
315Requirements:
316Your system must contain C<statvfs()> and C<fstatvfs()>, or C<statfs()> and C<fstatfs()>
317You must be running Perl 5.6 or higher.
318
319=head1 AUTHOR
320
321Ian Guthrie
322IGuthrie@aol.com
323
324Copyright (c) 2006 Ian Guthrie. All rights reserved.
325               This program is free software; you can redistribute it and/or
326               modify it under the same terms as Perl itself.
327
328=head1 SEE ALSO
329
330statvfs(2), fstatvfs(2), statfs(2), fstatfs(2), df(1), Filesys::DfPortable
331
332perl(1).
333
334=cut
335