zipindex04.pl to HTML.

index -|- end

Generated: Sun Apr 15 11:46:53 2012 from zipindex04.pl 2011/11/07 27.7 KB.

#!/perl -w
# NAME: zipindex04.pl
# AIM: Given a folder, prepare a HTML table of zips, Date Link Size MD5
# This is a COMPLETE REWRITE of zipindex03.pl...
# 07/11/2011 - Include links for files like fgfs-data-03.zip.txt, if contains a MD5 string
# 05/11/2011 - Fix zip count in output HTLM, and ADD alphabetic list option (nocase)
# 25/04/2011 - Remove 'Not zip [' to $dbg_01
# 22/05/2010 - add ???
# 04/05/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 Digest::MD5  qw(md5 md5_hex md5_base64);
use File::stat; # to get the file date and size
use Time::Local;
unshift(@INC, 'C:\GTools\perl');
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 $perl_dir = 'C:\GTools\perl';
my $outfile = $perl_dir."\\temp.$pgmname.txt";
open_log($outfile);

# user variables
my $VERS = "0.0.2 2011-11-05";
# $VERS = "0.0.1 2010-05-04";
my $debug_on = 0;   # OFF for release
my $load_log = 0;
my $in_directory = '';
my $recursive = 0;
my $load_browser = 0;
my $out_file = $perl_dir."\\tempzip.htm";
my $sort_by_date = 1;
my $sort_by_size = 0;
my $image_path = 'images';
my $clds_path  = 'images';
my $clds_image = "$clds_path/clds3.jpg";
my @valid_imgs = qw( checked_by_tidy.gif valid-html401.gif );
my @excluded = ();
my $prefix_path = '';
my $add_text_column = 0;
my $use_cn8_span = 0; # "<span class=\"cn8\">$md5</span>";, else use <tt>...</tt>
my $add_alphabetic = 0;
my $inc_text_entries = 1;

### program variables
my @warnings = ();
my $cwd = cwd();
my $os = $^O;
my @files_found = ();
my ($in_file,$in_dir);
my $md5_count = 0;
my $total_size = 0;

# debug
my $def_dir = "C:\\HOMEPAGE\\GA\\fg\\zips\\srcs";
my $dbg_01 = 0;
my $dbg_02 = 0;

my $verbosity = 0;

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

# forward
sub process_dir($$);

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 pgm_exit($$) {
    my ($val,$msg) = @_;
    show_warnings();
    if (length($msg)) {
        $msg .= "\n" if (!($msg =~ /\n$/));
        prt($msg)
    }
    close_log($outfile,$load_log);
    exit($val);
}

sub u2d($) {
   my ($f) = shift;
   $f =~ s/\//\\/g;
   return $f;
}

sub d2u($) {
   my ($f) = shift;
   $f =~ s/\\/\//g;
   return $f;
}


sub sub_common_folder_dos {
   my ($f1, $f2) = @_;
   my $df1 = u2d($f1);
   my $df2 = u2d($f2);
   if ($os eq 'MSWin32') {
      $df1 = lc($df1);
      $df2 = lc($df2);
   }
   # paddle across, stopping at first difference
   my $off = 0;
   while ( substr($df1,$off,1) && substr($df2,$off,1) &&
         ( substr($df1,$off,1) eq substr($df2,$off,1) ) ) {
      $off++;
   }
   return substr($f1,$off);
}

sub sub_in_folder($) {
    my ($path) = shift;
    $path = sub_common_folder_dos($path,$in_directory);
    $path =~ s/^(\\|\/)//; # kick off any leading '\' or '/' - 2010-04-02
    return $path;
}

sub add_2_files_found($$) {
    my ($fil,$lev) = @_;
    #                  0    1    2 3
    push(@files_found,[$fil,$lev,0,0]);
}

