home *** CD-ROM | disk | FTP | other *** search
/ Netrunner 2004 October / NETRUNNER0410.ISO / regular / ActivePerl-5.8.4.810-MSWin32-x86.msi / _982c5df4e0190bba3ce10215af197ffb < prev    next >
Text File  |  2004-06-01  |  4KB  |  140 lines
  1. package File::stat;
  2. use 5.006;
  3.  
  4. use strict;
  5. use warnings;
  6.  
  7. our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS);
  8.  
  9. our $VERSION = '1.00';
  10.  
  11. BEGIN { 
  12.     use Exporter   ();
  13.     @EXPORT      = qw(stat lstat);
  14.     @EXPORT_OK   = qw( $st_dev       $st_ino    $st_mode 
  15.                $st_nlink   $st_uid    $st_gid 
  16.                $st_rdev    $st_size 
  17.                $st_atime   $st_mtime  $st_ctime 
  18.                $st_blksize $st_blocks
  19.             );
  20.     %EXPORT_TAGS = ( FIELDS => [ @EXPORT_OK, @EXPORT ] );
  21. }
  22. use vars @EXPORT_OK;
  23.  
  24. # Class::Struct forbids use of @ISA
  25. sub import { goto &Exporter::import }
  26.  
  27. use Class::Struct qw(struct);
  28. struct 'File::stat' => [
  29.      map { $_ => '$' } qw{
  30.      dev ino mode nlink uid gid rdev size
  31.      atime mtime ctime blksize blocks
  32.      }
  33. ];
  34.  
  35. sub populate (@) {
  36.     return unless @_;
  37.     my $stob = new();
  38.     @$stob = (
  39.     $st_dev, $st_ino, $st_mode, $st_nlink, $st_uid, $st_gid, $st_rdev,
  40.         $st_size, $st_atime, $st_mtime, $st_ctime, $st_blksize, $st_blocks ) 
  41.         = @_;
  42.     return $stob;
  43. } 
  44.  
  45. sub lstat ($)  { populate(CORE::lstat(shift)) }
  46.  
  47. sub stat ($) {
  48.     my $arg = shift;
  49.     my $st = populate(CORE::stat $arg);
  50.     return $st if $st;
  51.     my $fh;
  52.     {
  53.         local $!;
  54.         no strict 'refs';
  55.         require Symbol;
  56.         $fh = \*{ Symbol::qualify( $arg, caller() )};
  57.         return unless defined fileno $fh;
  58.     }
  59.     return populate(CORE::stat $fh);
  60. }
  61.  
  62. 1;
  63. __END__
  64.  
  65. =head1 NAME
  66.  
  67. File::stat - by-name interface to Perl's built-in stat() functions
  68.  
  69. =head1 SYNOPSIS
  70.  
  71.  use File::stat;
  72.  $st = stat($file) or die "No $file: $!";
  73.  if ( ($st->mode & 0111) && $st->nlink > 1) ) {
  74.      print "$file is executable with lotsa links\n";
  75.  } 
  76.  
  77.  use File::stat qw(:FIELDS);
  78.  stat($file) or die "No $file: $!";
  79.  if ( ($st_mode & 0111) && $st_nlink > 1) ) {
  80.      print "$file is executable with lotsa links\n";
  81.  } 
  82.  
  83. =head1 DESCRIPTION
  84.  
  85. This module's default exports override the core stat() 
  86. and lstat() functions, replacing them with versions that return 
  87. "File::stat" objects.  This object has methods that
  88. return the similarly named structure field name from the
  89. stat(2) function; namely,
  90. dev,
  91. ino,
  92. mode,
  93. nlink,
  94. uid,
  95. gid,
  96. rdev,
  97. size,
  98. atime,
  99. mtime,
  100. ctime,
  101. blksize,
  102. and
  103. blocks.  
  104.  
  105. You may also import all the structure fields directly into your namespace
  106. as regular variables using the :FIELDS import tag.  (Note that this still
  107. overrides your stat() and lstat() functions.)  Access these fields as
  108. variables named with a preceding C<st_> in front their method names.
  109. Thus, C<$stat_obj-E<gt>dev()> corresponds to $st_dev if you import
  110. the fields.
  111.  
  112. To access this functionality without the core overrides,
  113. pass the C<use> an empty import list, and then access
  114. function functions with their full qualified names.
  115. On the other hand, the built-ins are still available
  116. via the C<CORE::> pseudo-package.
  117.  
  118. =head1 BUGS
  119.  
  120. As of Perl 5.8.0 after using this module you cannot use the implicit
  121. C<$_> or the special filehandle C<_> with stat() or lstat(), trying
  122. to do so leads into strange errors.  The workaround is for C<$_> to
  123. be explicit
  124.  
  125.     my $stat_obj = stat $_;
  126.  
  127. and for C<_> to explicitly populate the object using the unexported
  128. and undocumented populate() function with CORE::stat():
  129.  
  130.     my $stat_obj = File::stat::populate(CORE::stat(_));
  131.  
  132. =head1 NOTE
  133.  
  134. While this class is currently implemented using the Class::Struct
  135. module to build a struct-like class, you shouldn't rely upon this.
  136.  
  137. =head1 AUTHOR
  138.  
  139. Tom Christiansen
  140.