Generated: Tue Feb 2 17:54:22 2010 from bldtable.pl 2007/08/28 11.4 KB.
#!/Perl # NAME: bldtable.pl # AIM: Build a link table to ZIP files, in a specific directory # 27/08/2007 - some enhancements # (a) Get the LIST of ZIP files from a FOLDER # 30/07/2006 - geoff mclane - geoffair.net/fg use strict; use warnings; use File::Basename; use File::stat; use Digest::MD5 qw(md5 md5_hex md5_base64); require "logfile.pl" or die "Missing logfile.pl ...\n"; # my simple log file and some other utility subs require "relative.pl" or die "Missing relative.pl ...\n"; # given target, and from get ralative # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = "temp.$pgmname.txt"; open_log($outfile); prt( "$pgmname ... Hello, World...\n" ); my ($OH); # out handle my $dbg_on1 = 0; # seek the ZIP files in here my $in_zips = "C:\\HOMEPAGE\\GA\\fg\\zips"; # seek the reference files in here my $in_dir = "C:\\HOMEPAGE\\GA\\fg\\"; ###my $in_dir = "C:\\HOMEPAGE\\P26\\fg\\"; my $htm_out = "tempdown.htm"; my $in_path = $in_dir; my $desc_file = 'bldtable.csv'; my @excludes = qw( fgfsdown.htm download.htm ); my @zipfiles = (); my @descrip = (); my @mths = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec); my $zcnt = 0; my $file = ""; my $file2 = ""; my $dir = ""; my $ff = ""; my @found = (); my @references = (); # references offset my $re_zip = 0; my $re_ref = 0; my $lncnt = 0; my $tcnt = scalar @found; my $i = 0; my $fnd = 0; my $f_fnd = ""; my $f_in = ""; my $prt_table = 1; # do the HTML output my ($fnm, $fdir, $fext); my $rel_path = get_relative_path( $in_zips, $in_dir ); my @warnings = (); my $msg = ''; # debug my $dbg1 = 0; # show desciptions my $dbg2 = 0; # show duplicate discards my $dbg3 = 0; # add HTML lines to log my $dbg4 = 0; # show found # Get ZIP FILE LIST (from folder) get_zip_files( $in_zips ); $zcnt = scalar @zipfiles; # load the DESCRIPTIONS load_descriptions( $desc_file ); # seek reference file get_reference_files( $in_dir ); $tcnt = scalar @found; modify_references(); check_for_missing(); # output HTML file output_htm_file($htm_out); if (@warnings) { prt( "List of ".scalar @warnings." messages ...\n" ); foreach my $line (@warnings) { prt( "$line\n" ); } } system( $htm_out ) if ($prt_table); close_log($outfile,1); exit(0); sub prth { my ($m) = shift; prt($m) if ($dbg3); print $OH "$m"; } sub get_description { my ($f) = shift; my $ct = scalar @descrip; my $i2 = 0; my $m = ''; for ($i2 = 0; $i2 < $ct; $i2++) { if ($descrip[$i2][0] eq $f) { return $descrip[$i2][1]; } } $m = "WARNING: NO DESCRIPTION FOUND for file [$f] ... fix [$desc_file] ..."; prt( "$m\n" ); push(@warnings, $m); return "*** NO DESCRIPTION FOUND ***"; } sub date_string { my ($tm) = shift; my @arr = split( / /, $tm ); # time of form 'Sat Mar 12 03:11:55 2005' my $ac = scalar @arr; my $doff = 2; my $yoff = 4; if ($ac == 5) { $doff = 2; $yoff = 4; } elsif ($ac == 6) { $doff = 3; $yoff = 5; } else { mydie( "ERROR: Time ($tm) did NOT split correctly!\n" ); } my $mn = mth_to_num( $arr[1] ); if ($mn < 10) { $mn = '0'.$mn; } my $dn = $arr[$doff]; if ($dn < 10) { $dn = '0'.$dn; } my $dtt = $arr[$yoff].'/'.$mn.'/'.$dn; # translated to 2005/03/12 return $dtt; } ## month to number sub mth_to_num { my ($mth) = shift; my $ct = 0; ###prt( "Chk [$mth] " ); foreach my $m (@mths) { $ct++; if ($m eq $mth) { ###prt( "Is $m - return $ct\n" ); return $ct; } } prt( "WARNING: Returning 0!!!\n" ); return '??'; } sub get_zip_files { my ($inz) = shift; prt( "Processing [$inz] for ZIP files ... relative [$rel_path] ...\n" ); if (opendir( ID, $inz) ) { my @dirfils = readdir(ID); closedir ID; foreach $file (@dirfils) { next if ($file eq '.'); next if ($file eq '..'); ($fnm,$fdir,$fext) = fileparse( $file, qr/\.[^.]*/ ); next if (lc($fext) ne '.zip'); push(@zipfiles, $file); } $zcnt = scalar @zipfiles; prt( "Found $zcnt ZIP files ...\n" ); } else { mydie("ERROR: failed to OPEN directory [$in_zips] ... $! ...\n" ); } if (!$zcnt) { mydie("ERROR: FAILED to load any files from [$in_zips] ...\n"); } } # load the DESCRIPTIONS sub load_descriptions { my ($df) = shift; # = $desc_file prt( "Load DESCRIPTION file [$df] ...\n" ); if (open INF, "<$df") { my @arr = <INF>; close INF; foreach my $ln (@arr) { chomp $ln; my @arr2 = split(',',$ln); my $acnt = scalar @arr2; if (($acnt > 2)&&(substr($arr2[1],0,1) eq '"')) { my $nd = substr($arr2[1],1); for (my $j = 2; $j < $acnt; $j++) { $nd .= ','; $nd .= $arr2[$j]; } $nd =~ s/"$//; $arr2[1] = $nd; $acnt = 2; } if ($acnt == 2) { push(@descrip, [ $arr2[0], $arr2[1] ] ); prt( "push(\@descrip, [ $arr2[0], $arr2[1] ] );\n" ) if ($dbg1); } else { prt( "Got LINE [$ln] ...\n" ); mydie( "ERROR IN CSV FILES ...\n" ); } } } else { $msg = "WARNING: FAILED to load descriptions from [$df] ..."; prt( "$msg\n" ); push(@warnings,$msg); } } # $references[$r][1] = add_if_missing($references[$r][1], $file); sub add_if_missing { my ($refs, $fil) = @_; if ($refs =~ /$fil/) { return $refs; } return ($refs.'|'.$fil); } sub in_exclude { my ($fil) = shift; foreach my $f (@excludes) { if ($f eq $fil) { return 1; } } return 0; } # seek reference files for ZIPS # Each ZIP can have several REFERENCES sub get_reference_files { my ($ind) = shift; # = $in_dir prt( "Processing [$ind] for REFERENCE files ...\n" ); opendir DIR, $ind or mydie("ERROR: Failed to open directory $ind ...\n"); my @dfiles = readdir(DIR); closedir DIR; foreach $file (@dfiles) { next if ($file eq '.'); next if ($file eq '..'); next if in_exclude($file); # eq 'download.htm' or 'fgfsdown.htm'); ($fnm,$fdir,$fext) = fileparse( $file, qr/\.[^.]*/ ); next if (lc($fext) ne '.htm'); $ff = $ind . $file; if ( -f $ff ) { # open EACH HTM file open FH, "<$ff" or mydie("ERROR: Unable to open $ff ...\n"); my @lines = <FH>; # slurp it all in close FH; $lncnt = 0; foreach my $line (@lines) { chomp $line; $lncnt++; foreach $file2 (@zipfiles) { # extract EACH ZIP file if ($line =~ /$file2/) { ###prt( "Found $file2 in $file ...\n" ); my $ncnt = scalar @found; $fnd = 0; for ($i = 0; $i < $ncnt; $i++) { $f_fnd = $found[$i][0]; $f_in = $found[$i][1]; if (($f_fnd eq $file2) && ($f_in eq $file)) { $fnd = 1; last; } } my $rcnt = scalar @references; my $fnd2 = 0; my $r = 0; for (; $r < $rcnt; $r++) { my $z_fnd = $references[$r][0]; if ($z_fnd eq $file2) { $fnd2 = 1; last; } } if ($fnd2) { $references[$r][1] = add_if_missing($references[$r][1], $file); } else { push(@references, [ $file2, $file ]); } if ($fnd) { prt( "Discarding duplicate $file2 in $file ...\n" ) if ($dbg2); } else { prt( "Found $file2 in $file ...\n" ) if ($dbg4); push(@found, [$file2, $file]); } } } } } else { prt( "WARNING: Skipping directory entry $file ...\n" ); } } } sub check_for_missing { my $missed = 0; my $ok = 0; prt( "Got $tcnt in \@found ... of $zcnt file ... Checking for MISSING finds ...\n" ); foreach $file (@zipfiles) { $fnd = 0; for ($i = 0; $i < $tcnt ; $i++) { $f_fnd = $found[$i][0]; $f_in = $found[$i][1]; if ($f_fnd eq $file) { $fnd = 1; last; } } if ($fnd) { # skip this $ok++; } else { $msg = "WARNING: NOT FOUND [$file]"; prt( "$msg\n" ); push(@warnings,$msg); $missed++; } } prt( "Checked $tcnt, missed $missed, found $ok ...\n" ); } sub modify_references { my $rcnt = scalar @references; for (my $r = 0; $r < $rcnt; $r++) { my $z_fil = $references[$r][0]; my $z_ref = $references[$r][1]; prt( "$z_fil in [$z_ref]\n" ); my @arr = split(/\|/, $z_ref); my $nr = ''; foreach my $r (@arr) { if ($r =~ /fgfs-\d{3}\.htm/) { $nr .= '|' if (length($nr)); $nr .= $r; } } if (length($nr)) { $references[$r][1] = $nr; prt( "Modified to [$nr]\n" ); } } } sub out_htm_head { my ($hf) = shift; print $hf <<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"> <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1"> <meta name="Generator" content="EditPlus"> <meta name="Author" content="Geoff McLane"> <meta name="Keywords" content=""> <meta name="Description" content=""> <title> FlightGear Available Downloads </title> <link rel="stylesheet" type="text/css" href="fgcode.css"> <script type="text/javascript" src="qlfgmenu.js"></script> <style type="text/css"> <!-- /* Style Definitions */ .smlffnt { font-family:"Courier New"; font-size : small; } --> </style> </head> <body> <h1>FlightGear Available Downloads</h1> <p>Table of Downloads - <br> EOF } sub out_htm_tail { my ( $fh ) = shift; $msg = "<!-- generated by $pgmname on ". localtime(time()) . " -->\n"; print $fh <<EOF; <p>End of download list</p> <script type="text/javascript"><!-- QuickLinks(); ModifiedDate(); // --></script> $msg <!-- P26.2006.07.30 - initial file --> </body> </html> EOF } sub output_htm_file { my ($htm) = shift; if (!$prt_table) { return; } open $OH, ">$htm" or mydie("ERROR: Can not create $htm ... $! ...\n"); out_htm_head( $OH ); prth( "<table border=\"1\" align=\"center\" summery=\"Table of downloads\">\n" ); ###prth( "<caption><b>Table of Downloads</b></caption>\n" ); prth( " <tr>\n" ); prth( " <th>Date</th>\n" ); prth( " <th>Download</th>\n" ); prth( " <th>Web Page</th>\n" ); prth( " <th>Description</th>\n" ); prth( " <th>MD5 Digest</th>\n" ); prth( " </tr>\n" ); foreach $file (@zipfiles) { $fnd = 0; ###my $ff2 = $in_dir.$file; my $ff2 = $in_zips.'/'.$file; for ($i = 0; $i < $tcnt ; $i++) { $f_fnd = $found[$i][0]; $f_in = $found[$i][1]; if ($f_fnd eq $file) { $fnd = 1; last; } } if ($fnd) { prth( " <tr>\n" ); my $sb = stat($ff2) or mydie( "ERROR: Unable to 'stat' file [$ff2]?\n" ); my $tm = scalar localtime $sb->mtime; my $dtt = date_string($tm); my $desc = get_description( $file ); open(FILE, $ff2) or mydie( "Can't open '$file': $!" ); binmode(FILE); my $md5 = Digest::MD5->new->addfile(*FILE)->hexdigest; close(FILE); prth( " <td>$dtt</td>\n" ); prth( " <td nowrap>\n" ); prth( " <a href=\"" ); $ff = $rel_path.$f_fnd; prth( "$ff" ); prth( "\">" ); prth( "$f_fnd</a>\n" ); prth( " </td>\n" ); ##$ff = $in_path.$f_in; $ff = $f_in; prth( " <td nowrap><a href=\"$ff\" target=\"_blank\">$f_in</a></td>\n" ); prth( " <td>$desc</td>\n" ); prth( " <td nowrap><span class=\"smlffnt\">$md5</span></td>\n" ); prth( " </tr>\n" ); } else { $msg = "WARNING: NOT FOUND [$file]"; prt( "$msg\n" ); push(@warnings,$msg); } } prth( "</table>\n" ); out_htm_tail( $OH ); close $OH; } # eof - bldtable.pl