zipindex02.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:55:02 2010 from zipindex02.pl 2007/01/27 8.4 KB.

#!/Perl
# AIM: To read the INPUT directory, and generate a HTML file
# to allow down load of all the ZIPS files found there ...
# 20070127 - fix for get_nn only
use strict;
use Digest::MD5  qw(md5 md5_hex md5_base64);
use File::stat; # to get the file date
require 'logfile.pl' or die "ERROE: Can NOT load logfile.pl ...\n";
# log file stuff
my ($LF);
my $outfile = 'temp'.$0.'.txt';
open_log($outfile);
prt( "$0 ... Hello, World ...\n" );
my $verbose = 1;
my $verb2 = 1;
##my $my_folder = 'C:\HOMEPAGE\Max5\zips';
my $my_folder = 'C:\HOMEPAGE\P26\fg';
##my $my_folder = shift || die "Must input a FOLDER name ...\n";
my @dirs = ($my_folder); # folders to process
my $m_doctype = '<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"'."\n".
'"http://www.w3.org/TR/html4/loose.dtd">';
my @dir_obj = (); # start with NONE
# add time, file, size, md5
my @dir_obj2 = ();
my @dir_objs = ();
my $do_cnt = 0;
my $htm_fil = shift || 'zipindex.htm';
my $HF;
my $d;
my $msg = '';
my $verb3 = 0;
open $HF, ">$htm_fil" or mydie( "Can NOT open HTML file $htm_fil!\n" );
while ( scalar @dirs ) {
   my @dirs2 = @dirs;
   @dirs = ();
   my $dir;
   foreach $dir (@dirs2) {
      prt( '.' ) if !$verb2;
      process_dir($dir);
   }
   prt( "\n" ) if !$verb2;
}
$do_cnt = scalar @dir_obj;
@dir_objs = sort mycmp_decend @dir_obj2;
if ($do_cnt) {
   prt( "Found $do_cnt zips ...\n" );
   add_htm_head($HF, 'Zip File Listing');
   print $HF "<p>Click on the following links to download the ZIP file. Some are source files, and \n";
   print $HF "some are WIN32 EXE files. Take due care with downloading and running executables from \n";
   print $HF "the web. Do, at least, check the MD5 digest after downloading. Older items may no longer \n";
   print $HF "be valid with current FlightGear data ...<br>\n";
   print $HF "<font color=\"red\"><b>RUN EXECUTABLES AT YOUR OWN RISK!</b></font><br>\n";
   print $HF "Listing, in a table, $do_cnt zips for download, in date order ...</p>\n";
   print $HF "<p align=\"center\">\n";
   print $HF "<table border=\"1\" summary=\"List of downloadable zips\">\n";
   print $HF "<tr>\n";
   print $HF "<th>Date</th>\n";
   print $HF "<th>Zip</th>\n";
   print $HF "<th>Size(bytes)</th>\n";
   print $HF "<th>Md5</th>\n";
   print $HF "</tr>\n";
   for (my $i = 0; $i < $do_cnt; $i++) {
      # added time, file, size, md5
      my $dt = YYYYMMDD( $dir_objs[$i][0] );
      my $sn = subactdir( $dir_objs[$i][1] );
      my $sz = get_nn( $dir_objs[$i][2] );
      my $m5 = $dir_objs[$i][3];
      ###print $HF "$dt $sn $sz $m5<br>\n";
      print $HF "<tr>\n";
      print $HF "<td align=\"left\">$dt</td>\n";
      print $HF "<td align=\"left\"><a href=\"$sn\">$sn</a></td>\n";
      print $HF "<td align=\"right\">$sz</td>\n";
      print $HF "<td align=\"left\" nowrap><tt>$m5</tt></td>\n";
      print $HF "</tr>\n";
   }
   print $HF "</table>\n";
   print $HF "<p align=\"center\">Simple alphabetic list<br>| \n";
   foreach $d (sort @dir_obj) {
      $msg = "<a href=\"$d\">$d</a>";
      print $HF "$msg | \n";
   }
   print $HF "</p>\n";
   print $HF "<p class=\"ctr\"><font color=\"red\"><b>RUN EXECUTABLES AT YOUR OWN RISK!</b></font><\p>\n";
   add_htm_tail($HF, "<!-- P26.2006.09.07 geoff mclane - generated by $0 -->");
   close ($HF);
   system $htm_fil;
} else {
   prt( "WARNING: No zips found ...\n" );
}
close_log($outfile,1);
exit(0);
##################################
# end of program
#################################
### only subs below
#################################
sub add_htm_head {
   my ($fh, $tit) = @_;
   print $fh "$m_doctype\n";
   print $fh <<EOF;
<html>
<head>
<meta http-equiv="Content-Language" content="en-gb">
<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
<meta name="Author" content="Geoff Mclane">
<meta name="description" content="downloadable zip files">
<meta name="keywords" content="flightgear, flight, simulator, free, source, binaries, WIN32">
<title>$tit</title>
<style type="text/css">
<!-- /* Style Definitions */
body {
    margin: 0cm 1cm 0cm 1cm;
   background-image:url('clds5.jpg');
}
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;
}
.ctr { text-align: center; }
-->
</style>
</head>
<body>
<h1>$tit</h1>
<p class="ctr"><a href="index.htm">index</a></p>
EOF
}
sub add_htm_tail {
   my ($fh, $tit) = @_;
   print $fh <<EOF;
<p class="ctr"><a href="index.htm">index</a></p>
<p>
<a href="http://validator.w3.org/check?uri=referer">
<img src="valid-html401.gif" alt="Valid HTML 4.01 Transitional" width="88" height="31">
</a>
</p>
</body>
</html>
$tit
EOF
}
sub process_dir {
   my ($in_folder) = @_;
   prt( "Processing folder $in_folder ...\n" ) if $verb2;
   if( !( -d $in_folder ) ) {
      prt( "Folder $in_folder is NOT a directory! ... aborting ...\n" ) if $verbose;
      return 0;
   }
   if (! opendir(DIRH, $in_folder) ) {
      prt( "ERROR: Can NOT open directory $in_folder ... aborting ...\n" ) if $verbose;
      return 0;
   }
   my @files = readdir(DIRH);
   closedir(DIRH);
   my $fcnt = scalar @files;
   if ((! @files) || ($fcnt < 3)) {
      prt( "No files found in folder $in_folder ...\n" ) if $verb2;
      return 0;
   }
   my ($fn, $ffn);
   my $got_obj = 0;
   prt( "Found $fcnt items in folder ...\n" ) if $verb2;
   $got_obj = 0;
   foreach $fn (@files) {
      if ($in_folder eq '.') {
         $ffn = $fn;
      } else {
         $ffn = $in_folder . '\\' . $fn;
      }
      if ( -d $ffn ) {
         if (($fn eq '.') || ($fn eq '..')) {
            # do nothing
         } else {
            # do nothing
            ###push(@dirs, $ffn);
            ###print "Sub-directory $ffn ...\n" if $verb2;
         }
      } else {
         if ( $fn =~ /\.zip$/i) {
            my $sb = stat($ffn);
            open(FILE, $ffn) or mydie( "Can't open '$ffn': $!" );
            binmode(FILE);
            my $md5 = Digest::MD5->new->addfile(*FILE)->hexdigest;
            close(FILE);
            my $dtt = YYYYMMDD($sb->mtime);
            my $sn = subactdir($ffn);
            prt( "ZIP File [$ffn][$sn] ... ".$sb->size." bytes ... [$md5] [$dtt]\n" ) if $verb2;
            $got_obj++;
            push(@dir_obj, $sn);
            push(@dir_obj2, [ $sb->mtime, $ffn, $sb->size, $md5 ]);
         } else {
            prt( "File $ffn ...\n" ) if $verb2;
         }
      }
   }
   my $dcnt = scalar @dirs;
   if ($got_obj) {
      prt( "Found $got_obj zips in folder ...\n" ) if $verb2;
   } else {
      prt( "Found NO zipd in folder ...\n" ) if $verb2;
   }
   if ($dcnt) {
      prt( "Found $dcnt directories to process ...\n" ) if $verb2;
   }
}
################################################
# 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;
}
sub dos_2_unix($) {
   my ($du) = shift;
   $du =~ s/\\/\//g;
   return $du;
}
# sub root folder from full name
sub subactdir($) {
   my ($d) = shift;
   my $rt = dos_2_unix($my_folder);
   $d = dos_2_unix($d);
   $d =~ s,^$rt,,;
   if (length($d)) {
      $d =~ s,^/,,;
   }
   return $d;
}
# put least first
sub mycmp_ascend {
   if (${$a}[0] < ${$b}[0]) {
      prt( "-[".${$a}[0]."] < [".${$b}[0]."]\n" ) if $verb3;
      return -1;
   }
   if (${$a}[0] > ${$b}[0]) {
      prt( "+[".${$a}[0]."] < [".${$b}[0]."]\n" ) if $verb3;
      return 1;
   }
   prt( "=[".${$a}[0]."] < [".${$b}[0]."]\n" ) if $verb3;
   return 0;
}
sub mycmp_decend {
   if (${$a}[0] < ${$b}[0]) {
      prt( "+[".${$a}[0]."] < [".${$b}[0]."]\n" ) if $verb3;
      return 1;
   }
   if (${$a}[0] > ${$b}[0]) {
      prt( "-[".${$a}[0]."] < [".${$b}[0]."]\n" ) if $verb3;
      return -1;
   }
   prt( "=[".${$a}[0]."] < [".${$b}[0]."]\n" ) if $verb3;
   return 0;
}
##################################################
# 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;
}
# eof - zipindex.pl

index -|- top

checked by tidy  Valid HTML 4.01 Transitional