sub seek_image_path($$$) {
    my ($ind,$rimgs,$rout) = @_;
    my $dbgs = 0;
    foreach my $img (@{$rimgs}) {
        my $inf = $ind.$img;
        prt("Checking [$inf]\n") if ($dbgs);
        if (-f $inf) {
            ${$rout} = './$img';
            return 1;
        }
        $inf = $ind."images\\$img";
        prt("Checking [$inf]\n") if ($dbgs);
        if (-f $inf) {
            ${$rout} = "images/$img";
            return 1;
        }
        $inf = $ind."..\\$img";
        prt("Checking [$inf]\n") if ($dbgs);
        if (-f $inf) {
            ${$rout} = "../$img";
            return 1;
        }
        $inf = $ind."..\\images\\$img";
        prt("Checking [$inf]\n") if ($dbgs);
        if (-f $inf) {
            ${$rout} = "../images/$img";
            return 1;
        }
        $inf = $ind."..\\..\\$img";
        prt("Checking [$inf]\n") if ($dbgs);
        if (-f $inf) {
            ${$rout} = "../../$img";
            return 1;
        }
        $inf = $ind."..\\..\\images\\$img";
        prt("Checking [$inf]\n") if ($dbgs);
        if (-f $inf) {
            ${$rout} = "../../images/$img";
            return 1;
        }
    }
    return 0;   # failed
}

sub check_in_directory($) {
    my ($ind) = shift;
    my $iret = 0;
    $ind = u2d($ind);
    $ind .= "\\" if (!($ind =~ /(\\|\/)$/));
    # try to find a suitable path and filename for 
    # my $image_path = 'images';
    # $clds_path = 'images'
    # my $clds_image = "$clds_path/clds3.jpg";
    my $npath = '';
    my @imgs = ( "clds3.jpg", "clds5.jpg" );
    if (seek_image_path($ind,\@imgs,\$npath)) {
        $clds_image = $npath;
        #prt("Set clouds image path to [$clds_image]\n");
        $iret++;
    }
    if (seek_image_path($ind,\@valid_imgs,\$npath)) {
        my ($in,$id) = fileparse($npath);
        $id =~ s/\/$//;
        $image_path = $id;
        #prt("Set valid paths to [$image_path]\n");
        $iret++;
    }
    prt("Using clds [$clds_image], valid [$image_path], rel to [$ind] path...\n");
    #pgm_exit(1,"Temp exit");
    return $iret;
}

sub process_dir($$) {
    my ($ind, $lev) = @_;
    my (@files,$fcnt,$ff,$file,@dirs);
   if ( opendir(DIR, $ind) ) {
        @files = readdir(DIR);
        closedir(DIR);
        my $fcnt = scalar @files;
        $ind .= "\\" if (!($ind =~ /(\\|\/)$/));
        @dirs = ();
        foreach $file (@files) {
            next if (($file eq '.')||($file eq '..'));
            $ff = $ind.$file;
            if (-d $ff) {
                push(@dirs,$ff);
            } else {
                add_2_files_found($ff,$lev);
            }
        }
        if ($recursive && @dirs) {
            foreach $file (@dirs) {
                process_dir($file,($lev + 1));
            }
        }

    } else {
        prtw( "WARNING: Can NOT open directory $ind... ($lev)\n" );
    }
}

sub is_zip_ext($) {
    my ($ext) = shift;
    return 1 if (($ext =~ /^\.zip/i)||($ext =~ /^\.gz/i)||($ext =~ /^\.bz2/i)||($ext =~ /^\.tgz/i));
    return 0;
}
sub is_html_ext($) {
    my ($ext) = shift;
    return 1 if (($ext =~ /^\.htm/i)||($ext =~ /^\.html/i));
    return 0;
}
sub is_txt_ext($) {
    my ($ext) = shift;
    return 1 if ($ext =~ /^\.txt/i);
    return 0;
}

sub is_zip_file($) {
    my ($fil) = shift;
    my ($nm,$dir,$ext) = fileparse($fil , qr/\.[^.]*/ );
    return is_zip_ext($ext);
}

sub is_html_file($) {
    my ($fil) = shift;
    my ($nm,$dir,$ext) = fileparse($fil , qr/\.[^.]*/ );
    return is_html_ext($ext);
}

# My particular time 'translation' - replaced date_string
sub YYYYMMDD($) {
   #  0    1    2     3     4    5     6     7     8
   my ($tm) = shift;
    my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($tm);
   $year += 1900;
   $mon += 1;
   my $ymd = "$year/";
   if ($mon < 10) {
      $ymd .= '0'.$mon.'/';
   } else {
      $ymd .= "$mon/";
   }
   if ($mday < 10) {
      $ymd .= '0'.$mday;
   } else {
      $ymd .= "$mday";
   }
   return $ymd;
}

