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