dir2list02.pl to HTML.

index -|- end

Generated: Sun Mar 2 17:19:45 2014 from dir2list02.pl 2013/10/28 16.9 KB. text copy

#!/perl -w
# NAME: dir2list02.pl
# AIM: Take a directory listing file, and write it as a simple list
# 28/10/2013 - -bear list should also effect file written
# 06/07/2013 - Add -find to indicate it is a fa4 list
# 19/05/2013 - Add 
# 08/01/2013 - Some updates
# 11/11/2011 - Some improvement in the UI...
use strict;
use warnings;
use File::Basename;  # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] )
use Cwd;
use Time::Local;
my $perl_dir = 'C:\GTools\perl';
unshift(@INC, $perl_dir);
require 'lib_utils.pl' or die "Unable to load 'lib_utils.pl' Check paths in \@INC...\n";
# log file stuff
our ($LF);
my $pgmname = $0;
if ($pgmname =~ /(\\|\/)/) {
   my @tmpsp = split(/(\\|\/)/,$pgmname);
   $pgmname = $tmpsp[-1];
}
my $outfile = $perl_dir."\\temp.$pgmname.txt";
open_log($outfile);

# features
my $VERS = "0.0.4 2013-10-28";
#my $VERS = "0.0.3 2013-01-08";
#my $VERS = "0.0.2 2011-11-11";
my $load_log = 0;
my $just_simple_list = 1;
my $date_sort = 0;
my $size_sort = 0;
my $suppress_common = 0;
my $out_xml = '';
my $bear_list = 0;
my $is_fa4_file = 0;

my @input_files = ();
my $verbosity = 0;

### program variables
my @warnings = ();
my $cwd = cwd();
my $os = $^O;
my @output_files = ();

sub VERB1() { return $verbosity >= 1; }
sub VERB2() { return $verbosity >= 2; }
sub VERB5() { return $verbosity >= 5; }
sub VERB9() { return $verbosity >= 9; }

# DEBUG
my $debug_on = 0;
my $def_file = 'C:\FG\tempkap';
#my $def_file = 'C:\Projects\tempmam';
#my $def_file = 'C:\HOMEPAGE\tempdefold';
my $dbg_01 = 0; # show datetime stuff

sub show_warnings($) {
    my ($val) = @_;
    if (@warnings) {
        prt( "\nGot ".scalar @warnings." WARNINGS...\n" );
        foreach my $itm (@warnings) {
           prt("$itm\n");
        }
        prt("\n");
    } else {
        prt( "\nNo warnings issued.\n\n" ) if (VERB9());
    }
}

sub pgm_exit($$) {
    my ($val,$msg) = @_;
    if (length($msg)) {
        $msg .= "\n" if (!($msg =~ /\n$/));
        prt($msg);
    }
    show_warnings($val);
    close_log($outfile,$load_log);
    exit($val);
}


sub prtw($) {
   my ($tx) = shift;
   $tx =~ s/\n$//;
   prt("$tx\n");
   push(@warnings,$tx);
}

#              0    1      2      3      4      5      6     7
# push(@list, [$tm, $date, $time, $ampm, $size, $name, $dir, $sizen]);
# oldest to newest
sub mycmp_decend0 {
   my $off = 0;
   return -1 if (${$a}[$off] < ${$b}[$off]);
   return 1 if (${$a}[$off] > ${$b}[$off]);
   return 0;
}
# smallest to largest
sub mycmp_decend7 {
   my $off = 7;
   return -1 if (${$a}[$off] < ${$b}[$off]);
   return 1 if (${$a}[$off] > ${$b}[$off]);
   return 0;
}

sub suppress_last($$) {
   my ($last,$dir) = @_;
   my $len1 = length($last);
   my $len2 = length($dir);
   my $len = (($len2 > $len1) ? $len1 : $len2);
   my $ndir = '';
   my $i = 0;
   for (; $i < $len; $i++) {
      if (substr($last,$i,1) eq substr($dir,$i,1)) {
         $ndir .= ' ';
      } else {
         last;
      }
   }
   $ndir .= substr($dir,$i);
   return $ndir;
}

