#!/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 = ; 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 = ; 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+\s+(.+)$/) { # 12/07/2008 17:17 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 (-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