# My particular 'nice number'
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 mycmp_decend_n8 {
   return 1 if (${$a}[8] < ${$b}[8]);
   return -1 if (${$a}[8] > ${$b}[8]);
   return 0;
}
sub mycmp_decend_n7 {
   return 1 if (${$a}[7] < ${$b}[7]);
   return -1 if (${$a}[7] > ${$b}[7]);
   return 0;
}


sub get_html_table_stg($) {
    my ($ra_in) = @_# = \@files_found
    my $ra = $ra_in;
    my @arr = ();
    if ($sort_by_date) {
        @arr = sort mycmp_decend_n8 @{$ra_in};
        $ra = \@arr;
    } elsif ($sort_by_size) {
        @arr = sort mycmp_decend_n7 @{$ra_in};
        $ra = \@arr;
    }
    my $fc = scalar @{$ra};
    my $path = $prefix_path;
    if (length($path)) {
        $path =~ s/\\/\//g; # ensure UNIX type
        $path .= "/" if (!($path =~ /\/$/)); # and a trailing '/'
    }
    prt("Found $md5_count zip files...\n");
    my $html = '';
    my ($lf,$txt,$cnt2);
    $cnt2 = 0;
    for (my $i = 0; $i < $fc; $i++) {
        my $sf  = ${$ra}[$i][5];
        if (${$ra}[$i][2]) {
            # got a zip type
            $cnt2++;
            my $md5 = ${$ra}[$i][3];
            my $dtt = ${$ra}[$i][4];
            my $nn  = ${$ra}[$i][6];

            $lf = (length($path) ? $path.$sf : $sf);
            $txt = '&nbsp;';
            if ($sf =~ /-\d{2}\.zip$/i) {
                $txt = 'Source';
            } elsif ($sf =~ /e\d{2}\.zip$/i) {
                $txt = 'Binary';
            }
            $html .= "<tr>\n";

            # date
            $html .= "<td>";
            # $html .= "$cnt2 $dtt";
            $html .= "$dtt";
            $html .= "</td>\n";

            # link
            $html .= "<td align=\"center\">";
            $html .= "<a href=\"$lf\">$sf</a>";
            $html .= "</td>\n";

            # size
            $html .= "<td align=\"right\">";
            $html .= $nn;
            $html .= "</td>\n";

            if ($add_text_column) {
                # Notes
                $html .= "<td>";
                $html .= $txt;
                $html .= "</td>\n";
            }

            # md4
            $html .= "<td nowrap>";
            if ($use_cn8_span) {
                $html .= "<span class=\"cn8\">$md5</span>";
            } else {
                $html .= "<tt>$md5</tt>";
            }
            $html .= "</td>\n";

            $html .= "</tr>\n";
        }
    }
    return $html;
}

sub is_in_excluded($) {
    my ($fil) = @_;
    my ($nm,$dir) =  fileparse($fil);
    my $wos = ($os =~ /^Win/i) ? 1 : 0;
    $fil = lc($fil) if ($wos);
    $nm = lc($nm) if ($wos);
    foreach my $f (@excluded) {
        $f = lc($f) if ($wos);
        return 1 if (($f eq $fil)||($f eq $nm));
    }
    return 0;
}

sub datetime_to_seconds($) {
    my ($date) = shift;
    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 = timelocal($sec,$min,$hrs,$day,$mth-1,$year); 
        prt( "datatime: $year/$mth/$day $hrs:$min:$sec = $es\n" ) if ($dbg_02);
        return $es;
    } else {
        pgm_exit(1,"ERROR: DateTime passed [$date] FAILED!\n");
    }
    return 0;
}