sub delete_cwd($$) {
    my ($path,$dir) = @_;
    my $lpath = lc(path_u2d($path));
    my $ldir  = lc(path_u2d($dir));
    my $len1 = length($lpath);
    my $len2 = length($ldir);
    my $len = (($len2 > $len1) ? $len1 : $len2);
    my ($i);
    for ($i = 0; $i < $len; $i++) {
        last if (substr($lpath,$i,1) ne substr($ldir,$i,1));
    }
    return substr($path,$i);
}

sub datetime_to_epoch_secs($$$$$$) {
    my ($year,$mth,$day,$hrs,$min,$sec) = @_;
    my $es = timelocal($sec,$min,$hrs,$day,$mth,$year); 
    prt( "datatime: $year/$mth/$day $hrs:$min:$sec = $es\n" ) if ($dbg_01);
    return $es;
}

sub datetime_to_seconds($) {
    my ($date) = @_;
    if ($date =~ /^(\d{4}).{1}(\d{2}).{1}(\d{2})\s+(\d{2}).+(\d{2}).+(\d{2})\s*$/) {
        my $year = $1;
        my $mth = $2;
        my $day = $3;
        my $hrs = $4;
        my $min = $5;
        my $sec = $6;
        my $es = datetime_to_epoch_secs($year,$mth-1,$day,$hrs,$min,$sec); 
        prt( "datatime: $year/$mth/$day $hrs:$min:$sec = $es\n" ) if ($dbg_01);
        return $es;
    } else {
        prtw("WARNING: FAILED in regex! [$date] did not split\n");
    }
}

#  0         1    2      3   4            5        6     7    8    9         10     11  12 13     14 15 16    17
# "Processed 1585 files, 134 directories, rejected 1110, done 475, 3,596,970 bytes, for 24 finds, in 24 files ..."

sub process_fa4_file($) {
    my ($in_file) = @_;
    prt( "Processing [$in_file]... " );
    if (!open IF, "<$in_file") {
       prtw( "WARNING: Can not OPEN [$in_file] ... $1 ...\n" );
       return;
    }
    my @lines = <IF>;
    close IF;
    my $lncnt = scalar @lines;
    prt( "Got $lncnt lines...\n" );
    my ($line,$filecnt,$findcnt,@arr,$cnt,$tline,$len,$i,$infm,$ch);
    $line = $lines[-1];
    chomp $line;
    @arr = split(/\s+/,$line);
    $cnt = scalar @arr;
    if (($line =~ /Processed \d+ files, \d+ directories,/)&&($cnt == 18)) {
        # rejected %d+, done \d+, [\d,]+ bytes, for (\d+) finds, in (\d+) files \.\.\.$/) {
        $findcnt = $arr[12];
        $filecnt = $arr[15];
        prt("Got $filecnt files, $findcnt finds...\n");
        #prt("Got array of $cnt items...\n");
    } else {
        prt("Last line is\n");
        prt("[$line]\n");
        prt("Does NOT appear to be a FA4 file output!\n");
        return;
    }
    $lncnt--;
    $infm = 1;   # start in file
    for ($i = 0; $i < $lncnt; $i++) {
        $line = $lines[$i];
        chomp $line;
        $tline = trim_all($line);
        $len = length($tline);
        next if ($len == 0);
        $ch = substr($line,0,1);
        if ((($ch eq '\\')||($ch =~ /\w/))&&($line =~ /\./)) {
            prt("$line\n");
        }
    }
}

