dirg.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:30 2010 from dirg.pl 2007/01/27 11.7 KB.

#!/usr/bin/perl
use strict;
use Cwd;
use File::stat;
my $start_time = time();
my $program = 'dirg.pl';
my @in_files; # list of input folders
my $verbose = 0;
my $verb2 = 0;
my $cwdir = getcwd();
my $block = 512;
my $dbg = 0;
my $shwtm = 1;
my $fullname = 0;
my $actdir;
my @rows;
my $out_name = 'tempdgpl.htm';
my $in_file;
my $tot = 0;
my $tot_dirs = 0;
my $tot_files = 0;
my $g_tot_dirs = 0;
my $g_tot_files = 0;
my $msg;
my $hdrs = "";
my $tab_width = 600;
my $row_count;
my $excl_dir = "Temporary Internet Files"; # should these be EXCLUDED???
my @undefd = (); # seems we need to 'skip' some, quietly
my @colors = qw(red blue green yellow orange purple violet);
for my $name (@colors) {
   no strict 'refs';       # allow symbol table manipulation
    *$name = *{uc $name} = sub { "<font color='$name'>@_</font>" };
}
parse_arguments(@ARGV);
print "$program: Started on " . localtime($start_time) . " in $cwdir ...\n" if $shwtm;
die "$program: no input files found or specified\n" if ! @in_files;
# show count in the array ...
#print ("Processing " . $#in_files + 1 . " directories ...\n") if $verbose;
print ("Processing " . scalar @in_files . " directories ...\n") if $verbose;
foreach $in_file (@in_files) {
   $actdir = retfulldir($in_file);
   if (length($hdrs)) {
      $hdrs .= "|";
   }
   $hdrs .= $actdir;
   print ("Processing [$in_file], as [$actdir] ... moment ...\n") if ($in_file ne $actdir);
   $tot += do_user_dir($actdir);
}
print "Totals: $tot bytes, in $g_tot_dirs folders, $g_tot_files files ...\n";
#print "$program: Got ". red($tot) . " bytes, in $tot_dirs folders, $tot_files files ...\n";
die "No table rows to write to $out_name ...\n" if ! @rows;
# set header line
$msg = ("Totals|$tot|$g_tot_dirs|$g_tot_files");
push(@rows,$msg);
$row_count = scalar @rows;
# write HTML file
print "Creating $out_name, with table of $row_count rows ...\n" if $verbose;
open(DSP, ">$out_name")
   || die "Can not create $out_name: $!\n";