sub is_zip_text_file($$) {
    my ($fil,$rh) = @_;
    my ($nm,$dir,$ext) = fileparse($fil , qr/\.[^.]*/ );
    my $fnd = 0;
    if (is_txt_ext($ext)) {
        # ok first part OK - ends in .txt
        my ($nm2,$dir2,$ext2) = fileparse($nm , qr/\.[^.]*/ );
        if (is_zip_ext($ext2)) {
            # ok 2nd part OK - ends in .zip (type)
            if (open FIL,"<$fil") {
                my @lines = <FIL>;
                close FIL;
                # got file lines - seek 2 lines
                # MD5 ("fgfs-data-03.zip") = e7500f10c5753614b0f460e556807a94
                # file [fgfs-data-03.zip], of 861,897,303 bytes, dated 2008-11-30 19:23:25 (utc).
                my ($line,$file,$md5,$file2,$nn,$date,$size,$time,$esecs);
                foreach $line (@lines) {
                    chomp $line;
                    if ($line =~ /MD5\s+\((.+)\)\s+=\s+(.+)$/) {
                        $file = strip_quotes($1);
                        $md5  = $2;
                        $fnd |= 1;
                    } elsif ($line =~ /file\s+\[(.+)\],\s+of\s+(.+)\s+bytes,\s+dated\s+([0-9-]+)\s+(\d{2}:\d{2}:\d{2})\s+\(utc\)\./) {
                        $file2 = $1;
                        $nn = $2;
                        $date = $3;
                        $time = $4;
                        $size = $nn;
                        $size =~ s/,//g;
                        $esecs = datetime_to_seconds("$date $time");
                        $fnd |= 2;
                    }
                    last if ($fnd == 3);
                }
                if ($fnd == 3) {
                    if (($file eq $nm)&&($file2 eq $nm)) {
                        ${$rh}{'FILE'} = $file;
                        ${$rh}{'MD5'} = $md5;
                        ${$rh}{'BYTES'} = $nn;
                        ${$rh}{'DATE'} = $date;
                        ${$rh}{'SIZE'} = $size;
                        ${$rh}{'ESECS'} = $esecs;
                        return 1;
                    } else {
                        prtw("WARNING: MD5 names [$file] [$file2] DO NOT MATCH [$fil]\n");
                    }
                } else {
                    prtw("WARNING: Failed find MD5 lines in [$fil]\n");
                }
            } else {
                prtw("WARNING: Failed to open [$fil]\n");
            }
        }
    }
    return 0;
}


sub process_files_found($) {
    my ($ra) = @_# = \@files_found
    my ($fc,$i,$fil,$sf,$sb,$done);
    $fc = scalar @{$ra};
    my $html = '';
    prt("Found total $fc files...\n");
    my %hash = ();
    my $rh = \%hash;
    my ($sz,$md5,$dtt,$nn,$es);
    for ($i = 0; $i < $fc; $i++) {
        $fil = ${$ra}[$i][0];
        $sf = sub_in_folder($fil);
        $done = 0;
        if (is_in_excluded($fil)) {
            $done = 0;
        } else {
            if (is_zip_file($fil)) {
                if ($sb = stat($fil)) {
                    open(FILE, $fil) or mydie( "Can't open '$fil': $!" );
                    binmode(FILE);
                    $md5 = Digest::MD5->new->addfile(*FILE)->hexdigest;
                    close(FILE);
                    $done = 1;
                    $dtt = YYYYMMDD($sb->mtime);
                    $nn = get_nn($sb->size);
                    ${$ra}[$i][2] = 1;
                    ${$ra}[$i][3] = $md5;
                    ${$ra}[$i][4] = $dtt;
                    ${$ra}[$i][5] = $sf;
                    ${$ra}[$i][6] = $nn;
                    ${$ra}[$i][7] = $sb->size;
                    ${$ra}[$i][8] = $sb->mtime;
                    prt("[$dtt] [$sf] [$nn] [$md5]\n");
                    $md5_count++;
                    $total_size += $sb->size;
                } else {
                    prtw("WARNING: stat failed on [$fil]\n");
                }
            } elsif ($inc_text_entries && is_zip_text_file($fil,$rh)) {
                $sf  = ${$rh}{'FILE'};
                $md5 = ${$rh}{'MD5'};
                $dtt = ${$rh}{'DATE'};
                $nn  = ${$rh}{'BYTES'};
                $sz  = ${$rh}{'SIZE'};
                $es  = ${$rh}{'ESECS'};
                ${$ra}[$i][2] = 1;
                ${$ra}[$i][3] = $md5;
                ${$ra}[$i][4] = $dtt;
                ${$ra}[$i][5] = $sf;
                ${$ra}[$i][6] = $nn;
                ${$ra}[$i][7] = $sz;
                ${$ra}[$i][8] = $es;
                prt("[$dtt] [$sf] [$nn] [$md5] (TEXT)\n");
                $md5_count++;
                $total_size += $sz;
                $done = 1;
            } else {
                prt("Not a zip type [$sf]\n") if ($dbg_01);
            }
        }
        if (!$done) {
            ${$ra}[$i][2] = 0;
            ${$ra}[$i][3] = '';
            ${$ra}[$i][4] = '';
            ${$ra}[$i][5] = $sf;
            ${$ra}[$i][6] = '';
            ${$ra}[$i][7] = 0;
            ${$ra}[$i][8] = 0;
        }
    }
    return $html;
}