sub process_input_file($) {
   my ($in_file) = @_;
   my (@in_lines,$gottot,$line,@list,@lastlns,$dir);
   my ($date,$time,$ampm,$size,$name);
   my ($dy,$mt,$yr,$hr,$mn,$tm,$cnt,$i);
   my ($minlen,$len,$min2,$sizen,$mins);
   my ($lastdir,$outdir,$dircount,$msg);
   my (@slist);
   my $total_bytes = 0;
   my $earliest_date = time() + 50000;
   my $latest_date = 0;
   my $smallest_size = 999999999999;
   my $largest_size = 0;
   prt( "Processing [$in_file]... " );
   open IF, "<$in_file" or mydie( "Can not OPEN [$in_file] ... $1 ...\n" );
   @in_lines = <IF>;
   close IF;
   prt( " ".scalar @in_lines." lines..." );
   $gottot = 0;
   $line = '02/09/2004  05:13 PM            10,104 Multipad.mak';
   ##if ($line =~ /^(\d{2}\/\d{2}\/\d{4})\s+(\d{2}:\d{2})\s+(\w{2})\s+([\d,]+)\s+(\w+.*)/) {
   ##   print "ok\n";
   ##} else {
   ##   print "FAILED\n";
   ##}
   @list = ();
   @lastlns = ();
   $cnt = 0;
   $dircount = 0;
   foreach $line (@in_lines) {
      ###prt( $line );
      chomp $line;
      $line =~ s/\r$//;
      next if ($line =~ /^\s*$/);
      # like 'Directory of F:\GTools\ASM\e'
      if ($gottot) {
         ###prt( "$line\n" );
         push(@lastlns, $line) if (length($line));
         $gottot = 0;
      } else {
         #  Volume Serial Number is D833-AEFA
         if ($line =~ /^\s*Volume\s+Serial\s+Number\s+is\s+(.+)\s*$/) {
            # skip this line
         #  Volume in drive C is DRIVEC-D1 also ' Volume in drive C has no label.'
         #} elsif ($line =~ /^\s*Volume\s+in\s+drive\s+(\w+)\s+is\s+(.+)\s*$/) {
         } elsif ($line =~ /^\s*Volume\s+in\s+drive\s+(\w+)\s+(.+)\s*$/) {
            # drive and volume name
         } elsif ($line =~ /\s+Directory of (.*)/) {
            $dir = $1;
            ##prt( "$dir\n" );
         # like 
         # '02/09/2004  05:10 PM             4,301 FindI32.mak'
         } elsif ($line =~ /^(\d{2}\/\d{2}\/\d{4})\s+(\d{2}:\d{2})\s+(\w{2})\s+([\d,]+)\s+(\w+.*)/) {
            $date = $1;
            $time = $2;
            $ampm = $3;
            $size = $4;
            $name = $5;
            $sizen = $size;
            $sizen =~ s/,//g;
            $total_bytes += $sizen;
            $smallest_size = $sizen if ($sizen < $smallest_size);
            $largest_size = $sizen if ($sizen > $largest_size);
            ($dy,$mt,$yr) = split('/',$date);
            ($hr,$mn) = split(':',$time);
            if ($ampm eq 'PM') { $hr += 12; }
            $tm = $yr * 365 * 24 * 60;
            $tm += $mt * 30 * 24 * 60;
            $tm += $dy * 24 * 60;
            $tm += $mn * 60;
            $tm = datetime_to_epoch_secs($yr,$mt-1,$dy,$hr,$mn,0);
            $earliest_date = $tm if ($tm < $earliest_date);
            $latest_date = $tm if ($tm > $latest_date);
            ###prt( "[$date] [$time] [$ampm] [$size] [$name] [$dir]\n" );
            ###prt( "[$dy/$mt/$yr] [$time] [$ampm] [$size] [$name] [$dir]\n" );
            ###prt( "$tm [$dy/$mt/$yr] [$hr:$mn] [$ampm] [$size] [$name] [$dir]\n" );
            #            0    1      2      3      4      5      6     7
            push(@list, [$tm, $date, $time, $ampm, $size, $name, $dir, $sizen]);
         # or like
         # '22/12/2012  15:58            46,967 kap140.nas'
         # '05/01/2010  12:16             1,882 default.phtml
         } elsif ($line =~ /^(\d{2}\/\d{2}\/\d{4})\s+(\d{2}:\d{2})\s+([\d,]+)\s+(\w+.*)$/) {
            $date = $1;
            $time = $2;
            $size = $3;
            $name = $4;
            $sizen = $size;
            $sizen =~ s/,//g;
            $total_bytes += $sizen;
            $smallest_size = $sizen if ($sizen < $smallest_size);
            $largest_size = $sizen if ($sizen > $largest_size);
            ($dy,$mt,$yr) = split('/',$date);
            ($hr,$mn) = split(':',$time);
            $tm = $yr * 365 * 24 * 60;
            $tm += $mt * 30 * 24 * 60;
            $tm += $dy * 24 * 60;
            $tm += $mn * 60;
            $ampm = ' ';   # none = 24 hours clock
            $tm = datetime_to_epoch_secs($yr,$mt-1,$dy,$hr,$mn,0);
            $earliest_date = $tm if ($tm < $earliest_date);
            $latest_date = $tm if ($tm > $latest_date);
            #            0    1      2      3      4      5      6     7
            push(@list, [$tm, $date, $time, $ampm, $size, $name, $dir, $sizen]);
         #      Total Files Listed:
         } elsif ($line =~ /^\s+Total Files Listed:/) {
            $gottot = 1;
         #    1 File(s)          4,001 bytes
         } elsif ($line =~ /^\s*([\d,]+)\s+File\(s\)\s+([\d,]+)\s+bytes\s*$/) {
            # what to do about this line????
         #               0 Dir(s)  17,821,298,688 bytes free
         } elsif ($line =~ /^\s*([\d,]+)\s+Dir\(s\)\s+([\d,]+)\s+bytes\s+free\s*$/) {
            # keep this value?
         } elsif ($line =~ /\d+\/\d+\/\d+\s+\d+:\d+\s+<DIR>\s+(.+)$/) {
            # 12/07/2008  17:17    <DIR>          Win32-API-0.41
            # discard directories
            $dircount++;
         } else {
            prt("CHECK ME: [$line]\n");
         }
      }
   }

   prt(", $dircount DIRECTORIES...") if ($dircount);
   $cnt = scalar @list;
   prt( ", got $cnt files ...\n" );
   if ($date_sort) {
      @slist = sort mycmp_decend0 @list;
   } elsif ($size_sort) {
      @slist = sort mycmp_decend7 @list;
   } else {
      @slist = @list;
   }
   $minlen = 0;
   $min2 = 0;
   $mins = 0;
   for ($i = 0; $i < $cnt; $i++ ) {
      $name = $slist[$i][5];
      $len = length($name);
      $minlen = $len if ($len > $minlen);
      $dir  = $slist[$i][6];
      $msg = "$dir\\$name";
      $len = length($msg);
      $min2 = $len if ($len > $min2);
      $size = $slist[$i][4];
      $len = length($size);
      $mins = $len if ($len > $mins);
   }
   $lastdir = '';
   $lastdir = path_u2d($cwd);
   $lastdir .= "\\" if (!($lastdir =~ /\\$/));
   for ($i = 0; $i < $cnt; $i++ ) {
      $date = $slist[$i][1];
      $time = $slist[$i][2];
      $ampm = $slist[$i][3];
      $size = $slist[$i][4];
      $name = $slist[$i][5];
      $dir  = $slist[$i][6];
      $msg = "$dir\\$name";
      if ($bear_list) {
          push(@output_files,$name);
      } else {
          push(@output_files,$msg);
      }
      if ($just_simple_list) {
          if ($bear_list) {
              $msg = $name;
          } elsif ($suppress_common) {
             $msg = delete_cwd($msg,$lastdir);
         }
         if (VERB5()) {
             $msg .= ' ' while (length($msg) < $min2);
             $size = " $size" while (length($size) < $mins);
             $msg .= " $date $time $size";
         }
         prt("$msg\n");
      } else {
         while (length($size) < 12) { $size = ' '.$size; }
         while (length($name) < $minlen) { $name .= ' '; }
         prt( "$date $time $ampm $size $name $dir\n" );
      }
   }
   $size = get_nn($total_bytes);
   prt("Total $size bytes ");
   if ($date_sort) {
       $msg = lu_get_YYYYMMDD_hhmmss($earliest_date);
       prt("earliest $msg ");
       $msg = lu_get_YYYYMMDD_hhmmss($latest_date);
       prt("latest $msg ");
   } elsif ($size_sort) {
       $msg = get_nn($smallest_size);
       prt("smallest $msg ");
       $msg = get_nn($largest_size);
       prt("largest $msg ");
   }
   prt("\n");
   $cnt = scalar @lastlns;
   for ($i = 0; $i < $cnt; $i++) {
      prt( $lastlns[$i]."\n" );
   }
}