#html_head(\*DSP, $hdrs);
html_head2(\*DSP, $hdrs);
print DSP "<p>\n";
#print DSP "<TABLE>\n";
#print DSP "<TABLE class=sbfixed border=\"1\" width=\"" . $tab_width . "\">\n";
print DSP "<table class=sbfixed border=\"1\">\n";
print DSP "<tr><td><b>Folders</b></td><td><b>Bytes</b></td><td><b>Dirs</b></td><td><b>Files</b></td></tr>\n";
my $rcnt = 0;
my $ccnt = 0;
foreach $msg (@rows) {
   $rcnt++;
   # print DSP "$msg<BR>\n";
   print DSP "<tr>\n";
   $ccnt = 0;
   my (@mcols) = split( /\|/, $msg);
   foreach my $col (@mcols) {
      if($rcnt == $row_count) { # ***LAST ROW***
         if ($ccnt) { # is column 1++
            if ($ccnt == 1) {
               $msg = addcolmr( addbold( b2ks1($col) ) );
            } else {
               $msg = addcolmr( addbold( get_nn($col) ) );
            }
         } else { # first column
            #print DSP "<TD><b>$col</b></TD>\n"
            $msg = addcolm( addbold($col) );
         }
      } else {
         if ($ccnt) {
            if ($ccnt == 1 ) {
               $msg = addcolmr( b2ks1($col) );
            } else {
               $msg = addcolmr( get_nn($col) );
            }
         } else {
            $msg = addcolm( $col );
         }
      }
      print DSP "$msg\n"; # shove it out the the HTML file
      $ccnt++;
   }
   print DSP "</tr>\n";
}
print DSP "</table>\n";
print DSP "</p>\n";
if (scalar @undefd > 0) {
   print DSP "<p>Skipped following ...<br>\n";
   foreach $msg (@rows) {
      print DSP "$msg<br>\n";
   }
   print DSP "</p>\n";
} else {
   print DSP "<p>NONE skipped ...\n";
}
html_tail(\*DSP);
close(DSP);
print "$program: Ended on " . localtime(time()) . ".\n" if $shwtm;
system $out_name; # start HTML file
print "Results written to $out_name ...\n";
##################################
# end of program
#################################
### subs
#################################
sub do_user_dir {
   my $dir = shift;
   print "Processing folder [$dir] ...\n" if $verbose;
   opendir(THEDIR, $dir) || die("Couldn't open [$dir] directory\n");
   my @files = readdir(THEDIR);
   closedir(THEDIR);
   my $tsz = 0;
   print "Found " . scalar(@files) . " files and folders ...\n" if $verbose;
   my @dir_list;
   foreach my $dfile (@files) {
      my $df = $dir . '/' . $dfile; # get full name
      my $sb = stat($df);
      if ( -d $df ) { # is directory?
         # if ($dfile eq '.' || $dfile eq '..') or
         if ($dfile =~ '^\.$' || $dfile =~ '^\.\.$') {
            # do nothing with DOT and DOUBLE DOT
         } else {
           push(@dir_list, $df); # save DIRECTORY
           print "$dfile <DIR> [$df]\n" if $verb2;
           if ($dbg) {
                 printf "Folder is %s, size is %s, perm %04o, mtime %s\n",
               $dfile, $sb->size, $sb->mode & 07777,
               scalar localtime $sb->mtime;
           }
           $tot_dirs++; # tsz += $block;
         }
      } else {
         if (defined $sb) {
           print "$dfile full [$df]\n" if $verb2;
           if ($dbg) {
            printf "File is %s, size is %s, perm %04o, mtime %s\n",
               $dfile, $sb->size, $sb->mode & 07777,
               scalar localtime $sb->mtime;
           }
           $tot_files++;
           $tsz += $sb->size;
         } else {
            push(@undefd,$df);
         }
      }
   }
   if ($fullname) {
      $msg = ("$dir is $tsz bytes ... done " . scalar @files .
         " files ($tot_files) and folders ($tot_dirs)..." );
   } else {
      $msg = ( subactdir($dir) . " is $tsz bytes ... done " . scalar @files .
         " files ($tot_files) and folders ($tot_dirs)..." );
   }
   print "$msg\n";
   $g_tot_files = $tot_files;
   $g_tot_dirs = $tot_dirs;
   $msg = "$actdir|$tsz|$g_tot_dirs|$g_tot_files";
   push(@rows,$msg);
   # have DONE root, now process each folder
   foreach $dir (@dir_list) {
      $tot_files = 0;
      $tot_dirs = 0;
      $tsz += do_sub_dir($dir,1);
      $g_tot_files += $tot_files;
      $g_tot_dirs += $tot_dirs;
   }
   return $tsz;
}
sub do_sub_dir {
    my ($dir,$level) = @_;
   if ($level == 1) {
      print ("Processing sub-folder [$dir] ... level $level\n") if $verb2;
   }
   opendir(THEDIR, $dir) || die("Couldn't open [$dir] directory\n");
   my @files = readdir(THEDIR);
   closedir(THEDIR);
   my $tsz = 0;
   my $hdr = "";
   for (my $i = 0; $i < $level ; $i++ ) {
      $hdr .= "    ";
   }
   print ($hdr . "Found " . scalar(@files) . " files and folders ... (l=$level)\n") if $verb2;
   foreach my $dfile (@files) {
      my $df = $dir . '/' . $dfile; # get full name
      my $sb = stat($df);
      if ( -d $df ) {
         # if ($dfile eq '.' || $dfile eq '..') or
         if ($dfile =~ '^\.$' || $dfile =~ '^\.\.$') {
            # do nothing with DOT and DOUBLE DOT
         } else {
           print ($hdr . "$dfile <DIR> [$df]\n") if $verb2;
           if ($dbg) {
                 printf "Folder is %s, size is %s, perm %04o, mtime %s\n",
               $dfile, $sb->size, $sb->mode & 07777,
               scalar localtime $sb->mtime;
           }
           $tsz += do_sub_dir($df,($level+1));
         }
         $tot_dirs++; # count folders, and recurse into, except '.' & '..' ;=))
      } else {
        print ($hdr . "$dfile full [$df]\n" ) if $verb2;
        if (defined $sb) {
           if ($dbg) {
            printf "File is %s, size is %s, perm %04o, mtime %s\n",
               $dfile, $sb->size, $sb->mode & 07777,
               scalar localtime $sb->mtime;
           }
           $tot_files++;
           $tsz += $sb->size;
        } else {
           push (@undefd, $df);
        }
      }
   }
   if ($level == 1) {
      if ($fullname) {
         $msg = ("$dir is $tsz bytes ... done " . scalar @files .
            " files ($tot_files) and folders ($tot_dirs)..." );
      } else {
         $msg = (subactdir($dir) . " is $tsz bytes ... done " . scalar @files .
            " files ($tot_files) and folders ($tot_dirs)..." );
      }
      print "$msg\n" if $verbose;
      # print addbold($msg). "\n" if $verbose;
      $msg = (subactdir($dir) . "|${tsz}|$tot_dirs|$tot_files");
      push(@rows,$msg);
   }
   return $tsz;
}
sub parse_arguments {
 my @av = @_; # take it off the passed stack
 while (@av) {
  if ($av[0] eq '-version') {
   print "Version 0.0.1\n";
  } elsif ($av[0] eq '-verbose' || $av[0] eq '-v') {
     print "Setting verbose ...\n";
     $verbose = 1;
  } elsif ($av[0] eq '-debug') {
     print "Setting debug output ...\n";
     $dbg = 1;
  } elsif ($av[0] eq '-v2') {
     print "Setting verb2 ...\n";
     $verb2 = 1;
  } elsif ($av[0] =~ /^-/) {
   die "$program: unrecognised option? `$av[0]'\nOnly -version, -verbose input_folders ...\n";
  } else {
   print "Storing argument [$av[0]].\n";
   push(@in_files, $av[0]);
  }
  shift @av; # move to next argument to [0]
 }
 push(@in_files, ".") if ! @in_files; # default to current folder
}
sub dirname { # passed a path, './dir1/dir2/file.name' returns './dir1/dir2/
my ($file) = @_;
my ($sub);
($sub = $file) =~ s,/+[^/]+$,,g;
$sub = '.' if $sub eq $file;
return $sub;
}
sub retfulldir {
 my ($d) = @_;
 if ($d =~ '^\.$') {
    $d = $cwdir; # set CURRENT WORK DIRECTORY
 } elsif ( $d =~ '^\.\.$') {
   $d = dirname( $cwdir ); # back up one ...
 }
 return $d;
}
sub subactdir {
   my ($d) = @_;
   my ($nd);
   #my $s = "s,^\$actdir,,";
   #print ("rem $actdir frm $d use $s\n");
   #($nd = $d) =~ s,^C:/GTools/perl,,; # ok
   #($nd = $d) =~ $s; # fails???
   ($nd = $d) =~ s,^$actdir,,;
   if (length($nd) == 0) {
      $nd = $actdir;
   } else {
      $nd =~ s,^/,,;
   }
#   $nd = 'root' if length $nd == 0;
   return $nd;
}
sub addbold {
   return( "<b>@_</b>" );
}
sub addcolm {
   return( "  <td>@_</td>" );
}
sub addcolmr { # string tdr = "  <TD align=\"right\">"MEOS;
   return( "  <td align=\"right\">@_</td>" );
}
sub html_head {
   my ($fh, $hdr) = @_;
   print $fh <<"EOF";
<html>
<head>
<title>$hdr</title>
</head>
<body>
<h1 align="center">$hdr</h1>
EOF
}
sub html_head2 {
   my ($os, $hdr) = @_;
   print $os "<html>\n";
   print $os "<!-- title " . $hdr . " -->\n";
   print $os "<head>\n";
   print $os "<title>" . $hdr . "</title>\n";
   print $os "<style>\n";
   print $os "body.blueform\n";
   print $os "{\n";
   print $os "    BORDER-RIGHT: #4169e1 double;\n";
   print $os "    PADDING-RIGHT: 2px;\n";
   print $os "    BORDER-TOP: #4169e1 double;\n";
   print $os "    PADDING-LEFT: 2px;\n";
   print $os "    PADDING-BOTTOM: 2px;\n";
   print $os "    MARGIN: 3px;\n";
   print $os "    BORDER-LEFT: #4169e1 double;\n";
   print $os "    PADDING-TOP: 2px;\n";
   print $os "    BORDER-BOTTOM: #4169e1 double;\n";
   print $os "    BACKGROUND-COLOR: #add8e6\n";
   print $os "}\n";
   print $os ".sbfixed\n";
   print $os "{\n";
   print $os "    COLOR: #00008b;\n";
   print $os "    FONT-FAMILY: 'Courier New';\n";
   print $os "    BACKGROUND-COLOR: #afeeee\n";
   print $os "}\n";
   print $os "</style>\n";
   print $os "</head>\n";
   print $os "<body class=\"blueform\">\n";
   print $os "\n";
   print $os "<h1 align=\"center\">" . $hdr . "</h1>\n";
}
sub html_tail {
   my ($fh) = @_;
   print $fh <<"EOF";
</body>
</html>
EOF
}
#string dirghtml::b2ks1(double d) // b2ks1(double d)
sub b2ks1 {
   my ($d) = @_;
   my $oss;
   my $kss;
   my $lg = 0;
   my $ks = ($d / 1024); #// get Ks
   my $div = 1;
   if( $ks < 1000 ) {
      $div = 1;
      $oss = "KB";
   } elsif ( $ks < 1000000 ) {
     $div = 1000;
      $oss = "MB";
   } elsif ( $ks < 1000000000 ) {
      $div = 1000000;
      $oss = "GB";
   } else {
      $div = 1000000000;
      $oss = "TB";
   }
   $kss = $ks / $div;
   $kss += 0.05;
   $kss *= 10;
   $lg = int($kss);
   return( ($lg / 10) . " " . $oss );
}
sub get_nn { # perl nice number nicenum add commas
   my ($n) = @_;
   if (length($n) > 3) {
      my $mod = length($n) % 3;
      my $ret = (($mod > 0) ? substr( $n, 0, $mod ) : '');
      my $mx = int( length($n) / 3 );
      for (my $i = 0; $i < $mx; $i++ ) {
         if (($mod == 0) && ($i == 0)) {
            $ret .= substr( $n, ($mod+(3*$i)), 3 );
         } else {
            $ret .= ',' . substr( $n, ($mod+(3*$i)), 3 );
         }
      }
      return $ret;
   }
   return $n;
}
sub english_date_from_iso_style_date{
     my $date=shift;
     $date=~/(\d{4})(\d{2})(\d{2})/;
     my $d=Date::Handler->new({date=>{year=>$1,
          month=>$2,day=>$3}});
     return $d->MonthName().' '.$d->Day().', '.$d->Year();
}
# eof

index -|- top