sub get_head_html($$) {
    my ($tit,$ord) = @_;
    my $hd1 = <<EOF;
<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
"http://www.w3.org/TR/html4/loose.dtd">
<html>
 <head>
  <meta http-equiv="Content-Language"
      content="en-us">
  <meta http-equiv="Content-Type"
      content="text/html; charset=us-ascii">
  <meta name="Author"
      content="Geoff Mclane">
  <meta name="description"
      content="download zip files">
  <meta name="keywords"
      content="geoff, mclane, geoff mclane, programmer, flightgear, flight, simulator, free, source, binaries, WIN32, EXE">
  <meta name="GENERATOR"
      content="Microsoft FrontPage 5.0">
  <meta name="ProgId"
      content="FrontPage.Editor.Document">
  <title>
  $titt
  </title>
  <style type="text/css">
<!-- /* Style Definitions */
  body {
  margin: 0cm 1cm 1cm 1cm;
  background-image:url('$clds_image');
  text-align: justify;
  }
  h1 {
  background:#efefef;
  border-style: solid solid solid solid;
  border-color:#d9e2e2;
  border-width:1px;
  padding:2px 2px 2px 2px;
  font-size:200%;
  text-align:center;
  }
  tt { font-size : x-small }
  .ctr { text-align: center; }
  .cn { font-family : "Courier New"; } 
  .cnsmall { font-family : "Courier New"; font-size:70%; } 
  p.top { 
  margin : 0;
  border-style : none;
  padding : 0;
  text-align : center;
  }
  .cn8 { font-family : "Courier New"; font-size : x-small } 
  hr { margin: 0px; padding: 0px; }
-->
  </style>
 
 </head>
 <body>
  <h1>
   <a name="top"
       id="top"></a>$titt
  </h1>
EOF

    my $hd2a = <<EOF;
  <p class="ctr">
   <a target="_self" href="../index.htm">index</a> 
   <a target="_self" href="#end">end</a>
  </p>
EOF

    my $hd2b = <<EOF;
  <p class="ctr">
   <a target="_self" href="../index.htm">index</a> 
   <a target="_self" href="#alphabetic">alphabetic</a> 
   <a target="_self" href="#end">end</a>
  </p>
EOF

    my $hd3 = <<EOF;
  <p>
   Click on the following links to download the ZIP file. If this fails, try a right button click,
   and in the context menu, left click 'Save Target As...' ...
  </p>

  <p>
   Take due care with downloading and running executables from the web. Do, at least, check the
   MD5 digest after downloading. Older items are exactly that, older versions ... Listing, in a
   table, are $md5_count zips for download, in $ord order ... no warranty given or implied! Just some
   <font color="#FF0000"><b>PERSONAL</b></font> tools ... <font color="#FF0000"><b>USE AT OWN
   RISK</b></font>
  </p>

  <p align="center">
   <font color="red"><b>RUN EXECUTABLES AT YOUR OWN RISK!</b></font>
  </p>

EOF

    my $head = $hd1;
    if ($add_alphabetic) {
        $head .= $hd2b;
    } else {
        $head .= $hd2a;
    }
    $head .= $hd3;
    return $head;
}

sub get_tail_html() {
    my $tail = <<EOF;
 </body>
</html>
EOF
    return $tail;
}

sub get_table_begin() {
    my $table = <<EOF;
<table align="center" border="1" cellpadding="1" cellspacing="2" summary="table of zips">
<tr><th>Date</th><th>Link</th><th>Size</th><th>MD5</th></tr>
EOF

    if ($add_text_column) {
        my $table5 = <<EOF5;
<table align="center" border="1" cellpadding="1" cellspacing="2" summary="table of zips">
<tr><th>Date</th><th>Link</th><th>Size</th><th>Notes</th><th>MD5</th></tr>
EOF5
        return $table5;
    }
    return $table;
}

