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