sub process_input_files($) {
   my ($ra) = @_;
   foreach my $file (@{$ra}) {
       if ($is_fa4_file) {
           process_fa4_file($file);
       } else {
           process_input_file($file);
       }
   }
}

#########################################
### MAIN

process_args(@ARGV);
process_input_files(\@input_files);
if (length($out_xml) && @output_files) {
    write2file(join("\n",@output_files)."\n",$out_xml);
    prt("List written to [$out_xml]\n");
}
pgm_exit(0,"");

########################################

sub give_help {
    prt("$pgmname: version $VERS\n");
    prt("Usage: $pgmname [options] in-file\n");
    prt("Options:\n");
    prt(" --help  (-h or -?) = This help, and exit 0.\n");
    prt(" --verb[n]     (-v) = Bump [or set] verbosity. def=$verbosity\n");
    prt(" --load        (-l) = Load LOG at end. ($outfile)\n");
    prt(" --out <file>  (-o) = Write output to this file.\n");
    prt(" --size        (-s) = Sort by SIZE.\n");
    prt(" --date        (-d) = Sort by DATE.\n");
    prt(" --min         (-m) = Minimum file names. Remove current work directory.\n");
    prt(" --bare        (-b) = Just list the file names. Remove all directory.\n");
}

sub need_arg {
    my ($arg,@av) = @_;
    pgm_exit(1,"ERROR: [$arg] must have a following argument!\n") if (!@av);
}