sub get_top_text() {
    my $top = <<EOF;

  <p class="top">
   <a target="_self"
      href="#top">top</a>
  </p>
  <hr>

EOF
    return $top;
}

sub get_valid_text($) {
    my ($valp) = @_;
    my $valid = <<EOF;

  <p>
   <a name="end"
      id="end"></a> <a target="_blank"
      href="http://tidy.sourceforge.net/"><img border="0"
        src="$valp/checked_by_tidy.gif"
        alt="checked by tidy"
        width="32"
        height="32"></a>&nbsp; <a href="http://validator.w3.org/check?uri=referer"
      target="_blank"><img src="$valp/valid-html401.gif"
        alt="Valid HTML 4.01 Transitional"
        width="88"
        height="31"></a>
  </p>

EOF
    return $valid;
}

# sort A to Z
sub mycmp_decend_n0 {
    my $f1 = lc(${$a}[0]);
    my $f2 = lc(${$b}[0]);
   return 1 if ($f1 gt $f2);
   return -1 if ($f1 lt $f2);
   return 0;
}

# $html .= get_alphabetic_table() if ($add_alphabetic);
sub get_alphabetic_table() {
    my $htm = '';
    my ($ra,$lf,$sf,$md5,$dtt,$nn,$tcnt,$zcnt,$i);
    my $path = $prefix_path;
    if (length($path)) {
        $path =~ s/\\/\//g; # ensure UNIX type
        $path .= "/" if (!($path =~ /\/$/)); # and a trailing '/'
    }
    #                   0
    #push(@files_found,[$fil,$lev,0,0]);
    $tcnt = scalar @files_found;
    $zcnt = 0;
    $ra = \@files_found;
    for ($i = 0; $i < $tcnt; $i++) {
        $zcnt++ if (${$ra}[$i][2]);
    }
    if ($zcnt) {
        my @arr = sort mycmp_decend_n0 @files_found;
        $ra = \@arr;
        my $html = '';
        for ($i = 0; $i < $tcnt; $i++) {
            if (${$ra}[$i][2]) {
                # got a zip type
                $sf  = ${$ra}[$i][5];
                $md5 = ${$ra}[$i][3];
                $dtt = ${$ra}[$i][4];
                $nn  = ${$ra}[$i][6];
                $lf = (length($path) ? $path.$sf : $sf);

                $html .= "<tr>\n";
                # date
                $html .= "<td>";
                $html .= $dtt;
                $html .= "</td>\n";
                # link
                $html .= "<td>";
                $html .= "<a href=\"$lf\">$sf</a>";
                $html .= "</td>\n";
                # size
                $html .= "<td align=\"right\">";
                $html .= $nn;
                $html .= "</td>\n";
                # md4
                $html .= "<td nowrap>";
                $html .= "<tt>$md5</tt>";
                $html .= "</td>\n";

                $html .= "</tr>\n";
            }
        }
        $htm .= get_top_text();
        $htm .= "<a name=\"alphabetic\"></a>\n";
        $htm .= "<p><b>Table in alphabetic order, ignoring case...</b></p>\n";
        $htm .= get_table_begin();
        $htm .= $html;
        $htm .= "</table>\n";
        $htm .= "<p>Total of $zcnt files, ".get_nn($total_size)." bytes.</p>\n";
    }
    return $htm;
}


sub write_html($$) {
    my ($htm,$out) = @_;
    my $ord = ($sort_by_date ? "DATE" : ($sort_by_size ? "SIZE" : "DIRECTOR"));
    my $tim = YYYYMMDD(time());
    my $tit = "Table of ZIPS $tim";

    # dump a short version
    my $html = get_table_begin();
    $html .= $htm;
    $html .= "</table>\n";
    prt("$html\n") if (VERB5());
    # now the FULL file
    $html = get_head_html($tit,$ord);
    $html .= get_table_begin();
    $html .= $htm;
    $html .= "</table>\n";
    $html .= "<p>Total of $md5_count files, ".get_nn($total_size)." bytes.</p>\n";
    # Add alphabetic table
    $html .= get_alphabetic_table() if ($add_alphabetic);
    $html .= get_top_text();
    $html .= get_valid_text($image_path);
    $html .= "  <!-- $tim - geoffair.org - generated by $pgmname -->\n";
    $html .= get_tail_html();
    write2file($html,$out);
    prt( "Written to [$out]...\n");
    if ($load_browser) {
        if (is_html_file($out)) {
            system($out);
        } else {
            prt("Does not appear to have HTML extension, so [$out] not loaded\n");
        }
    }
}

