Generated: Tue Feb 2 17:55:02 2010 from zipindex03.pl 2008/05/27 41.4 KB.
#!/Perl # NAME: zipindex03.pl # AIM: To read the INPUT directory, and generate a HTML file - a zip index - # to allow down load of all the ZIPS files found there ... # 21/04/2008 - Add a $very_simple flag to do JUST the zip list, w/o javascript # 08/01/2008 - Put the information javascript into an external file # 19/08/2007 - Make more general than 'my' source zips, with $add_desc, $msvc_list, and # add $add_mo_2 to do onmouseover on (reversed) alphabetic list. # 09/06/2007 - update: either remote (depreciated) or local linking # # Also generates a javascript for showing all the files in the zip # Description may have to be added for NEW items, but existing items, # the description will come from zipdesc.txt ... # and a zipexclude.txt for excluded files ... # 20070127 - Add generation of a 'remote' index, similar to the 'local' index, # except all the links refer back to macpcfirstaid.com/zips site ... enable $writefil2, # and set $def_html2 and $remlink (depreciated) # and fixed get_nn() ... # ************************************************************************************* # NOTE WELL: the sub get_zip_text($zipfile) uses MY PERSONAL zip8.bat to get CONTENTS # NOTE WELL: This is MY zip listing BAT file, using the WINZIP # NOTE WELL: command line interface. THIS MUST BE ADJUSTED TO GET EQUIVALENT RESULTS!!! # ************************************************************************************* # geoff mclane - http://geoffair.net - 27 January, 2007 use strict; use Digest::MD5 qw(md5 md5_hex md5_base64); use File::stat; # to get the file date and size use File::Basename; require 'logfile.pl' or die "ERROR: Can NOT load logfile.pl ...\n"; # log file stuff my ($LF); my $pgmname = $0; if ($pgmname =~ /\w{1}:\\.*/) { my @tmpsp = split(/\\/,$pgmname); $pgmname = $tmpsp[-1]; } my $outfile = "temp.$pgmname.txt"; my $htm_folder = 'C:\HOMEPAGE\GA\unix'; my $my_folder = $htm_folder.'\zips'; my $rel_folder = 'zips/'; # if any relative folder to add #my $htm_folder = 'C:\HOMEPAGE\GA\fg'; #my $my_folder = $htm_folder.'\zips'; #my $my_folder = $htm_folder.'\zips\atlas01'; #my $my_folder = $htm_folder.'\zips\srcs'; #my $htm_folder = 'C:\HOMEPAGE\GA\ms'; #my $htm_folder = 'C:\HOMEPAGE\GA\tidy'; #my $my_folder = $htm_folder.'\zips'; ##my $my_folder = 'C:\HOMEPAGE\GA\ms\zips'; ##my $my_folder = 'C:\HOMEPAGE\Max5\zips'; ##my $my_folder = 'C:\HOMEPAGE\P26\fg'; ##my $rel_folder = 'zips/'; # if any relative folder to add # features ############################################################################# my $very_simple = 1; # just the actual zip list, no mouseover, no javascript my $excl_vcslns = 0; # exclude all vc[n]xxx[nn].zip my $add_desc = 0; # add a DESCRIPTION column, taking text from following my $descfile = 'zipdesc.txt'; my $msvc_list = 0; # add MSVC explanation, and split file name my $add_mo_2 = 1; # add onMouseOver javascript to ALPHABETIC list my $no_pre = 1; # do NOT use PRE - align with , and use Courier New ... my $add_ref = 1; # Search HTM files in $htm_folder, for references to this ZIP my $remlink = ''; #my $remlink = 'http://macpcfirstaid.com/zips/'; my $writefil2 = 0; # set to write the 2nd file (depreciated) my $addconttbl = 1; # add a contents table ... my $tryfulltxt = 1; # add full ZIP text - this works well, especially with $no_pre above my $extjsfile = 1; # 08/01/2008 - write to EXTERNAL js file - ziplist??.js my $use_full_zl = 0; # 0 = just the file name my $def_html1 = 'tempind01.htm'; my $def_html2 = 'tempind02.htm'; my $firstzlf = 'tempziplst01.js'; my $bm_do = "dateordertbl"; my $bm_ct = "contenttbl"; my $bm_ab = "alphabetic"; my $bm_dateorder = "<a name=\"$bm_do\"\n id=\"$bm_do\"></a>\n"; my $bm_content = "<a name=\"$bm_ct\"\n id=\"$bm_ct\"></a>\n"; my $bm_alphabetic = "<a name=\"$bm_ab\"\n id=\"$bm_ab\"></a>\n"; my $max_cell_cont = (90 * 12); my $m_doctype = '<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"'."\n". '"http://www.w3.org/TR/html4/loose.dtd">'; open_log($outfile); ##prt( "$pgmname ... Hello, World ...\n" ); # DEBUG ITEMS my $dbg0 = 0; # load log file my $verbose = 0; my $verb2 = 0; my $verb3 = 0; my $dbg1 = 0; # show getting DESCRIPTIONS my $dbg2 = 0; # show ZIP contents ... my $dbg3 = 1; # load HTM file ... my $dbg4 = 0; # show the exclude checking ... my $dbg5 = 0; # show description list ... my $dbg6 = 0; # show more on decription ... my $dbg7 = 0; # show description found ... my $dbg8 = 0; # show zip content text ... my $dbg9 = 0; # show zip content text being processed ... my $dbg10 = 0; # show line split count ... my $dbg11 = 0; # show function line added ... my $dbg12 = 0; # show discard ZL from function ... my $dbg13 = 0; # load 2nd (remote) HTM file ... # program variables my @descrips = (); my @desclist = (); # list of descriptions added my @lines = (); my $line = ''; my $filename = ''; my $filesrc = ''; my $fileexe = ''; my $lncnt = 0; my @warnings = (); my $desc = ''; my @excluded = (); ###my @excluded = qw( vc8sln03.zip vc8sln02.zip vc8sln01.zip ###fgvc8rt03.zip fgvc8rt02.zip fgvc8rt01.zip img.zip ); my @dirs = ($my_folder); # folders to process # program variables my @dir_obj = (); # start with NONE # add time, file, size, md5 my @dir_obj2 = (); # accumulated list my @dir_objs = (); # sorted list my $do_cnt = 0; my $htm_fil = shift || $def_html1; my $htm_fil2 = $def_html2; my ($HF1, $HF2); my $msg = ''; my @zip_list = (); if ($add_desc) { get_desc_txt(); $lncnt = scalar @descrips; if ($lncnt) { prt( "Got $lncnt descriptions ...\n" ); # close_log($outfile,1); # exit(0); } else { prt( "FAILED to find any descriptions ...\n" ); # close_log($outfile,1); # exit(1); } } open $HF1, ">$htm_fil" or mydie( "Can NOT open HTML file $htm_fil!\n" ); if ($writefil2) { open $HF2, ">$htm_fil2" or mydie( "Can NOT open HTML file $htm_fil2!\n" ); } while ( scalar @dirs ) { my @dirs2 = @dirs; @dirs = (); my $dir; foreach $dir (@dirs2) { ### prt( '.' ) if !$verb2; process_dir($dir); get_zip_list( $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" ); post_processing(); # add item(s) to @dir_objs, which is a SORTED version of @dir_obj2 ... write_html($HF1, 0); # with NO 'remote' link prt( "Written $htm_fil ...\n" ); if ($writefil2) { @desclist = (); write_html($HF2, 1); # with REMOTE link prt( "Written $htm_fil2 ...\n" ); } } else { prt( "WARNING: No zips found ...\n" ); } # clean up close ($HF1); system $htm_fil if ($dbg3); if ($writefil2) { close ($HF2); system $htm_fil2 if ($dbg13); } $lncnt = scalar @warnings; if ($lncnt) { prt( "NOTE: Got following $lncnt warnings ...\n" ); foreach $line (@warnings) { prt($line); } } show_descriptions() if ($dbg5); close_log($outfile,$dbg0); exit(0); ################################## # end of program ################################# ### only subs below ################################# # seek ar particular file name in @dir_objs, # and return its mouse over text, if any. sub get_mo_from_dir_objs { my ($fn) = shift; for (my $j = 0; $j < $do_cnt; $j++) { my $zln = subactdir( $dir_objs[$j][1] ); if ($zln eq $fn) { return $dir_objs[$j][7]; # return the OnMouseOver display function } } return ''; } # seek through the LIST of file given, in $htm_folder # finding this particular file name. # Return string, with file names separted by /<br>/ if more than one. sub find_refs { my ($f, $rf, @refs) = @_; my @lines = (); my ($rff, $line); my $infs = ''; foreach $rff (@refs) { if (open(INF, "<$rff")) { @lines = <INF>; close INF; foreach $line (@lines) { if ($line =~ /$f/) { $infs .= '<br>' if (length($infs)); $infs .= $rf.subhtmdir($rff); last; } } } } return $infs; } # give a string from the above sub, find_refs, # split it on /<br>/ and build a HREF string # using only the file name as text. sub get_href_ref_string { my ($rs) = shift; my $rrs = ''; my @arr = split(/<br>/, $rs); my $sz = scalar @arr; foreach my $r (@arr) { my ($rf, $rd) = fileparse($r); $rrs .= '<br>' if (length($rrs)); $rrs .= "<a href=\"$r\">$rf</a>"; } return $rrs; } # we have all the ZIP files, but this adds some more # information to the multidenmensional array, @dir_objs, # which was built from @dir_obj2, the original array. # Uses $htm_folder, if $add_ref is enabled, # building a relative path from $my_folder, to the # possible reference files in $htm_folder ... sub post_processing { my ($i, $ii, $mo, $zfn, $rf, $relf); prt( "Doing post processing on $do_cnt zip files ...\n" ); # add mouse over display index my $rcnt = 0; my @ref_files = (); if ($add_ref && !$very_simple) { @ref_files = process_ref_dir($htm_folder); $rcnt = scalar @ref_files; if ($rcnt) { } prt( "And will check $rcnt HTML file for references ...\n" ); } for ($i = 0; $i < $do_cnt; $i++) { $ii = $i + 1; $mo = "disp$ii"; # 0 1 2 3 4 5 5 7 8 #push(@dir_obj2, [ $sb->mtime, $ffn, $sb->size, $md5, $zt, $desc, 0, "", "" ]); $dir_objs[$i][7] = $mo; # set the OnMouseOver display function if ($add_ref && $rcnt && !$very_simple) { $zfn = subactdir( $dir_objs[$i][1] ); $relf = get_relative_path( $htm_folder, $my_folder ); $rf = find_refs($zfn, $relf, @ref_files); $dir_objs[$i][8] = $rf; # set reference files ##prt( "Set reference for $zfn to $rf ...\n" ); } } } # +++++++++++++++++++++++++++++++++++++++++++++++++++++ # MAIN PURPOSE # To write a HTML file, listing all the ZIPS found, # including lots of information about each. # +++++++++++++++++++++++++++++++++++++++++++++++++++++ sub write_html { # $h=handle $r=remote link or not my ($h, $r) = @_; my ($i, $ii, $jt, $dt, $sn, $sz, $m5, $d, $ln, $mo, $re); add_htm_head($h, 'Zip File Listing', $r); # out the HTML header parts print $h "$bm_dateorder"; # set anchor point # write the zip file table in DATE ORDER, adding # a description, if $add_desc enabled, and a desritpion file found # a reference, if $add_ref enabled, with the page(s) the zip is mentioend in. print $h "<table border=\"1\" align=\"center\" summary=\"List of zip downloads\">\n"; ###print $h "<caption>List of ZIP downloads, in Date Order</caption>\n"; # add table header lines print $h "\n <tr>\n"; print $h " <th>\n Date\n </th>\n"; print $h " <th>\n Zip\n </th>\n"; print $h " <th>\n Size\n </th>\n"; print $h " <th>\n Md5\n </th>\n"; print $h " <th>\n Description\n </th>\n" if ($add_desc); print $h " <th>\n Reference\n </th>\n" if ($add_ref && !$very_simple); print $h " </tr>\n"; # output each ZIP, and its information to the table ... for ($i = 0; $i < $do_cnt; $i++) { # added time, file, size, md5 $ii = $i + 1; $mo = $dir_objs[$i][7]; # get the OnMouseOver display function $re = $dir_objs[$i][8]; # get HTML reference file, IF ANY $dt = YYYYMMDD( $dir_objs[$i][0] ); $ln = subactdir( $dir_objs[$i][1] ); #$jt = "onMouseOver=\"disp$ii()\" onMouseOut=\"nodisp()\""; $jt = ''; if (!$very_simple) { $jt = "onMouseOver=\"$mo()\" onMouseOut=\"nodisp()\""; } # 0 1 2 3 4 5 5 7 8 #push(@dir_obj2, [ $sb->mtime, $ffn, $sb->size, $md5, $zt, $desc, 0, "", "" ]); if ($r) { $sn = $remlink . $ln; } else { $sn = $rel_folder.$ln; } $sz = get_nn( $dir_objs[$i][2] ); $m5 = $dir_objs[$i][3]; $desc = $dir_objs[$i][5]; if (in_desclist($desc)) { $desc = "see later version above"; } else { push(@desclist, $desc); } print $h "\n <tr>\n"; print $h " <td align=\"left\">\n $dt\n </td>\n"; print $h " <td align=\"left\">\n <a href=\"$sn\" $jt>\n $ln\n </a>\n </td>\n"; print $h " <td align=\"right\">\n $sz\n </td>\n"; print $h " <td align=\"left\" nowrap>\n <tt>\n $m5\n </tt>\n </td>\n"; print $h " <td align=\"left\">\n $desc\n </td>\n" if ($add_desc); if ($add_ref && !$very_simple) { if (length($re)) { print $h " <td>\n ".get_href_ref_string($re)."\n </td>\n"; } else { print $h " <td>\n \n </td>\n"; } } print $h " </tr>\n"; } print $h " </table>\n"; print $h "\n"; if (!$very_simple) { add_index_link( $h, $r, 3 ); # excl alphabetic print $h "\n"; # NOTE: post_processing has to have been done to SET # the mouseover $mo $dir_objs[nn][7] # and the reference $re $dir_objs[nn][8] if $add_ref enabled. print $h "<p align=\"center\">"; print $h "$bm_alphabetic"; print $h "Simple (reverse) alphabetic list<br>| \n"; #foreach $d (sort @dir_obj) { foreach $d (reverse @dir_obj) { if ($r) { $sn = $remlink . $d; } else { $sn = $rel_folder . $d; } $mo = get_mo_from_dir_objs($d); $jt = ''; if ($add_mo_2 && length($mo)) { $jt = "onMouseOver=\"$mo()\" onMouseOut=\"nodisp()\""; } $msg = "<a $jt href=\"$sn\">$d</a>"; print $h "$msg | \n"; } print $h "</p>\n"; print $h "\n"; print $h "<p class=\"ctr\"><font color=\"red\"><b>RUN EXECUTABLES AT YOUR OWN RISK!</b></font></p>\n"; # add a second CONTENTS table, listing each ZIPS contents add_htm_table2($h, $msg, $r); } # boink out the HTML tail stuff $msg = '<!-- '; $msg .= YYYYMMDD(time()); if ($r) { $msg .= ' geoffmclane.com/zips '; } else { $msg .= ' geoffair.net/ms/zips '; } $msg .= '- generated by '; $msg .= "$pgmname -->"; add_htm_tail($h, $msg, $r); } # navigation jump within document # usually the closest item is omitted, due to # the number passed. Called from add_index_link() sub get_index_text { my ($num) = shift; my $it = ''; $it .= "[<a href=\"#top\">top</a>] " if ($num != 1); if (!$very_simple) { $it .= "[<a href=\"#".$bm_do."\">Ordered</a>] " if ($num != 2); $it .= "[<a href=\"#".$bm_ab."\">Alphabetic</a>] " if ($num != 3); $it .= "[<a href=\"#".$bm_ct."\">Content</a>] " if ($num != 4); } $it .= "[<a href=\"#end\">end</a>] " if ($num != 5); $it .= "[<a href=\"../index.htm\">index</a>]"; return $it; } # add a mainly within document jump line sub add_index_link { my ($fh, $r, $num) = @_; if ($r) { print $fh <<EOF; <p class="ctr">|- <a href="../home2.htm">home</a> -| </p> EOF } else { print $fh "\n <p class=\"ctr\">|- "; print $fh get_index_text($num); print $fh " -|\n </p>\n"; } } # bounce out the HEAD of the HTML document sub add_htm_head { my ($fh, $tit, $r) = @_; print $fh "$m_doctype\n"; print $fh <<EOF; <html> <head> <meta http-equiv="Content-Language" content="en-us"> <meta http-equiv="Content-Type" content="text/html; charset=us-ascii"> <meta name="Author" content="Geoff Mclane"> <meta name="description" content="download zip files"> <meta name="keywords" content="geoff, mclane, geoff mclane, programmer, flightgear, flight, simulator, free, source, binaries, WIN32, EXE"> <meta name="GENERATOR" content="Microsoft FrontPage 5.0"> <meta name="ProgId" content="FrontPage.Editor.Document"> <title> $tit </title> <style type="text/css"> <!-- /* Style Definitions */ body { margin: 0cm 1cm 1cm 1cm; background-image:url('../imgs/cldsxp.jpg'); text-align: justify; } 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; } .cn { font-family : "Courier New"; } .cnsmall { font-family : "Courier New"; font-size:70%; } hr.mini { margin : 0; border-style : none; padding : 0; width : 20%; text-align : center; } p.top { margin : 0; border-style : none; padding : 0; text-align : center; } tt { font-size : x-small } --> </style> EOF if (!$very_simple) { add_js_script($fh); } print $fh <<EOF; </head> <body> EOF if (!$very_simple) { print $fh ' <div id="toolDiv" style="position:absolute; visibility:hide;z-index:1;"></div>'; } printf $fh <<EOF; <h1><a name="top" id="top"></a>$tit </h1> EOF add_index_link($fh, $r, 1); # excluding 'top' print $fh <<EOF; <p>Click on the following links to download the ZIP file. If this fails, try a right button click, and in the context menu, left click 'Save Target As...' ...</p> EOF if ($msvc_list) { print $fh <<EOF; <p>These ZIP files contain either MSVC (6,7 and/or 8) source files, or a WIN32 runtime executable. Generally, a name like dc4w-nn.zip will be the source, and dc4wenn.zip will be the WIN32 runtime executable. </p> EOF } print $fh <<EOF; <p>Take due care with downloading and running executables from the web. Do, at least, check the MD5 digest after downloading. Older items are exactly that, older versions ... Listing, in a table, are $do_cnt zips for download, in DATE order ... EOF if (!$very_simple) { print $fh <<EOF; If javascript is enabled, hovering the mouse over the link should show the contents of the zip file ... EOF } print $fh <<EOF; No warranty is given or implied! Just some <font color= "#FF0000"><b>PERSONAL</b></font> tools ... <font color="#FF0000"><b>USE AT OWN RISK</b></font> </p> EOF print $fh <<EOF; <p align="center"><font color="red"><b>RUN EXECUTABLES AT YOUR OWN RISK!</b></font> </p> EOF } # convert a fixed font directory listing, using to # keep the alignment. sub get_nbsp_text { my ($zt) = shift; my $nzt = ''; my $max = length($zt); my ($k, $ch, $pch, $nch, $k1, $nl); $pch = ''; $nl = 0; for ($k = 0; $k < $max; $k++) { $ch = substr($zt,$k,1); $k1 = $k + 1; if ($ch eq "\n") { # new line if ( ($k1 < $max) && ($nl > 0) ) { $nzt .= "\n<br>"; } $nl = 0; } elsif ($ch eq ' ') { if ($k1 < $max) { $nch = substr($zt,$k1,1); if ($nch eq ' ') { # ok we have 2 or more spaces $k++; # bump to this next $nzt .= ' '; # add the 'space' skipped for ( ; $k < $max; $k++) { $k1 = $k + 1; # get to NEXT $nch = ''; if ($k1 < $max) { $nch = substr($zt,$k1,1); } if ($nch ne ' ') { last; } $nzt .= ' '; # add the 'space' skipped } } } } $nzt .= $ch; $nl++; $pch = $ch; } return $nzt; } # finishing up - spit out the HTML tail sub add_htm_tail { my ($fh, $msg, $r) = @_; add_index_link($fh, $r, 5); # except 'end' print $fh <<EOF; <p class="top"> <a target="_self" href="#top">top</a> </p> <hr class="mini"> <p> <a name="end" id="end"></a> <a target="_blank" href="http://tidy.sourceforge.net/"> <img border="0" src="images/checked_by_tidy.gif" alt="checked by tidy" width="32" height="32"></a> <a href="http://validator.w3.org/check?uri=referer" target="_blank"> <img src="images/valid-html401.gif" alt="Valid HTML 4.01 Transitional" width="88" height="31"></a> </p> EOF if (!$very_simple) { print $fh <<EOF; <script type="text/javascript" language="JavaScript"> <!-- // add final paragraph ... add_last_modified_para(); // --> </script> EOF } printf $fh <<EOF; $msg </body> </html> EOF } # add the SECOND contents table, if $addconttbl is enabled. sub add_htm_table2 { my ($fh, $msg, $r) = @_; my $zcnt = scalar @zip_list; if ($addconttbl && $zcnt) { add_index_link($fh, $r, 4); # excl content print $fh "$bm_content"; # = "<a name=\"$bm_ct\"\n id=\"$bm_ct\"></a>\n"; print $fh "\n"; print $fh "<table border=\"1\" summary=\"List of zip downloads, with contents\">\n"; print $fh "<caption><b>List of ZIP downloads, showing contents.</b></caption>\n"; print $fh "<tr>\n"; print $fh "<th>Download</th>\n"; print $fh "<th>Contents</th>\n"; print $fh "</tr>\n"; prt( "Table of $zcnt zip files, with content ...\n" ); for (my $i = 0; $i < $zcnt; $i++) { my $fil = $zip_list[$i][1]; my $bas = $zip_list[$i][2]; my $typ = $zip_list[$i][3]; my $num = $zip_list[$i][4]; my $ztx = $zip_list[$i][5]; # full zip -vb text, with \n ... print $fh "<tr>\n"; print $fh "<td valign=\"top\"><a href=\"$rel_folder$fil\">$fil</a></td>\n"; if ($tryfulltxt) { if (length($ztx) > $max_cell_cont) { $ztx .= "<font face=\"arial, helvetica\" size=\"-2\">page links: ".get_index_text(0)."</font>"; } else { $ztx =~ s/\n$//; } if ($no_pre) { print $fh '<td class="cnsmall">'; $ztx = get_nbsp_text($ztx); print $fh $ztx; } else { print $fh "<td>"; print $fh "<pre>"; print $fh $ztx; print $fh "</pre>"; } print $fh "</td>\n"; } else { my $zls = get_zip_file_list( $ztx, $fil ); # reduced to file list if (length($zls) > $max_cell_cont) { print $fh "<td>$zls - in page: |- ".get_index_text(0)." -|</td>\n"; } else { print $fh "<td>$zls</td>\n"; } } print $fh "</tr>\n"; ###prt( "$fil ... [$bas][$typ][$num] ...\n" ); } print $fh "</table>\n"; print $fh "\n"; } else { # none to list, but want anchor anyway print $fh "$bm_content"; # = "<a name=\"$bm_ct\"\n id=\"$bm_ct\"></a>\n"; } } # get a LIST of HTML files in the given folder. # return the array, using FULL FILE NAMES. sub process_ref_dir { my ($rd) = shift; my @hfiles = (); if (opendir(RDIR, $rd)) { my @files = readdir(RDIR); close RDIR; my $fcnt = scalar @files; if ($fcnt > 2) { foreach my $fn (@files) { if (($fn eq '.') || ($fn eq '..')) { next; } if (( $fn =~ /\.htm$/i )||( $fn =~ /\.html$/i )) { my $ff = $rd."\\".$fn; push(@hfiles, $ff); } } if ( ! @hfiles ) { prt( "WARNING: Reference directory [$rd] containes NO HTM[L] FILES! (fcnt=$fcnt)\n" ); } } else { prt( "WARNING: Reference directory [$rd] containes NO FILES! (fcnt=$fcnt)\n" ); } } else { prt( "WARNING: Failed to open directory [$rd] ... $! ...\n" ); } return @hfiles; } # MAIN IDEA # process a given directory, seeking ZIP files. 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 (in_excluded($fn)) { prt( "EXCLUDED file [$fn] ...\n" ) if $verb2; } elsif ( $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); my $zt = get_zip_txt($ffn); $desc = ""; if ($add_desc) { $desc = get_description($fn); if (length($desc)) { prt( "DESC[$desc]\n" ) if ($dbg7); } else { $desc = 'ADD DESCRIPTION'; prt( "WARNING: NO DESCRIPTION for [$fn]!\n" ); push(@warnings, "WARNING: NO DESCRIPTION for [$fn]!\n" ); } } prt( "ZIP File [$ffn][$sn] ... ".$sb->size." bytes ... [$md5] [$dtt]\n" ) if $verb2; prt( "Contents:\n$zt\n" ) if ($dbg2); $got_obj++; push(@dir_obj, $sn); ##push(@dir_obj2, [0, 1, 2, 3, 4, 5, 6, 7, 8 ]); push(@dir_obj2, [ $sb->mtime, $ffn, $sb->size, $md5, $zt, $desc, 0, '', '']); } else { prt( "Dicarded file [$fn] ...\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; } # ENSURE '/' is used throughout string. sub dos_2_unix($) { my ($du) = shift; $du =~ s/\\/\//g; return $du; } # sub root folder, $my_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; } # sub $htm_folder, from full name. sub subhtmdir($) { my ($d) = shift; my $rt = dos_2_unix($htm_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; } # NOTE WELL: This is highly specialised, and will NOT # run unless you have a batch file, zip8.bat in the # PATH ... sub get_zip_txt($) { my ($f) = shift; my $rd = "tempzips.txt"; if ( -f $rd) { #prt("Removing [$rd] ...\n"); unlink $rd; } # use MY zip8.bat to get CONTENTS # NOTE WELL: This is MY zip listing BAT file, using the WINZIP # command line interface. THIS MUST BE ADJUSTED TO GET RESULTS!!! my @zargs = ('zip8','-vb',$f, '>', $rd); my $result = system(@zargs); open ZIN, "<$rd" or die "Unable to open $rd ...\n"; my @arr = <ZIN>; close ZIN; my $inblk = 0; my $rmsg = ''; ##print "Got ".scalar @arr." lines ...\n"; foreach my $ln (@arr) { chomp $ln; $ln =~ s/\r$//; ###print "$ln\n"; if ($ln =~ /-----\s+----/) { if ($inblk) { $inblk = 0; } else { $inblk = 1; } } elsif ($inblk) { $rmsg .= "$ln\n"; } } prt( "For file [$f], got zip text -\n" ) if ($dbg8); prt( $rmsg ) if ($dbg8); return $rmsg; } sub next_js_file { my $nf = $firstzlf; # like 'tempziplst01.js'; while (check_filename($nf)) { $nf = next_filename_num($nf); } return $nf; } sub in_added { my ($fil, @add) = @_; foreach my $fl (@add) { if ($fil eq $fl) { return 1; } } return 0; } # ====================================================== # add JAVASCRIPT to HTML # the services are in tooltip.js, obtainable from say # http://geoffair.net/tidy/zips/tooltip.js # it provides a TOOLTIP popup, when the mouse # is hovered over a ZIP file. # This function generates the list of functions needed # for the $do_cnt items in @dir_objs array. # there is a NUMBERED function 'dispnn' for each entry. # THIS CAN GET TOO LARGE - SHOULD MOVE TO EXTERNAL FILE! # ====================================================== sub add_js_script($) { my ($fh) = shift; my ($jsfile, $JSF, $sfh); $sfh = $fh; print $fh <<EOF; <script language="javascript" src="tooltip.js" type="text/javascript"> </script> EOF if ($extjsfile) { $jsfile = next_js_file(); open $JSF, ">$jsfile" or mydie( "ERROR: Can NOT create $jsfile! ... $! ...\n" ); print $fh <<EOF; <script language="javascript" src="$jsfile" type="text/javascript"> </script> EOF print $JSF "/* $jsfile - generated by $pgmname, on "; print $JSF scalar localtime(time()); print $JSF " */\n\n"; $fh = $JSF; } else { print $fh <<EOF; <script type="text/javascript" language="JavaScript"> <!-- // begin EOF } for (my $i = 0; $i < $do_cnt; $i++) { # added time, file, size, md5, zip contents # 0, 1, 2, 3, 4, 5, 6 7, 8 # push(@dir_obj2, [ $sb->mtime, $ffn, $sb->size, $md5, $zt, $desc, 0, DISP, REF ]); my $ii = $i + 1; my $zt = $dir_objs[$i][4]; my $sn = subactdir( $dir_objs[$i][1] ); my $func = "function disp$ii() {\n"; my @zarr = split(/\n/,$zt); # split per line of unzip -vb text ... my $zcnt = scalar @zarr; my $cl = ''; my $mxlen = 0; my $len = 0; my $cnt = 0; my $fline = ''; my $ffn = ''; my @added = (); $func .= " var msg = 'File $sn contains:<br>';\n"; prt( "Adding zip text\n$zt lines=$zcnt ...\n" ) if ($dbg9); if ($use_full_zl) { foreach $cl (@zarr) { $cnt++; # bump the count $cl =~ s/\\/\//g; # subtitute DOS '\' for web/unix '/' globally # eg msg += ' 5168 1312 75% 30/01/2005 12:10 Atlas/Map/Map.vcproj<br>'; $fline = " msg += '"; $fline .= $cl; if ($cnt < $zcnt) { $fline .= "<br>"; } $fline .= "';\n"; $func .= $fline; if ($dbg11) { prt( "Added $fline" ); if (substr($fline, length($fline)-1) ne "\n") { prt("\n"); } } $len = length($cl); if ($len > $mxlen) { $mxlen = $len; # get max length } } } else { # not FULL zip list, so suppress repeats, and nulls foreach $cl (@zarr) { $cnt++; # bump the count $cl =~ s/\\/\//g; # subtitute DOS '\' for web/unix '/' globally # eg msg += ' 5168 1312 75% 30/01/2005 12:10 Atlas/Map/Map.vcproj<br>'; my @zlarr = split(/ /,trim_all($cl)); my $sc = scalar @zlarr; prt( "Space split count = $sc for [".trim_all($cl)."] ...\n" ) if ($dbg10); if ($sc < 6) { mydie( "\nSPLIT IS LESS THAN 6!\n" ); } my $fn = $zlarr[5]; if ($sc > 6) { # NOTE: This BREAKS if name contained double space, but it is just a representation ... for (my $j = 6; $j < $sc; $j++) { $fn .= ' '; $fn .= $zlarr[$j]; # put name back together } } ###$fline .= my_file_name( $zlarr[-1] ); $ffn = my_file_name( $fn ); if (length($ffn) && ($ffn ne '.') && !in_added($ffn, @added)) { push(@added, $ffn); $fline = " msg += '"; $fline .= $ffn; $fline .= ', ' if ($cnt < $zcnt); $fline .= "';\n"; $func .= $fline; if ($dbg11) { prt( "Added $fline" ) if ($dbg11); if (substr($fline, length($fline)-1) ne "\n") { prt("\n"); } } $len = length($cl); if ($len > $mxlen) { $mxlen = $len; # get max length } } else { prt( "Discard ZL[$cl]...\n" ) if ($dbg12); } } } $func .= " tt_width = tt_perchar * $mxlen;\n"; $func .= " dispmsg(msg);\n"; $func .= "}\n"; print $fh $func; } if ($extjsfile) { print $JSF "/* eof */\n"; close $JSF; } else { print $fh <<EOF; // end of script --> </script> EOF } } sub my_file_title { my ($f) = shift; my @a = split(/\./, $f); my $cnt = scalar @a; if ($cnt > 1) { pop @a; return join( '.', @a); } return $f; } sub show_descriptions { my $dc = scalar @descrips; prt( "Showing $dc descriptions ...\n" ); for (my $j = 0; $j < $dc; $j++) { prt( "Name = $descrips[$j][0]\n"); prt( "$descrips[$j][1]\n"); prt( "$descrips[$j][2]\n"); } } sub get_description { #push(@descrips, [$filename, $filesrc, $fileexe] ); my ($f) = shift; my $ll = length($f); my $dsc = ''; my $fn = ''; my $j = 0; $f =~ s/\.zip$//i; $ll = length($f); prt( "Seeking description for [$f] ...\n" ) if ($dbg6); my $pc = ''; my $ise = 0; my $nch = ''; for ($j = 0; $j < $ll; $j++) { my $ch = substr($f,$j,1); $nch = ''; $nch = substr($f,$j+1,1) if (($j + 1) < $ll); if ($ch eq '-' ) { $pc = $ch; last; } if ($ch =~ /\d/) { # is it a number PAIR if ((($j + 1) < $ll)&&($nch =~ /\d/)) { if (($ch eq '3')&&($nch eq '2')) { # except 32 } else { last; } } } $fn .= $ch; $pc = $ch; } $ll = length($fn); prt( "Seeking description for [$fn] ($ll)...\n" ) if ($dbg6); if ($ll) { if ($pc =~ /e/i) { $ll--; $fn = substr($fn,0,$ll); $ise = 1; prt( "Seeking description for [$fn] ($ll)...\n" ) if ($dbg6); } } if ($ll) { my $dc = scalar @descrips; for ($j = 0; $j < $dc; $j++) { my $d = $descrips[$j][0]; if (($fn eq $d)||($fn =~ /$d/i)) { if ($ise) { $dsc = $descrips[$j][2]; } else { $dsc = $descrips[$j][1]; } last; } } } return $dsc; } sub in_excluded { my ($fn) = shift; foreach my $f (@excluded) { prt( "Checking [$f] with [$fn] ...\n" ) if ($dbg4); if ($f eq $fn) { prt( "Equal 1 excluded [$f] with [$fn] ...\n" ) if ($dbg4); return 1; } if ($f =~ /^$fn$/i) { prt( "Equal 2 excluded [$f] with [$fn] ...\n" ) if ($dbg4); return 1; } } if ($excl_vcslns) { ###my @wildexclds = qw( vc?sln??.zip fgvc?rt??.zip img.zip ); if ($fn =~ /vc\d{1}sln\d{2}.zip/i) { return 1; } if ($fn =~ /fgvc\d{1}rt\d{2}.zip/i) { return 1; } } prt( "Not found [$fn] ...\n" ) if ($dbg4); return 0; } sub in_desclist { my ($d) = shift; foreach my $dsc (@desclist) { if ($dsc eq $d) { return 1; } } return 0; } sub get_desc_txt { if( open DF, "<$descfile" ) { @lines = <DF>; close DF; $lncnt = scalar @lines; prt( "Openned $descfile, with $lncnt lines ...\n" ); ###foreach $line (@lines) { for (my $i = 0; $i < $lncnt; $i++ ) { $line = $lines[$i]; chomp $line; $line = trim_all($line); if (length($line) && (substr($line,0,1) ne '#')) { $filename = $line; prt( "Ln $i [$line] ...\n" ) if ($dbg1); $filesrc = ''; $fileexe = ''; $i++; for ( ; $i < $lncnt; $i++ ) { $line = $lines[$i]; chomp $line; $line = trim_all($line); if (length($line) && (substr($line,0,1) ne '#')) { prt( "Ln $i [$line] ...\n" ) if ($dbg1); if ($line =~ /^Source:/i) { prt( "Ln $i [$line] ... SOURCE\n" ) if ($dbg1); $filesrc = $line; } elsif ($line =~ /^Executable:/i) { prt( "Ln $i [$line] ... EXECUTABLE\n" ) if ($dbg1); $fileexe = $line; } else { prt( "WARNING: Line [$line] IGNORED!\n" ); push(@warnings, "WARNING: Line [$line] IGNORED!\n" ); } } else { last; } } if (length($filename) && (length($filesrc)||length($fileexe))) { prt( "push(\@descrips, [$filename, $filesrc, $fileexe] );...\n" ) if ($dbg1); push(@descrips, [$filename, $filesrc, $fileexe] ); } else { prt( "WARNING: no push(\@descrips, [$filename, $filesrc, $fileexe] );!\n" ); push(@warnings, "WARNING: no push(\@descrips, [$filename, $filesrc, $fileexe] );!\n" ); } $filename = ''; $filesrc = ''; $fileexe = ''; } } } } sub get_zip_list { my ($ind) = shift; if ( opendir( DIR, $ind ) ) { my @files = readdir(DIR); closedir DIR; foreach my $fil (@files) { if (($fil eq ".")||($fil eq "..")) { next; } my $ff = $ind . "\\" . $fil; if ((-f $ff) && !in_excluded($fil)) { my ($nm,$dir,$ext) = fileparse( $fil, qr/\.[^.]*/ ); if (lc($ext) eq '.zip') { my $bas = $nm; my $typ = '?'; my $num = '00'; if ($nm =~ /(\w+)([-e]{1})(\d{2})/) { $bas = $1; $typ = $2; $num = $3; ###prt( "Got $bas $typ $num ..\n" ); } else { if ($msvc_list) { prt( "WARNING: [$fil] did not split normally ...\n" ); } } my $zt = get_zip_txt($ff); # use MY unzip8.bat to get CONTENTS push(@zip_list, [$ff, $fil, $bas, $typ, $num, $zt]); } } } } else { mydie( "ERROR: Unable to open $ind ... $! ...\n" ); } } sub get_zip_file_list { my ($zt, $fil) = @_; my @zarr = split(/\n/,$zt); # split per line of unzip -vb text ... my $zcnt = scalar @zarr; my $cl = ''; my $ffn = ''; my $nzt = ''; my $cnt = 0; my @zlist = (); foreach $cl (@zarr) { # $cl =~ s/\\/\//g; # subtitute DOS '\' for web/unix '/' globally # eg msg += ' 5168 1312 75% 30/01/2005 12:10 Atlas/Map/Map.vcproj<br>'; my @zlarr = split(/ /,trim_all($cl)); my $sc = scalar @zlarr; prt( "Space split count = $sc for [".trim_all($cl)."] ...\n" ) if ($dbg10); if ($sc < 6) { mydie( "\nSPLIT IS LESS THAN 6!\n" ); } my $fn = $zlarr[5]; if ($sc > 6) { # NOTE: This BREAKS if name contained double space, but it is just a representation ... for (my $j = 6; $j < $sc; $j++) { $fn .= ' '; $fn .= $zlarr[$j]; # put name back together } } $fn =~ s/\\/\//g; push(@zlist, $fn) if (length($fn)); } foreach $cl (@zlist) { $nzt .= ", " if length($nzt); $nzt .= $cl; } $cnt = scalar @zlist; prt( "\nFor file $fil, got list: ($cnt) from ($zcnt) lines\n$nzt\n" ) if ($dbg10); return $nzt; } ##my $rel = get_relative_path( $htm_folder, $my_folder ); added 20070820 # seems to work fine ... still under test!!! sub get_relative_path { my ($target, $fromdir) = @_; my ($colonpos, $path, $posval, $diffpos, $from, $to); my ($tlen, $flen); my $retrel = ""; $target = dos_2_unix($target); $fromdir = dos_2_unix($fromdir); # add '/' to target. if missing if (substr($target, length($target)-1, 1) ne '/') { $target .= '/'; } # remove drive, if present if ( ( $colonpos = index( $target, ":" ) ) != -1 ) { $target = substr( $target, $colonpos+1 ); } if ( ( $colonpos = index( $fromdir, ":" ) ) != -1 ) { $fromdir = substr( $fromdir, $colonpos+1 ); } $to = $target; $from = $fromdir; $path = "../"; $posval = 0; $retrel = ""; # // Step through the paths until a difference is found (ignore slash, backslash differences # // or the end of one is found while ( substr($from,$posval,1) && substr($to,$posval,1) ) { if ( substr($from,$posval,1) eq substr($to,$posval,1) ) { $posval++; } else { last; # break; } } # // Save the position of the first difference $diffpos = $posval; # // Check if the directories are the same or # // the if target is in a subdirectory of the fromdir if ( ( !substr($from,$posval,1) ) && ( substr($to,$posval,1) eq "/" || !substr($to,$posval,1) ) ) { # // Build relative path $retrel = substr( $target, $posval+1, length( $target ) ); } else { # // find out how many "../"'s are necessary # // Step through the fromdir path, checking for slashes # // each slash encountered requires a "../" #$posval++; while ( substr($from,$posval,1) ) { # // Check for slash if ( substr($from,$posval,1) eq "/" ) { # || ( substr($from,$posval,1) eq "\\" ) ) { # // Found a slash, add a "../" $path .= "../"; } $posval++; } # // Search backwards to find where the first common directory # // as some letters in the first different directory names # // may have been the same $diffpos--; while ( ( substr($to,$diffpos,1) ne "/" ) && substr($to,$diffpos,1) ) { $diffpos--; } # // Build relative path to return $retrel = $path . substr( $target, $diffpos+1, length( $target ) ); } ###prt( "Returning [$retrel] ...\n" ); return $retrel; } sub next_filename_num { my ($ff) = shift; my $nfil = $ff; my ($nm, $dir, $ext) = fileparse( $ff, qr/\.[^.]*/ ); my $nl = length($nm); my $num = ''; my $bgn = ''; for (my $i = 0; $i < $nl; $i++) { my $ch = substr($nm,$i,1); if ($ch =~ /\d/) { $num .= $ch; } else { $bgn .= $num; $bgn .= $ch; $num = ''; } } if (length($num)) { $num++; } else { $num = '01'; } $nfil = $bgn.$num.$ext; return $nfil; } sub check_filename { my ($ff) = shift; if ( -f $ff ) { ###prt( "Found file [$ff] ...\n" ); return 1; } ###prt( "File [$ff] not found ...\n" ); return 0; } sub my_file_name { my ($fil) = shift; my ($nam,$dir,$ext) = fileparse($fil, qr/\.[^.]*/ ); $nam .= $ext if (length($ext)); return $nam; } # eof - zipindex03.pl