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