sub process_args {
    my (@av) = @_;
    my ($arg,$sarg);
    while (@av) {
        $arg = $av[0];
        if ($arg =~ /^-/) {
            $sarg = substr($arg,1);
            $sarg = substr($sarg,1) while ($sarg =~ /^-/);
            if (($sarg =~ /^h/)||($sarg =~ /^\?/)) {
                give_help();
                pgm_exit(0,"Help exit(0)\n");
            } elsif ($sarg =~ /^v/) {
                if ($sarg =~ /^v.*(\d+)$/) {
                    $verbosity = $1;
                } else {
                    while ($sarg =~ /^v/) {
                        $verbosity++;
                        $sarg = substr($sarg,1);
                    }
                }
                prt("Verbosity = $verbosity\n") if (VERB1());
            } elsif ($sarg =~ /^b/) {
                $bear_list = 1;
                prt("Set to list only file names.\n") if (VERB1());
            } elsif ($sarg =~ /^f/) {
                $is_fa4_file = 1;
                prt("Set to view file as FA4 result.\n") if (VERB1());
            } elsif ($sarg =~ /^l/) {
                $load_log = 1;
                prt("Set to load log at end.\n") if (VERB1());
            } elsif ($sarg =~ /^s/) {
                $size_sort = 1;
                prt("Sort by SIZE.\n") if (VERB1());
            } elsif ($sarg =~ /^d/) {
                $date_sort = 1;
                prt("Sort by DATE.\n") if (VERB1());
            } elsif ($sarg =~ /^m/) {
                $suppress_common = 1;
                prt("Minimum form - suppress common.\n") if (VERB1());
            } elsif ($sarg =~ /^o/) {
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $out_xml = $sarg;
                prt("Set out file to [$out_xml].\n") if (VERB1());
            } else {
                pgm_exit(1,"ERROR: Unknown command [$arg]\n");
            }
        } else {
            if (! -f $arg) {
                prt("ERROR: Can NOT locate [$arg] file!\n");
                pgm_exit(1,"Check name, location...\n");
            }
            push(@input_files,$arg);
            prt("Added [$arg] to input file list...\n");
        }
        shift @av;
    }
    if (! @input_files) {
        if (-f $def_file && $debug_on) {
            push(@input_files,$def_file);
            prt("Added DEFAULT [$def_file] to input file list...\n");
        } else {
            pgm_exit(1,"ERROR: No input file, or files found on command line!\n");
        }
    }
}

# eof - dir2list02.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional