BSD-stat

 view release on metacpan or  search on metacpan

stat.pm  view on Meta::CPAN

# In favor of speed, especially when $st_ series variables are exported,
# Exporter is no longer used, though EXPORT variables are still used
# to make the code easier to read. see how $USE_OUR_ST is used

use vars qw(@ISA @EXPORT_OK @EXPORT $USE_OUR_ST);

@ISA = qw(DynaLoader);

@EXPORT_OK = 
    qw( 
	$st_dev $st_ino $st_mode $st_nlink $st_uid $st_gid $st_rdev $st_size 
	$st_atime $st_mtime $st_ctime $st_blksize $st_blocks
	$st_atimensec $st_mtimensec $st_ctimensec $st_flags $st_gen
	);

@EXPORT = 
    qw(
       stat
       lstat
       chflags
       utimes

stat.pm  view on Meta::CPAN

# Looks like as of Perl 5.18.1 the stat cache must be filled
# before BSD::stat makes use of it
CORE::lstat(__FILE__);

my $field = {
    dev       =>  0,
    ino       =>  1,
    mode      =>  2,
    nlink     =>  3,
    uid       =>  4,
    gid       =>  5,
    rdev      =>  6,
    size      =>  7,
    atime     =>  8,
    mtime     =>  9,
    ctime     => 10,
    blksize   => 11,
    blocks    => 12,
    atimensec => 13,
    mtimensec => 14,
    ctimensec => 15,

stat.pm  view on Meta::CPAN

sub mtimespec { $_[0]->[9] + $_[0]->[14] / 1e9 }
sub ctimespec { $_[0]->[10] + $_[0]->[15] / 1e9 }

# "my" subroutine which is invisible from other package

my $set_our_st = sub 
{
    no strict 'vars';
    no warnings 'uninitialized';
    ( 
      $st_dev, $st_ino, $st_mode, $st_nlink, $st_uid, $st_gid, $st_rdev, 
      $st_size, $st_atime, $st_mtime, $st_ctime, $st_blksize, $st_blocks,
      $st_atimensec, $st_mtimensec, $st_ctimensec, $st_flags, $st_gen,
      ) = @{$_[0]};
};

sub DESTROY{
    $DEBUG or return;
    carp "Destroying ", __PACKAGE__;
    $DEBUG >= 2 or return;
    eval qq{ require Devel::Peek; } and Devel::Peek::Dump $_[0];

stat.pm  view on Meta::CPAN

=head1 NAME

BSD::stat - stat() with BSD 4.4 extentions

=head1 SYNOPSIS

  use BSD::stat;

  # just like CORE::stat

  ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
   $atime,$mtime,$ctime,$blksize,$blocks,
   $atimensec,$mtimensec,$ctimensec,$flags,$gen)
    = stat($filename); 

  # BSD::stat now accepts filehandles, too

  open F, "foo";
  my @stat = stat(*F);

  # omit an argument and it will use $_;

stat.pm  view on Meta::CPAN

=head2 BSD::stat vs. CORE::stat

When called as array context, C<lstat()> and C<stat()> return an array
like CORE::stat. Here are the meaning of the fields:

  0 dev        device number of filesystem
  1 ino        inode number
  2 mode       file mode  (type and permissions)
  3 nlink      number of (hard) links to the file
  4 uid        numeric user ID of file's owner
  5 gid        numeric group ID of file's owner
  6 rdev       the device identifier (special files only)
  7 size       total size of file, in bytes
  8 atime      last access time in seconds since the epoch
  9 mtime      last modify time in seconds since the epoch
 10 ctime      inode change time (NOT creation time!) in seconds si
 11 blksize    preferred block size for file system I/O
 12 blocks     actual number of blocks allocated
 13 atimensec  nsec of last access
 14 mtimensec  nsec of last data modification
 15 ctimensec  nsec of last file status change

stat.xs  view on Meta::CPAN

    SV* sva[NUMSTATMEM];
    int i;

    /* same as CORE::stat */

    sva[0]  = sv_2mortal(newSVuv(PL_statcache.st_dev     = st->st_dev));
    sva[1]  = sv_2mortal(newSVuv(PL_statcache.st_ino     = st->st_ino));
    sva[2]  = sv_2mortal(newSVuv(PL_statcache.st_mode    = st->st_mode));
    sva[3]  = sv_2mortal(newSVuv(PL_statcache.st_nlink   = st->st_nlink));
    sva[4]  = sv_2mortal(newSVuv(PL_statcache.st_uid     = st->st_uid));
    sva[5]  = sv_2mortal(newSVuv(PL_statcache.st_gid     = st->st_gid));
    sva[6]  = sv_2mortal(newSVuv(PL_statcache.st_rdev    = st->st_rdev));
    sva[7]  = sv_2mortal(newSVuv(PL_statcache.st_size    = st->st_size));
    sva[8]  = sv_2mortal(newSViv(PL_statcache.st_atime   = st->st_atime));
    sva[9]  = sv_2mortal(newSViv(PL_statcache.st_mtime   = st->st_mtime));
    sva[10] = sv_2mortal(newSViv(PL_statcache.st_ctime   = st->st_ctime));
    sva[11] = sv_2mortal(newSVuv(PL_statcache.st_blksize = st->st_blksize));
    sva[12] = sv_2mortal(newSVuv(PL_statcache.st_blocks  = st->st_blocks));


    /* BSD-specific */

t/fields.t  view on Meta::CPAN

# change 'tests => 1' to 'tests => last_test_to_print';

use Test;
use strict;
my $Debug = 0;
BEGIN { plan tests => 18 };

use BSD::stat qw(:FIELDS);
my $bsdstat = lstat($0);

for my $s (qw(dev ino mode nlink uid gid rdev size
	      atime mtime ctime blksize blocks
	      atimensec mtimensec  ctimensec flags gen))
{
    no strict; 
    $Debug and warn "\$st_$s = ", ${"st_$s"};
    ok($bsdstat->$s() == ${"st_$s"});
}

$Debug and print $bsdstat->dev, "\n";

t/object.t  view on Meta::CPAN

my $Debug = 0;
BEGIN { plan tests => 13 };

use BSD::stat;

use File::stat ();
my $bsdstat = lstat($0);
my $perlstat = File::stat::lstat($0);

no strict 'refs';
for my $s (qw(dev ino mode nlink uid gid rdev size
	      atime mtime ctime blksize blocks))
{
    $perlstat->$s() == $bsdstat->$s() ? ok(1) : ok(0);
}
use strict;
$Debug and print $bsdstat->dev, "\n";