stat02.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:56 2010 from stat02.pl 2009/10/13 5.5 KB.

#!/Perl
# AIM: To check out the power of 'stat' - geoff - 2006.07.11
# 13/10/2009 - revisited, and try to fix the errors now...
# This consisted mainly of making is an ($mode & S_item),
# CONTRARY to the FUNCTIONS list in http://perldoc.perl.org/functions/stat.html
# and from : http://kobesearch.cpan.org/htdocs/perl/Fcntl.pm.html
# Amybe this has CHANGED since 2006, when I am sure this was working!!!
# ##############################################################################
# 'stat' returns 13 fields ...
# ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
#       $atime,$mtime,$ctime,$blksize,$blocks)
#           = stat($filename);
#  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 in seconds since the epoch (*)
# 11 blksize  preferred block size for file system I/O
# 12 blocks   actual number of blocks allocated
# * Not all a valid on all file systems
# 13/10/2009 - But in WIN32, it also seems blksize and blocks are NOT valid, filled in???
# (The epoch was at 00:00 January 1, 1970 GMT.)
# add 'use' statement -
use File::stat;
# and if analysis of mode required, then
use Fcntl ':mode';
# S_IRWXU S_IRUSR S_IWUSR S_IXUSR
# S_IRWXG S_IRGRP S_IWGRP S_IXGRP
# S_IRWXO S_IROTH S_IWOTH S_IXOTH
# File types.  Not necessarily all are available on your system.
# S_IFREG S_IFDIR S_IFLNK S_IFBLK S_IFCHR S_IFIFO S_IFSOCK S_IFWHT S_ENFMT
# drwxr-xr-x    3 geoffmc  geoffmc      4096 Jun 29 11:36 public_ftp/
# -rw-r--r--    1 geoffmc  geoffmc      1987 Jun 20  2004 xml.htm
require "logfile.pl" or die "Missing logfile.pl ...\n"; # my simple log file
my $in_dir = '.';
if (@ARGV) {
   $in_dir = pop @ARGV;
}
my @files = ();
my $file = '';
my @mths = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my $minszlen = 8;
my @mdarr = ();
# log file stuff
my ($LF);
my $outfile = 'temp'.$0.'.txt';
open_log($outfile);
###prt( "$0 ... Hello, World ...\n" );
prt ("Processing directory $in_dir ...\n");
# features
my $add_file_list = 0;  # ad another filelist at end
opendir( DIR, $in_dir) || mydie( "ERROR: Can NOT open $in_dir ... aborting ...\n" );
@files = readdir(DIR);
closedir DIR;
prt ("Found ".scalar @files." items in the directory ...\n");
my $cnt = 0;
foreach $file (@files) {
   $cnt++;
   my $ff = $in_dir.'/'.$file;
   my $sb = stat($ff) or mydie( "ERROR: Unable to 'stat' file [$ff]?\n" );
   my $ms = stat_mode_stg($sb->mode); # get UNIX like mode string, like 'drwxrwx'
   my $tm = scalar localtime $sb->mtime;
   my @arr = split( / /, $tm ); # time of form 'Sat Mar 12 03:11:55 2005'
   my $ac = scalar @arr;
   my $doff = 2;
   my $yoff = 4;
   if ($ac == 5) {
      $doff = 2;
      $yoff = 4;
   } elsif ($ac == 6) {
      $doff = 3;
      $yoff = 5;
   } else {
      mydie( "ERROR: Time ($tm) did NOT split correctly!\n" );
   }
   my $mn = mth_to_num( $arr[1] );
   if ($mn < 10) {
      $mn = '0'.$mn;
   }
   my $dn = $arr[$doff];
   if ($dn < 10) {
      $dn = '0'.$dn;
   }
   my $dtt = $arr[$yoff].'/'.$mn.'/'.$dn; # translated to 2005/03/12
   my $size = $sb->size;
   while (length($size) < $minszlen) {
      $size = ' '.$size;
   }
   my $mode = $sb->mode & 07777;
   my $blks = $sb->blocks;
   # prt( "$ac $tm $dtt $mode $ms $size $file\n" );
   prt( "$ms $size $tm $file\n" );
   push(@mdarr, [$ac, $tm, $dtt, $mode, $ms, $size, $file]);
}
my $mdim = 7;
my $mdcnt = scalar @mdarr;
prt( "Got count $cnt, and mdarr $mdcnt ...\n" );
if ($add_file_list) {
   for (my $i = 0; $i < $mdcnt; $i++) {
      prt( "File ".$mdarr[$i][6]." of size ".$mdarr[$i][5]."\n" );
   }
}
close_log($outfile,1);
exit(0);
##################################
### only subs below
## month to number
sub mth_to_num {
   my ($mth) = shift;
   my $cnt = 0;
   ###prt( "Chk [$mth] " );
   foreach my $m (@mths) {
      $cnt++;
      if ($m eq $mth) {
         ###prt( "Is $m - return $cnt\n" );
         return $cnt;
      }
   }
   prt( "WARNING: Returning 0!!!\n" );
   return '??';
}
# convert stat mode value to unix typical string
# types
# S_IFREG S_IFDIR S_IFLNK (?? S_IFBLK S_IFCHR S_IFIFO S_IFSOCK S_IFWHT S_ENFMT)
# permissions
# S_IRUSR S_IWUSR S_IXUSR (S_IRWXU)
# S_IRGRP S_IWGRP S_IXGRP (S_IRWXG)
# S_IROTH S_IWOTH S_IXOTH (S_IRWXO)
sub stat_mode_stg {
   my ($mode) = shift;
   my $stg = '';
   if ($mode & S_IFREG) {
      $stg .= '-';
   } elsif ( $mode & S_IFDIR ) { # elsif (S_IFDIR($mode)) {
      $stg .= 'd';
   }  elsif ( $mode & S_IFLNK ) { # elsif (S_IFLNK($mode)) {
      $stg .= 'l';
   } else {
      $stg .= '?';
   }
   if (S_IRUSR & $mode) {
      $stg .= 'r';
   } else {
      $stg .= '-';
   }
   if (S_IWUSR & $mode) {
      $stg .= 'w';
   } else {
      $stg .= '-';
   }
   if (S_IXUSR & $mode) {
      $stg .= 'x';
   } else {
      $stg .= '-';
   }
   if (S_IRGRP & $mode) {
      $stg .= 'r';
   } else {
      $stg .= '-';
   }
   if (S_IWGRP & $mode) {
      $stg .= 'w';
   } else {
      $stg .= '-';
   }
   if (S_IXGRP & $mode) {
      $stg .= 'x';
   } else {
      $stg .= '-';
   }
   if (S_IROTH & $mode) {
      $stg .= 'r';
   } else {
      $stg .= '-';
   }
   if (S_IWOTH & $mode) {
      $stg .= 'w';
   } else {
      $stg .= '-';
   }
   if (S_IXOTH & $mode) {
      $stg .= 'x';
   } else {
      $stg .= '-';
   }
   return $stg;
}
# eof

index -|- top

checked by tidy  Valid HTML 4.01 Transitional