[Summary view] [Print] [Text view]

   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