#########################################
### MAIN ###
#prt( "$pgmname: in [$cwd]: Hello, World...\n" );
parse_args(@ARGV);
check_in_directory($in_directory);
process_dir($in_directory,0);
process_files_found(\@files_found);
my $html_text = get_html_table_stg(\@files_found);
write_html($html_text,$out_file);
pgm_exit(0,"");
########################################

sub give_help {
    prt("$pgmname: version $VERS\n");
    prt("Usage: $pgmname [options] input_folder\n");
    prt("Options:\n");
    prt(" --help    (-h or -?) = This help and exit(0)\n");
    prt(" --alpha         (-a) = Add alphabetic table below date table.\n");
    prt(" --browser       (-b) = Set to load browser at end. (def=$load_browser)\n");
    prt(" --load          (-l) = Set to load log at end. (def=$load_log)\n");
    prt(" --out <file>    (-o) = Set output file name. (def=$out_file)\n");
    prt(" --prefix <path> (-p) = Add this prefix path to each file.\n");
#    prt(" --sort DSN      (-s) = Sort by Date (default), Size, or None\n");
    prt(" --text          (-t) = Add text column - if conforms project02[-|e]nn.zip use Source/Binary else &nbsp;.\n");
    prt(" --verb[n]       (-v) = Bump or set verbosity. def=$verbosity\n");
    prt(" --xclude <f>    (-x) = Exclude file 'f' from table.\n");
    prt("Purpose: Scan a directory finding zip files, and generating\n");
    prt(" a HTML table with date, link, size, MD5 columns, in date order rows.\n");
}

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

sub parse_args {
    my (@av) = @_;
    my ($arg,$sarg);
    while (@av) {
        $arg = $av[0];
        if ($arg =~ /^-/) {
            my $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 =~ /^a/i) {
                $add_alphabetic = 1;
                prt("Set to add alphabetic (nocase) table.\n");
            } elsif ($sarg =~ /^o/i) {
                # output file
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $out_file = $sarg;
                prt("Set out file to [$out_file]\n");
            } elsif ($sarg =~ /^l/i) {
                $load_log = 1;
                prt("Set to load log at end.\n");
            } elsif ($sarg =~ /^b/i) {
                $load_browser = 1;
                prt("Set to load browser at end.\n");
            } elsif ($sarg =~ /^x/i) {
                # exclude file
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                push(@excluded,$sarg);
                prt("Added [$sarg] to excluded files...\n");
            } elsif ($sarg =~ /^p/i) {
                # prefix path
                need_arg(@av);
                shift @av;
                $sarg = $av[0];
                $prefix_path = $sarg;
                prt("Set [$sarg] as prefix path...\n");
            } elsif ($sarg =~ /^t/i) {
                $add_text_column = 1;
                prt("Set to add text column.\n");
            } elsif ($sarg =~ /^v/i) {
                if ($sarg =~ /^v.*(\d+)$/i) {
                    $verbosity = $1;
                } else {
                    while ($sarg =~ /^v/i) {
                        $verbosity++;
                        $sarg = substr($sarg,1);
                    }
                }
                prt("Set to verbosity to $verbosity.\n");
            } else {
                pgm_exit(1,"ERROR: Unknown argument! Try -?\n");
            }
        } else {
            $in_directory = $arg;
            prt("Set input directory to [$in_directory]\n");
        }
        shift @av;
    }
    if (length($in_directory) == 0) {
        if ($debug_on && (-d $def_dir)) {
            $in_directory = $def_dir;
            prt("Set input directory to DEFAULT [$in_directory]\n");
        } else {
            pgm_exit(1,"ERROR: No input directory given... aborting...\n");
        }
    } elsif ( ! -d $in_directory ) {
        pgm_exit(1,"ERROR: Input directory [$in_directory] NOT VALID!... aborting...\n");
    }
}

# eof - zipindex04.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional