Generated: Sun Aug 21 11:11:02 2011 from gendowntable02.pl 2011/04/24 23.8 KB.
#!/usr/bin/perl -w # NAME: gendowntable.pl (was ziptable.pl) # AIM: Given a set of zip files, prepare a somewhat standard table with # Date Zip Size MD5 columns. # 24/04/2011 - Only process ZIP file... # 21/08/2010 - Add <b> to link, and allow wild cards, like *.zip, *.gz... # 16/08/2010 - Make it simple - use 'gendowntable .' to do the current directory # 14/08/2010 geoff mclane http://geoffair.net/mperl use strict; use warnings; use File::Basename; # split path ($name,$dir,$ext) = fileparse($file [, qr/\.[^.]*/] ) use Cwd; use File::stat; use Digest::MD5; use File::Spec; # File::Spec->rel2abs($rel); # we are IN the SLN directory, get ABSOLUTE from RELATIVE use File::DosGlob 'glob'; my $perl_dir = 'C:\GTools\perl'; unshift(@INC, $perl_dir); require 'logfile.pl' or die "Unable to load logfile.pl ...\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = $perl_dir."\\temp.$pgmname.txt"; open_log($outfile); # user variables my $load_log = 0; my $in_file = ''; my @in_files = (); my $targ_dir = ''; my $out_htm = $perl_dir."\\tempzip.htm"; my $src_dir = ''; my $htm_output = ''; my $def_css = 'projects.css'; my $do_item_sort = 1; my $sort_by_time = 1; my $invert_sort = 0; my $verbose = 0; my $load_dir = ''; my $add_alpha_table = 1; my @excluded_files = (); my $upd_bat = $perl_dir."\\tempupdt.bat"; $upd_bat = 'C:\MDOS\tempupdt.bat' if (-d 'C:\MDOS'); # debug my $debug_on = 0; my $def_file = 'C:\DTEMP\FG\worldkit.zip'; my $def_target = 'C:\DTEMP'; ### program variables my @warnings = (); my $cwd = cwd(); my $os = $^O; my $iswin = ($os =~ /Win/i) ? 1 : 0; my $cmd_line = ''; sub VERB() { return ($verbose > 0); } sub VERB2() { return ($verbose > 1); } sub VERB5() { return ($verbose > 4); } sub VERB9() { return ($verbose > 8); } sub pgm_exit($$) { my ($val,$msg) = @_; if (length($msg)) { $msg .= "\n" if (!($msg =~ /\n$/)); prt($msg) } close_log($outfile,$load_log); exit($val); } sub prtw($) { my ($tx) = shift; $tx =~ s/\n$//; prt("$tx\n"); push(@warnings,$tx); } sub show_warnings() { if (@warnings) { prt( "\nGot ".scalar @warnings." WARNINGS...\n" ); foreach my $itm (@warnings) { prt("$itm\n"); } prt("\n"); } else { prt( "\nNo warnings issued.\n\n" ); } } sub get_html_head($) { my ($cssfil) = shift; my $htm_top = <<EOF; <!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN" "http://www.w3.org/TR/html4/loose.dtd"> <html> <head> <link rel="shortcut icon" href="http://geoffair.net/projects/images/favicon.ico"> <meta http-equiv="Content-Language" content="en-us"> <meta name="GENERATOR" content="Microsoft FrontPage 5.0"> <meta name="ProgId" content="FrontPage.Editor.Document"> <meta http-equiv="Content-Type" content="text/html; charset=us-ascii"> <meta name="author" content="geoff mclane"> <meta name="keywords" content="geoff, mclane, geoffmclane, computer, consultant, programmer, projects, open, sources, GPL, LGPL,"> <meta name="description" content="zip download table."> <title> Zip Download Table </title> <link href="$cssfil" rel="stylesheet" rev="stylesheet" type="text/css" media="screen"> </head> <body> <a name="top" id="top"></a> <h1> Zip Download Table </h1> <p class="ctr"> <a href="index.htm" target="_self">index</a> EOF if ($add_alpha_table) { $htm_top .= " <br>\n"; $htm_top .= " <a target=\"_self\" href=\"#alphabetic\">alphabetic</a>"; } $htm_top .= " </p>\n"; return $htm_top; } sub get_html_tail($) { my ($comment) = @_; my $htm_end = <<EOF; <hr class="mini"> <p class="top"> <a href="#top">top</a> </p> <p class="rite"> EOP </p> <p> <a name="end" id="end"></a> <a target="_blank" href="http://sourceforge.net/projects/tidy"><img border="0" src="images/checked_by_tidy.gif" alt="checked by Tidy" width="32" height="32"></a> <a target="_blank" href="http://validator.w3.org/check?uri=referer"><img border="0" src="images/valid-html401.gif" alt="Valid HTML 4.01 Transitional" width="88" height="31"></a> </p> <!-- $comment --> </body> </html> EOF return $htm_end; } sub get_table_head() { my $th = <<EOF; <table border="1" cellpadding="2" cellspacing="2" align="center" summary="Download table"> EOF return $th; } sub get_table_header() { my $th = <<EOF; <tr> <th> Date </th> <th> Link </th> <th> Size </th> <th> MD5 </th> </tr> EOF return $th; } sub get_nn($) { # perl nice number nicenum add commas my ($n) = shift; 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 get_YYYYMMDD($) { my ($t) = shift; my @f = (localtime($t))[0..5]; my $m = sprintf( "%04d/%02d/%02d", $f[5] + 1900, $f[4] +1, $f[3]); return $m; } sub get_hex_digest($) { my ($fil) = shift; if (open FILE, "<$fil") { binmode FILE; my $md5 = Digest::MD5->new; while (<FILE>) { $md5->add($_); } close FILE; return $md5->hexdigest; } else { pgm_exit(1,"ERROR: Unable to open file [$fil]\n"); } } # put largest first sub mycmp_decend2 { # special - ascend by 2nd component - time in this case if ($invert_sort) { return 1 if (${$a}[1] > ${$b}[1]); return -1 if (${$a}[1] < ${$b}[1]); } else { return -1 if (${$a}[1] > ${$b}[1]); return 1 if (${$a}[1] < ${$b}[1]); } return 0; } sub mycmp_decend3 { # special - ascend by 3rd component - size in this case if ($invert_sort) { return 1 if (${$a}[2] > ${$b}[2]); return -1 if (${$a}[2] < ${$b}[2]); } else { return -1 if (${$a}[2] > ${$b}[2]); return 1 if (${$a}[2] < ${$b}[2]); } return 0; } # put number first, then ALPHA - inverted to numeric sort sub mycmp_decend6 { # special - ascend by 6th component - filename in this case if ($invert_sort) { return -1 if (lc(${$a}[5]) gt lc(${$b}[5])); return 1 if (lc(${$a}[5]) lt lc(${$b}[5])); } else { return 1 if (lc(${$a}[5]) gt lc(${$b}[5])); return -1 if (lc(${$a}[5]) lt lc(${$b}[5])); } return 0; } sub Get_Alpha_Jump($) { my ($ra) = @_; # = \@found my $cnt = scalar @{$ra}; my ($i,$ch,$lc); for ($i = 0; $i < $cnt; $i++) { $ch = substr(uc(${$ra}[$i][5]),0,1); } } # process_file_list(\@in_files,$dst_dir,$src_dir,$out_htm); sub process_file_list($$$$) { my ($ra,$dst,$src,$out) = @_; my $rp = get_rel_dos_path($src,$dst); my $fcnt = scalar @{$ra}; prt("Got $fcnt files, relative path is [$rp]\n"); my ($file,$ff,$ok,$sb,$hfil,$cnt,$html,$ifile,$dir); my ($dig,$i,$tm,$tot,$sz,$nn,$ctim,$indent); $src .= "\\" if (!($src =~ /(\\|\/)$/)); $cnt = 0; my @found = (); foreach $ifile (@{$ra}) { ($file,$dir) = fileparse($ifile); $ff = $src.$file; $hfil = path_d2u($rp.$file); $ok = '*** NOT FOUND***'; if ((-f $ff)&&($sb = stat($ff))) { $ok = 'ok'; $cnt++; $dig = get_hex_digest($ff); # 0 1 2 3 4 5 push(@found, [ $ff, $sb->mtime, $sb->size, $hfil, $dig, $file ]); } prt("file: [$ff] $ok, rel=[$hfil]\n"); } pgm_exit(1,"ERROR: No source files found!\n") if ($cnt == 0); prtw("WARNING: Only $cnt of $fcnt, are valid!\n") if ($cnt != $fcnt); if ($do_item_sort) { if ($sort_by_time) { @found = sort mycmp_decend2 @found; } else { @found = sort mycmp_decend3 @found; } } $html = ''; $html .= get_html_head($def_css); $html .= get_table_head(); $html .= get_table_header(); $tot = 0; for ($i = 0; $i < $cnt; $i++) { $ff = $found[$i][0]; $tm = $found[$i][1]; $sz = $found[$i][2]; $hfil = $found[$i][3]; $dig = $found[$i][4]; $file = $found[$i][5]; $ctim = get_YYYYMMDD($tm); $nn = get_nn($sz); $html .= " <tr>\n"; $html .= " <td>\n"; $html .= " $ctim\n"; $html .= " </td>\n"; $html .= " <td>\n"; $html .= " <a href=\"$hfil\"><b>$file</b></a>\n"; $html .= " </td>\n"; $html .= " <td align=\"right\">\n"; $html .= " $nn\n"; $html .= " </td>\n"; $html .= " <td>\n"; $html .= " <tt>$dig</tt>\n"; $html .= " </td>\n"; $html .= " </tr>\n\n"; $tot += $sz; } $html .= " </table>\n"; $html .= " <p>\n"; $html .= " Total $cnt files, ".get_nn($tot)." bytes.\n"; $html .= " </p>\n"; if ($add_alpha_table) { @found = sort mycmp_decend6 @found; $file = Get_Alpha_Jump(\@found) if ($cnt > 15); $html .= " <p class=\"nmb\">\n"; $html .= " <a name=\"alphabetic\"></a>\n"; $html .= " Alphabetic Table. $file\n"; $html .= " </p>\n"; $html .= get_table_head(); $html .= get_table_header(); $tot = 0; for ($i = 0; $i < $cnt; $i++) { $ff = $found[$i][0]; $tm = $found[$i][1]; $sz = $found[$i][2]; $hfil = $found[$i][3]; $dig = $found[$i][4]; $file = $found[$i][5]; $ctim = get_YYYYMMDD($tm); $nn = get_nn($sz); $html .= " <tr>\n"; $html .= " <td>\n"; $html .= " $ctim\n"; $html .= " </td>\n"; $html .= " <td>\n"; $html .= " <a href=\"$hfil\"><b>$file</b></a>\n"; $html .= " </td>\n"; $html .= " <td align=\"right\">\n"; $html .= " $nn\n"; $html .= " </td>\n"; $html .= " <td>\n"; $html .= " <tt>$dig</tt>\n"; $html .= " </td>\n"; $html .= " </tr>\n\n"; } $html .= " </table>\n"; $html .= " <p class=\"nmt\">\n"; $html .= " Total $cnt files.\n"; $html .= " </p>\n"; } $file = $cmd_line; $indent = ' '; if (length($file) > 70) { my @arr = split(/\s/,$file); my $max = 40; $ff = ''; $file = ''; foreach $ifile (@arr) { $ff .= ' ' if (length($ff)); $ff .= $ifile; if (length($ff) > $max) { $file .= "\n$indent" if (length($file)); $file .= $ff; $ff = ''; $max = 60; } } if (length($ff)) { $file .= "\n$indent" if (length($file)); $file .= $ff; $ff = ''; } } $ctim = "Generated ".localtime(time()).", by $pgmname,\n in [$cwd]\n with command [$file]"; $html .= get_html_tail($ctim); write2file($html,$out); prt("Written to $out...and loading in browser...\n"); ($file,$dir) = fileparse($out); $ff = $dir.$def_css; if ( !((-f $def_css)||(-f $ff)) ) { prt("May not display correctly, since [$def_css] appears missing.\n"); } system($out); $htm_output = '.' if (length($htm_output) == 0); $html = ''; $html .= "\@echo COPY [$out] TO [$htm_output]?\n"; $html .= "\@echo WARNING: Any existing file will be OVERWRITTEN!\n"; $html .= "\@echo *** CONTINUE? ***\n"; $html .= "\@pause\n"; $html .= "copy $out $htm_output\n"; write2file($html,$upd_bat); prt("Written to $upd_bat, to do the copy, if OK...\n"); } sub process_in_files($) { my ($ra) = @_; # \@in_files process_file_list($ra,$targ_dir,$src_dir,$out_htm); } sub in_exclude_list($) { my ($fil) = @_; $fil = lc($fil) if ($iswin); my ($itm); foreach $itm (@excluded_files) { $itm = lc($itm) if ($iswin); return 1 if ($fil eq $itm); } return 0; } sub in_include_list($) { my $file = shift; return 1 if ($file =~ /\.zip$/i); return 1 if ($file =~ /\.tar.gz$/i); return 0; } sub process_dir($) { my ($dir) = @_; return if (length($dir) == 0); pgm_exit(1,"ERROR: Unable to open directory [$dir]!\n") if (! opendir(DIR,$dir)); my @files = readdir(DIR); closedir(DIR); my ($file,$ff); my @arr = (); $dir .= "/" if (!($dir =~ /(\\|\/)$/)); foreach $file (@files) { next if (($file eq '.')||($file eq '..')); next if (!in_include_list($file)); $ff = $dir.$file; if (-f $ff) { next if (in_exclude_list($file)); push(@arr,$ff); } } if (@arr) { parse_args(@arr); } else { pgm_exit(1,"ERROR: Directory [$dir] contains NO files!\n"); } } ######################################### ### MAIN ### parse_args(@ARGV); # prt( "$pgmname: in [$cwd]: Hello, World...\n" ); process_dir($load_dir); process_in_files( \@in_files ); pgm_exit(0,"Normal exit(0)"); ######################################## sub give_help { prt("$pgmname: version 0.0.1 2010-08-14\n"); prt("Usage: $pgmname [options] zip-file [zip-file...]\n"); prt("Options:\n"); prt(" --help (-h or -?) = This help, and exit 0.\n"); prt(" -out=<file> = Output HTML file, and implies target directory.\n"); prt(" -targ=<dir> = Target directory, for HTML\n"); prt(" -css=<file> = Set CSS file of output HTML\n"); prt(" -sort=<on|off|time|size> = Sort files per time, size. Default is ON per time\n"); prt(" -@<in_file> = An input file, with line delimited file list.\n"); prt(" -v[num] = Bump or set verbosity.\n"); prt(" -l = Load log at end.\n"); prt(" -dir=<dir> = Process directory for input files.\n"); prt(" -x=<file[;file;..] = Exclude file, indirectory processing.\n"); } sub need_arg { my ($arg,@av) = @_; pgm_exit(1,"ERROR: [$arg] must have following argument!\n") if (!@av); } sub load_input_file($) { my ($fil) = @_; if (! open INF, "<$fil") { pgm_exit(1,"ERROR: Unable to OPEN input file [$fil]!\n"); } my @lines = <INF>; close INF; my $lncnt = scalar @lines; prt("Processing $lncnt lines...\n"); my ($i,$line); my @arr = (); for ($i = 0; $i < $lncnt; $i++) { $line = trim_all($lines[$i]); next if (length($line) == 0); next if ($line =~ /^#/); # skip comment lines push(@arr,$line); } parse_args(@arr) if (@arr); } sub get_sort_arg($) { my ($txt) = @_; return 1 if ($txt =~ /^on$/i); return 1 if ($txt =~ /^yes$/i); return 1 if (($txt =~ /^\d+$/)&&($txt > 0)); return 0 if ($txt =~ /^off$/i); return 0 if ($txt =~ /^no$/i); return 0 if (($txt =~ /^\d+$/)&&($txt == 0)); if (($txt =~ /^time$/i)||($txt =~ /^date$/i)) { prt("Set time/date sort\n") if (VERB2()); $sort_by_time = 1; return 1; } if ($txt =~ /^size$/) { $sort_by_time = 0; prt("Set size sort\n") if (VERB2()); return 1; } if (($txt =~ /^i$/i)||($txt =~ /^invert$/i)) { $invert_sort = 1; prt("Set inverted sort\n") if (VERB2()); return 1; } prt("ERROR: Unknown sort parameter! Got [$txt]!\n"); pgm_exit(1,"Can be 'on','off','yes','no','1','0','time','date','size','i', or 'invert'...\n"); } sub pre_process_verbosity { my (@av) = @_; my ($arg,$sarg,$tmp); while (@av) { $arg = $av[0]; if ($arg =~ /-/) { $sarg = substr($arg,1); $sarg = substr($sarg,1) while ($sarg =~ /-/); if ($sarg =~ /^v/i) { if ($sarg =~ /^v(\d+)$/) { $tmp = $1; $verbose = $tmp; } else { while ($sarg =~ /^v/i) { $verbose++; $sarg = substr($sarg,1); } } prt("Set verbosity level to [$verbose]\n") if ($verbose); if (VERB9()) { $load_log = 1; prt("VERB=$verbose: Also set load log.\n"); } } } shift @av; } } sub add_to_excludes($) { my ($xlist) = @_; my @arr = split(';',$xlist); my ($file,$cnt); $cnt = 0; foreach $file (@arr) { push(@excluded_files,$file); $cnt++; } prt("Added $cnt to excluded file list.\n") if (VERB2()); prt("List [$xlist]\n") if (VERB9()); } sub got_wild_char($) { my $fil = shift; return 1 if ($fil =~ /\*/); return 1 if ($fil =~ /\?/); return 0; } sub process_wild_card($) { my $wild = shift; $in_file = $wild; my $ff = File::Spec->rel2abs($wild); my ($nam,$dir,$ext) = fileparse($ff,qr/\.[^.]*/); my @files = glob($wild); my $cnt = 0; my ($itm); foreach $itm (@files) { $ff = $dir.$itm; push(@in_files,$ff); prt("Added input to [$itm]\n") if (VERB2()); $cnt++; } if ($cnt) { prt("Added $cnt inputs from [$wild]\n") if (VERB2()); } else { prtw("WARNING: Input [$wild] did NOT yield any files.\n"); } } sub parse_args { my (@av) = @_; my ($arg,$sarg,$tmp,$act); pre_process_verbosity(@av); while (@av) { $arg = $av[0]; $cmd_line .= ' ' if (length($cmd_line)); $cmd_line .= $arg; $act = 0; if ($arg =~ /^-/) { $sarg = substr($arg,1); $sarg = substr($sarg,1) while ($sarg =~ /^-/); if (($sarg =~ /^h/i)||($sarg eq '?')) { give_help(); pgm_exit(0,"Help exit(0)"); } elsif ($sarg =~ /^v/i) { # already processed } elsif ($sarg =~ /^l$/i) { $load_log = 1; prt("Set to load log at end.\n") if (VERB2()); } elsif ($sarg =~ /^targ=(.+)$/i) { $sarg = $1; $act = 1; } elsif ($sarg =~ /^targ$/i) { need_arg(@av); shift @av; $sarg = $av[0]; $cmd_line .= ' ' if (length($cmd_line)); $cmd_line .= $sarg; $act = 1; } elsif ($sarg =~ /^out=(.+)$/i) { $sarg = $1; $act = 2; } elsif ($sarg =~ /^out$/i) { need_arg(@av); shift @av; $sarg = $av[0]; $cmd_line .= ' ' if (length($cmd_line)); $cmd_line .= $sarg; $act = 2; } elsif ($sarg =~ /^css=(.+)$/i) { $sarg = $1; $act = 3; } elsif ($sarg =~ /^css$/i) { need_arg(@av); shift @av; $sarg = $av[0]; $cmd_line .= ' ' if (length($cmd_line)); $cmd_line .= $sarg; $act = 3; } elsif ($sarg =~ /^dir=(.+)$/i) { $sarg = $1; $act = 5; } elsif ($sarg =~ /^dir$/i) { need_arg(@av); shift @av; $sarg = $av[0]; $cmd_line .= ' ' if (length($cmd_line)); $cmd_line .= $sarg; $act = 5; } elsif ($sarg =~ /^x=(.+)$/i) { $sarg = $1; $act = 6; } elsif ($sarg =~ /^x$/i) { need_arg(@av); shift @av; $sarg = $av[0]; $cmd_line .= ' ' if (length($cmd_line)); $cmd_line .= $sarg; $act = 6; } elsif ($sarg =~ /^sort=(.+)$/i) { $sarg = $1; $act = 4; } elsif ($sarg =~ /^sort$/i) { need_arg(@av); shift @av; $sarg = $av[0]; $cmd_line .= ' ' if (length($cmd_line)); $cmd_line .= $sarg; $act = 4; } elsif ($sarg =~ /^\@(.+)$/) { $tmp = $1; prt("Loading input file [$tmp]...\n") if (VERB2()); load_input_file($tmp); } else { pgm_exit(1,"ERROR: Invalid argument [$arg]! Try -?\n"); } } else { $in_file = File::Spec->rel2abs($arg); if (-d $in_file) { $load_dir = $in_file; prt("Set to load files from directory [$load_dir]\n") if (VERB2()); } else { if (got_wild_char($arg)) { process_wild_card($arg); } else { pgm_exit(1,"ERROR: Can NOT locate file [$in_file]! Aborting...\n") if (! -f $in_file); push(@in_files,$in_file); prt("Added input to [$in_file]\n") if (VERB2()); } } } if ($act == 1) { $tmp = File::Spec->rel2abs($sarg); pgm_exit(1,"ERROR: Can NOT locate dir [$tmp]! [$arg] [$sarg] Aborting...\n") if (! -d $tmp); $targ_dir = $tmp; prt("Set target directory to [$targ_dir]\n") if (VERB2()); } elsif ($act == 2) { # Try to handle BOTH -out=<file> or -out=<dir> $htm_output = File::Spec->rel2abs($sarg); if (-d $htm_output) { $targ_dir = $htm_output; } else { ($tmp,$targ_dir) = fileparse($htm_output); } prt("Set output html to [$htm_output], target dir [$targ_dir]\n") if (VERB2()); } elsif ($act == 3) { $def_css = $sarg; prt("Set CSS file for output html to [$def_css], target dir [$targ_dir]\n") if (VERB2()); } elsif ($act == 4) { $do_item_sort = get_sort_arg($sarg); prt("Set sort to ".($do_item_sort ? "On" : "OFF")."\n") if (VERB2()); } elsif ($act == 5) { $in_file = $sarg; $load_dir = $sarg; pgm_exit(1,"ERROR: Directory [$load_dir] does NOT EXIST!\n") if (! -d $load_dir); prt("Set to load files from directory [$load_dir]\n") if (VERB2()); } elsif ($act == 6) { add_to_excludes($sarg); } shift @av; } if ((length($in_file) == 0) && $debug_on ) { if (-f $def_file) { $in_file = $def_file; push(@in_files,$in_file); $targ_dir = $def_target; } } if (length($in_file) == 0) { pgm_exit(1,"ERROR: No input files found in command!\n"); } if (length($src_dir) == 0) { if (-d $in_file) { $src_dir = $in_file; } else { ($arg,$src_dir) = fileparse($in_file); } } if (length($targ_dir) == 0) { $targ_dir = $src_dir; } } # eof - gendowntable02.pl