#!/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
