Generated: Tue Feb 2 17:54:23 2010 from bldtable02.pl 2007/08/28 22.4 KB.
#!/Perl # NAME: bldtable02.pl # AIM: Build a link table to ZIP files, in a specific directory # 28/08/2007 - list ZIPS in DATE ORDER # ************************************************************************************* # NOTE WELL: the sub get_zip_txt($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!!! # ************************************************************************************* # 27/08/2007 - some enhancements # Get the LIST of ZIP files from a FOLDER # SEE ALSO zipindex03.pl! # 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 $prt_table = 1; # do the HTML output 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 ); # features my $bm_do = "dateordertbl"; my $bm_ab = "alphabetic"; my $bm_dateorder = "<a name=\"$bm_do\"\n id=\"$bm_do\"></a>\n"; my $bm_alphabetic = "<a name=\"$bm_ab\"\n id=\"$bm_ab\"></a>\n"; my $use_full_zl = 0; # 0 = just the file name my $add_js = 1; # add javascript display my @zipfiles = (); my @zipfiles2 = (); my @descrip = (); my @sortedzips = (); 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 = 1; # @zipfiles2 AND THUS @sortedzips OFFSETS # push(@zipfiles2, [ $tm, $file, $md5, $zt, "" ]); my $sz_tim = 0; my $sz_fil = 1; my $sz_md5 = 2; my $sz_ztx = 3; my $sz_dsp = 4; my $sz_siz = 5; my $lncnt = 0; my $tcnt = 0; my $i = 0; my $fnd = 0; my $f_fnd = ""; my $f_in = ""; my ($fnm, $fdir, $fext); my $rel_path = get_relative_path( $in_zips, $in_dir ); my @warnings = (); my $msg = ''; my $refcnt = 0; # 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 my $dbg5 = 0; # show initial references my $dbg6 = 0; # show final references my $dbg7 = 0; # show sorting my $dbg8 = 0; # show get_zip_txt my $dbg9 = 0; my $dbg10 = 0; my $dbg11 = 0; my $dbg12 = 1; # Get ZIP FILE LIST (from folder) get_zip_files( $in_zips ); $zcnt = scalar @zipfiles; @sortedzips = sort mycmp_decend @zipfiles2; # load the DESCRIPTIONS load_descriptions( $desc_file ); # seek reference file get_reference_files( $in_dir ); $tcnt = scalar @found; $refcnt = scalar @references; modify_references(); check_for_missing(); # finally output_htm_file($htm_out); # output HTML file 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'); my $ff2 = $inz . "\\" . $file; my $sb = stat($ff2) or mydie( "ERROR: Unable to 'stat' file [$ff2]?\n" ); my $zt = get_zip_txt($ff2); my $tm = $sb->mtime; open(FILE, $ff2) or mydie( "Can't open '$file': $!" ); binmode(FILE); my $md5 = Digest::MD5->new->addfile(*FILE)->hexdigest; close(FILE); # 0 1 2 3 4 5 # $sz_ tim fil md5 ztx dsp siz push(@zipfiles2, [ $tm, $file, $md5, $zt, "", $sb->size ]); 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; prt( "Modifying $rcnt entries in \@references list ...\n" ); 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" ) if ($dbg5); 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" ) if ($dbg6); } } prt( "Done $rcnt entries in \@references list ...\n" ); } sub out_htm_head { my ($hf, $tit) = @_; my $divmsg = ''; 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=us-ascii"> <meta name="Generator" content="EditPlus"> <meta name="Author" content="Geoff McLane"> <meta name="Keywords" content=""> <meta name="Description" content=""> <title> $tit </title> <link rel="stylesheet" type="text/css" href="fgcode.css"> <script type="text/javascript" src="qlfgmenu.js"> </script> EOF if ($add_js) { $divmsg = " <div id=\"toolDiv\"\n style=\"position:absolute; visibility:hide;z-index:1;\">\n </div>"; add_js_script($hf); } print $hf <<EOF; <style type="text/css"> <!-- /* Style Definitions */ .smlffnt { font-family : "Courier New"; font-size : small; } --> </style> </head> <body> $divmsg <h1> <a name="top" id="top"></a>$tit </h1> <p class="ctr"> <a href="index.htm">index</a> <br> |- <a href="#$bm_do">Date Order</a> -|- <a href="#$bm_ab">Alphabetic</a> -| </p> <p> Click on the following links to download the ZIP file. Try right mouse click, and choose 'Save Target As...' from the context menu if this fails. Some are MSVC (6,7 & 8) project files, sometimes in a zip, some source files, and some are WIN32 EXE (binary) files. Take due care with downloading and running executables from the web. Do, at least, check the MD5 digest after downloading. Older items may no longer be valid with current FlightGear data ;=(( ... </p> <p class="ctr"> <font color="red"><b>RUN EXECUTABLES AT YOUR OWN RISK!</b></font> </p> EOF } sub out_htm_tail { my ( $fh ) = shift; $msg = "<!-- generated by $pgmname on ". localtime(time()) . " -->\n"; print $fh <<EOF; <p> </p> <script type="text/javascript"> <!-- QuickLinks(); ModifiedDate(); // --> </script> <p> </p> <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 add_top_link( $fh ); print $fh <<EOF; <p> </p> $msg <!-- P26.2006.07.30 - initial file --> </body> </html> EOF } # seek a particular file name in @sortedzips # and return its mouse over function, if any. sub get_mo_from_sorted { my ($fn) = shift; my $do_cnt = scalar @sortedzips; for (my $j = 0; $j < $do_cnt; $j++) { my $zln = $sortedzips[$j][$sz_fil]; if ($zln eq $fn) { return $sortedzips[$j][$sz_dsp]; # return the OnMouseOver display function } } return ''; } sub add_top_link { my ($hf) = shift; print $hf <<EOF; <p class="top"> |- <a href="#top">top</a> -|- <a href="#$bm_do">Date Order</a> -|- <a href="#$bm_ab">Alphabetic</a> -| </p> <hr class="mini"> EOF } sub output_htm_file { my ($htm) = shift; if (!$prt_table) { return; } my ($z, $tm, $md5, $mo, $dtt, $jt, $ff2, $desc, @iarr, $iacnt, $j, $f2_in, $sz); my $szcnt = @sortedzips; open $OH, ">$htm" or mydie("ERROR: Can not create $htm ... $! ...\n"); out_htm_head( $OH, 'FlightGear Available Downloads' ); prth( " <p>$bm_dateorder Table of $szcnt downloads in DATE ORDER, showing the reference page - \n </p>\n" ); prth( " <table border=\"1\"\n align=\"center\"\n summary=\"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>Ref Page(s)</th>\n" ); prth( " <th>Description (Bytes)</th>\n" ); prth( " <th>MD5 Digest</th>\n" ); prth( " </tr>\n" ); # 0 1 2 3 4 5 # $sz_ tim fil md5 ztx dsp siz # push(@zipfiles2, [ $tm, $file, $md5, $zt, DISP, $siz ]); # my $szcnt = @sortedzips; for ($z = 0; $z < $szcnt; $z++) { #foreach $file (@zipfiles) { $tm = localtime($sortedzips[$z][$sz_tim]); $file = $sortedzips[$z][$sz_fil]; $md5 = $sortedzips[$z][$sz_md5]; $mo = $sortedzips[$z][$sz_dsp]; # get the OnMouseOver display function $sz = $sortedzips[$z][$sz_siz]; $dtt = date_string($tm); $jt = ''; $jt = "onMouseOver=\"$mo()\" onMouseOut=\"nodisp()\"" if ($add_js); $fnd = 0; ###$ff2 = $in_dir.$file; $ff2 = $in_zips.'/'.$file; for ($i = 0; $i < $refcnt ; $i++) { $f_fnd = $references[$i][0]; $f_in = $references[$i][1]; if ($f_fnd eq $file) { $fnd = 1; last; } } if ($fnd) { prth( " <tr>\n" ); $desc = get_description( $file ); prth( " <td>$dtt</td>\n" ); prth( " <td nowrap>\n" ); prth( " <a $jt 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>\n" ); if ($f_in =~ /\|/) { @iarr = split(/\|/, $f_in); $iacnt = scalar @iarr; for ($j = 0; $j < $iacnt; $j++) { $f2_in = $iarr[$j]; prth( " <br>\n" ) if ($j); prth( " <a href=\"$f2_in\" target=\"_blank\">$f2_in</a>\n" ); } } else { prth( " <a href=\"$ff\" target=\"_blank\">$f_in</a>\n" ); } prth( " </td>\n" ); prth( " <td>$desc (".get_nn($sz).")</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" ); add_top_link( $OH ); prth( " <p class=\"ctr\"><font color=\"red\"><b>RUN EXECUTABLES AT YOUR OWN RISK!</b></font></p>\n" ); prth( "<p class=\"ctr\">$bm_alphabetic Simple ALPHABETIC list<br>\n| " ); foreach $file (sort @zipfiles) { $ff = $rel_path.$file; $jt = ''; if ($add_js) { $mo = get_mo_from_sorted($file); $jt = "onMouseOver=\"$mo()\" onMouseOut=\"nodisp()\"" if (length($mo)); } prth( "<a $jt href=\"$ff\">$file</a> |\n" ); } prth( "</p>\n" ); add_top_link( $OH ); out_htm_tail( $OH ); close $OH; } sub mycmp_decend { if (${$a}[0] < ${$b}[0]) { prt( "+[".${$a}[0]."] < [".${$b}[0]."]\n" ) if $dbg7; return 1; } if (${$a}[0] > ${$b}[0]) { prt( "-[".${$a}[0]."] > [".${$b}[0]."]\n" ) if $dbg7; return -1; } prt( "=[".${$a}[0]."] == [".${$b}[0]."]\n" ) if $dbg7; return 0; } # 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 mydie( "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 file_name { my ($fil) = shift; my ($nam,$dir) = fileparse($fil); return $nam; } # ====================================================== # 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 eahc entry. # ====================================================== sub add_js_script { my ($fh) = shift; #push(@zipfiles2, [ $tm, $file, $md5, $zt, DISP ]); my $do_cnt = scalar @sortedzips; if (!$do_cnt) { return; } print $fh <<EOF; <script language="javascript" src="tooltip.js" type="text/javascript"> </script> <script type="text/javascript" language="JavaScript"> <!-- // begin EOF for (my $i = 0; $i < $do_cnt; $i++) { # 0 1 2 3 4 # $sz_ tim fil md5 ztx dsp #push(@zipfiles2, [ $tm, $file, $md5, $zt, "" ]); my $ii = $i + 1; my $sn = $sortedzips[$i][$sz_fil]; my $zt = $sortedzips[$i][$sz_ztx]; my $fxn = "disp$ii"; $sortedzips[$i][$sz_dsp] = $fxn; my $func = "function $fxn() {\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 = ''; $func .= " var msg = 'File $sn contains:<br>';\n"; prt( "Adding zip text, function $fxn, file $sn\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 { 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 } } ###$fline .= file_name( $zlarr[-1] ); $ffn = file_name( $fn ); if ($ffn ne '.') { $cnt++; # bump the count $fline = " msg += '"; $fline .= file_name( $fn ); if ($cnt < $zcnt) { $fline .= ', '; } $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 { $msg = "WARNING: Discard ZL[$cl]..."; prt( "$msg\n" ); push(@warnings,$msg); } } } $func .= " tt_width = tt_perchar * $mxlen;\n"; $func .= " dispmsg(msg);\n"; $func .= "}\n"; print $fh $func; } print $fh <<EOF; // end of script --> </script> EOF } # 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 - bldtable.pl