#!/usr/bin/perl -w
###########################################################################
# p2hall03.pl - Geoff McLane - geoffair.net/mperl
#
# 12/10/2013 - Seems the Godaddy server does NOT download filename.pl.txt! Change to filename.txt
# 02/02/2010 - 1. Somehow MISSED adding 'bm_top' to ALL the samples!!!
# 2. since using <pre> do NOT need to ADD '&nbsp;' all over the place,
#    but this seems like too drastic a change for now. Maybe add using 'Tidy'???,
#    but have a tidyall.bat to do this as a separate process
#
# This is the MOST recent, in a group
# update 07 June, 2007
# This is an update on p2hall, 01, 02, ... of April, 2006.
# Major update: 28 August, 2006
# Its purpose is to read a FOLDER, and CONVERT ALL perl scripts found
# into a HTML file, of the same name, in an OUTPUT folder. It will
# NOT overwrite any EXISTING file of the same name found in the
# OUTPUT folder unless the source is LATER/NEWER ...
# This p2hallNN.pl series took over from the p2htmlNN.pl series.
#
# Further the CSS coding comes from an perl.css file, which is
# generates if NOT already in existance ...
#
# Another attempt at 'converting' perl scripts to a colour coded HTML page.
# The previous attempt got too unwieldy - abandoned at p2html12.pl ...
# This works on a line by line, character by character, decode,
# and colour encode ... a modest file can grow to 4 or more times
# its original size ... adding colour coding COSTS!
#
# NOTE: While this conversion to coloured HTML produces a 'pretty
# picture' of the original perl script file, often it MAY NOT be copied
# exactly by others. Asside from some big spacing differences, entities
# such as $tok .= '&amp;'; MAY NOT translate correctly. In a copy-and-
# paste operation, this MAY be 'translated' as $tok .= '&';, which
# produces ERRANT perl code! Other ERRORS are $ln =~ s/</&lt;/g;
# MAY become $ln =~ s/</</g; which does NOTHING!!
#
# BUT EVERY ATTEMPT HAS BEEN MADE TO FIX THIS TRANSLATION PROBLEM,
# BUT THERE ARE NO GUARANTEES ;=)) MAYBE I HAVE MISSED SOME CASES!!!
#
# If you want to SHARE your perl script, then you should also place the
# actual script, perhaps in a TEXT (.txt) file, on the web for example.
# I use this perl utility mainly only to convert code fragments, with pretty
# colouring, on example web pages ... BE VERY WARNED, AND TAKE DUE CARE
#
# However, considerable effort has been made to ensuring a clipboard copy of
# the HTML page will 'translate' back to the original text faithfully. ;=))
# The main difference being the translation of TAB characters, mentioned
# below. A GNU 'diff', from - http://unxutils.sourceforge.net/ - with the
# -w (ignore white space) compare, will usually shows NO DIFFERENCE ...
#
# ALSO IT STILL HAS SOME OTHER FOIBLES ;=)) MAYBE ...
#
# Coding like $cond{$#value} can be taken as a comment from the #
# in SOME cases, but maybe most are fixed ... and other unescaped #
# can likewise go wrong ...
#
# The best thing is does is to try to correctly handle such things as
# print <<"EOF";, placing all the following text in one colour, until EOF
# and even my $help = <<EOH; is greyed until EOH but again I may have
# missed some case. Perl syntax can usually be done MANY WAYS ...
#
# There is presently some slight miss-indenting, as all tabs are converted
# to 3 spaces, so lines with a say 4 spaces, will be different to lines
# with tab ... $tab_space can be adjust below. The only auto-type
# solution would be to pre-process the lines, and try to make a tab-stop
# decision, but that is a lot of extra work ;=()
#
# It presently has NO input command - you have to manually adjust the
# $in_folder variable to the FOLDER you want decode. Likewise with the
# htm $out_folder, and $log_file ...
#
# The 'reserved words' and 'builtin functions' can come from the
# perl.stx file of EditPlus 2 - http://www.editplus.com/ - This makes the
# load flexible, as the perl.stx file can be adjusted as desired.
# Without this, you can define $use_local = 1; and the local list will
# be used. 
#
# I have needlessly included Time::HiRes to give an indication of how
# long the processing took, but usually I can 'see' it takes longer
# than the very minimal time elapsed ... If you do not have this
# module, then these time references can be commented out.
#
# The CSS class names, and colours can be changed via the set of 'class'
# and 'color' variables, $a_class, $a_color, $b_class, $b_color, etc.
# And of course the head and ending of the HTML document can be modified
# as desired.
#
# There are a couple of DEBUG switch. The $debug_on immencely increases
# the output, but can often aid is 'seeing' and 'understanding' the code
# path taken ... $add_chart adds a colour chart at the end of the
# document, together with some stats on colour use ... and the increased
# size of the document.
#
# awk! some how an errant 'strip' reference has crept in. there is no
# perl file called strip.pl, nor a strip.htm - remove it - oct, 2006
#
# 2020/10/24 - Fix location of perl.stx in Dell03 machine...
# 23/09/2013 - Fix for location of perl.stx in this Win7 machine. Also add 
# a 'text' copy of each file updated in the 'txt' folder...
# 20081107 - update
# 20070608 - Tidy up, and add more 'links' in index HTML
# 20070526 - Added use File::Basename, and skip 'temp*.pl' files.
# 2006/10/26 - Add 'link' ($add_link) vectors to the index.htm page ...
# 2006/10/27 - Add packages used table ($add_used);
# 20070127 - fix for get_nn only
# DELL-01 machine - had to install Time::HiRes - used PPM
###########################################################################
use Time::HiRes qw(usleep gettimeofday tv_interval );
use strict;
use File::Copy; # to copy from an existing background file - see $jpg_file
use File::stat; # to get the file date
use File::Basename;	# to split path into ($name, $dir, $ext)

# USER VARIABLES
# 1 SOURCE OF GRAPHIC FILES, AND EDITPLUS FILES
###my $out_folder = 'C:/HOMEPAGE/P26/mperl/samples';
my $img_src = "D:/HOMEPAGE/GA/mperl/samples";
###my $img_src = "C:/HOMEPAGE/GA/mperl/samples";
###my $ed2_dir = 'C:/Program Files/EditPlus 2/';
###my $ed2_dir = 'C:/Program Files (x86)/EditPlus 3/';
my $ed2_dir = 'C:\Program Files\EditPlus';

# 2 OUT FOLDER - this FOLDER must exist - it will NOT be created
###my $out_folder = 'GA';	# this FOLDER must exist - it will NOT be created
###my $out_folder = 'P26';
###my $out_folder = 'Max5';
my $out_folder = 'samples';	# this FOLDER must exist - it will NOT be created

my $pgmname = $0;	# get the perl script name perl_name ...
if ($pgmname =~ /\w{1}:[\\\/].*/) {
	my @tmparr = split( /[\\\/]/, $pgmname );
	$pgmname = $tmparr[-1];
}
my $log_file = 'temp'.$pgmname.'.txt'; # log file output
my $in_folder = '.'; # run in local folder
# setting reserved word and function arrays
my $use_local = 0; # set 1 to local internal lists, and NOT load the following file ...
my $perlstx = $ed2_dir.'\perl.stx'; # fix location - or use local list!
# a back ground file
my $jpg_file = 'cldsp.jpg';
# background SOURCE and DESTINATION of background file
my $jpg_src = $img_src."/$jpg_file";
my $jpg_des = "$out_folder/$jpg_file";
# validation file
my $v401_file = 'valid-html401.gif';
# validation SOURCE and DESTINATION of validation file
my $v401_src = $img_src."/$v401_file";
my $v401_des = "$out_folder/$v401_file";
# checked by tidy file
my $tidy_file = 'checked_by_tidy.gif';
# checked SOURCE and DESTINATION
my $tidy_src = $img_src."/$tidy_file";
my $tidy_des = "$out_folder/$tidy_file";

my $indexhtm = 'index.htm';
my $write_index = 1; # set to WRITE index ...
my $dbgem = 0;
my $add_link = 1;	# set to 1 to add anchor names (bookmarks) to index table 3 ...
my $add_used = 1;	# set to 1 to add a 'use' table ...
##my $emreg = '(\\w+\\@{1})(hotmail\\.com)';
my $emreg = '(geoff\\w+\\@{1})(hotmail\\.com)';
my $efix_cnt = 0;	# keep count of email names changed,
my @efix_files = ();	# and the names that had change
my $m_doctype = '<!DOCTYPE html PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"'."\n".
'"http://www.w3.org/TR/html4/loose.dtd">';
my $wrap = 5;		# column wrap in file tables

# set the CLASS and COLOUR strings
my $a_class = 'a'; # built-in function (red)
my $b_class = 'b'; # comments (#006666)
my $c_class = 'c'; # reserved words (blue)
my $d_class = 'd'; # inside qw(...)
my $e_class = 'e'; # $scalar (#9400d3)
my $f_class = 'f'; # in <<EOF...EOF block (#666666)
my $o_class = 'o'; # @array  (#008b8b - was #FFA500)
my $v_class = 'v'; # %hash (#a52a2a - was #808000)
my $t_class = 't'; # quoted - single and double (#006600)
# this is an extract from my perl.css file
#.bif { color: #ff0000 } /* a built-in functions */
#.com { color: #008000 } /* b comments after # */
#.rw { color: #0000cd }  /* c reserved words */
# no d
#.sca { color: #9400d3 } /* e scalar variables */
# no f
#.arr { color: #008b8b } /* o array variables */
#.has { color: #a52a2a } /* v hash variables */
#.qot { color: #009900 } /* t quoted items */

my $a_color = 'red';
my $b_color = '#006666';
my $c_color = 'blue';
###my $d_color = 'brown'; # does not exist!
my $d_color = '#a52a2a';
#my $e_color = '#00008B';
my $e_color = '#9400d3';
my $f_color = '#666666';
#my $o_color = '#FFA500';
my $o_color = '#008b8b';
#my $v_color = '#808000';
my $v_color = '#a52a2a';
my $t_color = '#006600';

# other USER variables
my $tab_space = '   '; # note tabs to 3 spaces - change if desired
# some USER OPTIONS
my $add_chart = 0; # add colour chart at end, with document stats
my $brown_qw = 1; # to process a qw(...);
# these a mutually exclusive - either or ...
my $add_table = 0; # use table to outline code
my $add_pre = 1; # use a <pre>...</pre> block
# this option REALLY adds weight to certain files
my $add_uvars = 1; # colour code user variables

my $wrap_menu = 20;	# insert jump islands, into table
my $menu_wrap = 0;
my $maxcelltxt = (8 * 12 * 12 * 2);

# special DEBUG variables
my $debug_on = 0; # heavy DEBUG ONLY output
my $out_lists = 0; # output the lists in qw form
my $dbg1 = 0;
my $dbg2 = 1;
my $dbg3 = 0;
my $dbg4 = 0; # show 'Add metas to handle'
my $dbg5 = 0;	# show ALL email changes
my $dbg6 = 0;	# show ALL DISCARDED:

my $verb3 = 0;
my $verb4 = 0;
my $verb5 = 0; # debug add_2_used sub
my $verb6 = 0; # output each file processed ...
#####################
# PROGRAM VARIABLES #
#####################

my %HFuncsFnd = ();	# set of FOUND builtin functions
my %HResWdFnd = (); # reserved words used
my @AFileNames = (); # for each output file, with hash of functions
my @AFileHashs = (); # for each output file, with hash of functions
my %HUsedpack = (); # used packages

my $out_file = ''; # out file for HTML
my $in_file = '';  # current in begin processed
my $bs_name = '';  # base file name of current
my $in_date = '';
my $in_size = '';
# for log file
my ($LF, $OF);
# reserved words, and build-ins
my @ResWords = ();
my @BuiltIns = ();

# load perl.stx file, or use this local list
if ($use_local) {

@ResWords = qw/ continue do else elsif for foreach goto if last local lock map my next package redo 
require return sub unless until use while STDIN STDOUT STDERR ARGV ARGVOUT ENV INC SIG TRUE FALSE __FILE__ 
__LINE__ __PACKAGE__ __END__ __DATA__ lt gt le ge eq ne cmp x not and or xor q qq qx qw $ @ % /;

@BuiltIns = qw(abs accept alarm atan2 bind binmode bless caller chdir chmod chomp chop chown chr 
chroot close closedir connect cos crypt dbmclose dbmopen defined delete die dump each eof eval exec exists 
exit exp fcntl fileno flock fork format formline getc getlogin getpeername getpgrp getppid getpriority 
getpwnam getgrnam gethostbyname getnetbyname getprotobyname getpwuid getgrgid getservbyname gethostbyaddr 
getnetbyaddr getprotobynumber getservbyport getpwent getgrent gethostent getnetent getprotoent 
getservent setpwent setgrent sethostent setnetent setprotoent setservent endpwent endgrent endhostent 
endnetent endprotoent endservent getsockname getsockopt glob gmtime grep hex import index int ioctl 
join keys kill lc lcfirst length link listen localtime log lstat mkdir msgctl msgget msgsnd msgrcv no oct 
open opendir ord pack pipe pop pos print printf prototype push quotemeta rand read readdir readlink recv 
ref rename reset reverse rewinddir rindex rmdir scalar seek seekdir select semctl semget semop send setpgrp 
setpriority setsockopt shift shmctl shmget shmread shmwrite shutdown sin sleep socket socketpair sort 
splice split sprintf sqrt srand stat study substr symlink syscall sysopen sysread sysseek system syswrite 
tell telldir tie tied time times truncate uc ucfirst umask undef unlink unpack untie unshift utime values 
vec wait waitpid wantarray warn write );

} 

my $perlcss = <<"PEOF";
/* Style Definitions - updated 2007.06.12 - 2006.07.13 */

body { 
background-image : url('cldsp.jpg');
margin : 0 1cm 0 1cm;
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;
} 

h2 { 
font-size : 16pt;
font-weight : bold;
background-color : #ccccff;
} 

p.top { 
margin : 0;
border-style : none;
padding : 0;
text-align : center;
}

p.nom {
margin : 0cm;
margin-bottom : .0001pt;
color : red;
}

p.code {
	margin: 0cm 0.5cm 0cm 0.5cm;
	font-size:10.0pt;
	font-family:"Courier New";
}

.bld { font-weight: bold; }
.cn { font-family:"Courier New"; }
.ctr { text-align: center; }

.nob { 
margin : 0 0 0 0;
border-style : none;
padding : 0 0 0 0;
} 

.red { color:red; }
.blue { color:blue; }
.green { color:#006600 }
.brown { color:#a52a2a }
.a { color:red; }
.b { color:#006666; }
.c { color:blue; }
.d { color:#a52a2a; }
.e { color:#9400d3; }
.f { color:#666666; }
.o { color:#008b8b; }
.v { color:#a52a2a; }
.t { color:#006600; }

.cd {
  /* top, right, bottom, left */
  padding: 0px 10px 0px 10px;
  margin: 1px 10px 1px 10px;
  background: #f0f8ff;
  border-width: 1px;
  border-style: solid solid solid solid;
  border-color: #cccccc;
  width: 90%;
  font-family:"Courier New";
}

.out {
  padding: 0px 10px 0px 10px;
  margin: 1px 10px 1px 10px;
  background: #2f2f2f;
  color: #ffffff;
  border-width: 1px;
  border-style: solid solid solid solid;
  border-color: #cccccc;
  width: 90%;
  font-family:"Courier New";
}

 /* reserved words */
 .rw { color: #0000cd; }
 /* built-in functions */
.bif { color: #ff0000; }
/* scalar variables */
.sca { color: #9400d3; }
/* array variables */
.arr { color: #008b8b; }
/* hash variables */
.has { color: #a52a2a; }
/* comments after # */
.com { color: #008000; }
/* quoted items */
.qot { color: #009900; }

hr {
margin : 0px 0px 0px 0px;
border-style : none;
padding: 0px 0px 0px 0px;
}

hr.mini { 
margin : 0;
border-style : none;
padding : 0;
width : 20%;
text-align : center;
} 


/* eof - perl.css */
PEOF

my @lines = (); # final output line gathered here
my $line = '';
my $date = '';
my $sz = '';
my $last_builtin = '';
my $last_resword = '';
my $doc_total = 0;
my $out_total = 0;
# these are really just DEBUG counters
my $a_cnt = 0;
my $b_cnt = 0;
my $c_cnt = 0;
my $d_cnt = 0;
my $e_cnt = 0;
my $f_cnt = 0;
my $o_cnt = 0;
my $v_cnt = 0;
my $q_cnt = 0;
# TIME VARIABLES
my ($t0, $t1, $elapsed);

my @in_files = ();	# set of perl files gathered from FOLDER search
my $ind_file = '';	# file name for INDEX list
my $txt_file = '';	# file name for TEXT file (copy of perl)
my @ind_files = ();	# array of files for INDEX generation
my $sb;	# stat of current file
my $latest = 0;
my $earliest = time();

my $dbg20 = 0;
my $dbg21 = 0; # collect from alphabetic table
my $dbg22 = 0; # collect from alphabetic table
my $dbg23 = 0;
my $dbg24 = 0;
my $dbg25 = 0;
# get the old index.htm - D NOT lose information in update ...
my $in_index = "$out_folder/$indexhtm";	# = something line 'index.htm';
my $tbl_num = 1;	# want the first table
my @tbl_arr = ();
my $tacnt = 0;
my @tbl_set = ();
##	push(@tbl_set, [$hrf, $fil, $dt, $sz, $yr, $mt, $dy, 0]);

my $tbl_num3 = 3;	# and we want the third table
my @tbl_arr3 = ();
my $tacnt3 = 0;
my @tbl_set3 = ();
## push(@tbl_set3, [$bif, $files]);
my @hrefs = ();
my %HOldbifs = ();

#################
my $lncnt = 0;
my $tblcnt = 0;
my $indcnt = 0;
my @larr = ();
my @larr2 = ();
my $ln = '';
# get_existing_files( $out_folder );	# put existing in @existing
my @existing = (); # push(@existing, $dfile);
my @dir_list = ();	# if/when I want to be recursive...
my $tot_dirs = 0;
my $tot_files = 0;

my @warnings = ();
# forward references
sub get_old_index($);


#####################################################################
# This is the small MAIN part of the script
$t0 = [gettimeofday];
# logging file, if possible
my $out_log = 1;
if (open $LF, ">$log_file") {
   $out_log = 1;
   prt( "Output also being written to LOG file $log_file ... \n" );
} else {
   $out_log = 0;
   prtw( "WARNING: Unable to create LOG file $log_file ... \n" );
}

sub pgm_exit($$) {
    my ($val,$msg) = @_;
    if (length($msg)) {
        $msg .= "\n" if (!($msg =~ /\n$/));
        prt($msg);
    }
    ###show_warnings($val);
    ###close_log($outfile,$load_log);
    exit($val);
}

if ( ! $use_local) { load_stx_file( $perlstx ); }
prt( "Got ".scalar @ResWords." Reserved Words, and ".scalar @BuiltIns." Built-in functions ...\n" );
# get existing files, and fix missing files in destination.
get_existing_files( $out_folder );	# put existing in @existing
get_input_files( $in_folder );		# find perl scripts, and put in @in_files
# PROCESS THE IN FILES FOUND
#############################################################################
# Get the DATE and TIME,
# Process the file lines - process_file
# If the out file already exists, only overwrite it if the in file is NEWER
# Read in the OLD index, if any, extracting information from the tables.
# Then GENERATE the NEW index file, with lots of information.
#############################################################################
my $fcnt = scalar @in_files;
my $skipped = 0;
my $newercnt = 0;
my $donecnt = 0;
my $tmsg = '';
if ($fcnt) {
	prt( "Processing $fcnt files from folder $in_folder ...\n" );
	for (my $i = 0; $i < $fcnt; $i++ ) {
		reset_variables();
		# push(@in_files, [$df, $dfile]); # store full, and base names
		$in_file = $in_files[$i][0];
		$bs_name = $in_files[$i][1];
		$sb = stat($in_file);
		###$in_date = YYYYMMDD($sb->mtime);
		###$in_size = get_nn($sb->size);
		$in_size = $sb->size;
		$in_date = $sb->mtime; # keep DATE unchanged, so a SORT can be done
		if ($sb->mtime > $latest) { $latest = $sb->mtime; }
		if ($sb->mtime < $earliest) { $earliest = $sb->mtime; }
		$ind_file = my_file_name( $bs_name );
        $txt_file = $ind_file . ".txt";
        $ind_file .= '.htm'; # make the sample file name
		push(@ind_files, [$ind_file,$in_date,$in_size]);	# array of files for INDEX generation
		$out_file = "$out_folder/$ind_file";
		process_file( $in_file, $bs_name ); # main processing of the file lines
		##push(@AFileNames, [$ind_file, \%HFuncsFnd]); # store the functions used ...
		push(@AFileNames, $ind_file   );
		my %th = %HFuncsFnd;
		my @tar = keys %th;
		prt("Pushing HASH with ".scalar @tar." keys ...\n") if ($verb6 || $debug_on);
		push(@AFileHashs, \%th); # store the functions used ...
        $tmsg = 'NEW';
		if ( -f $out_file) {
			my $sb2 = stat($out_file);
			if ($sb->mtime < $sb2->mtime) {
				prt( "Skipping [$out_file] since it already exists ...\n" ) if ($dbg3);
				$out_file = ''; # kill the new output
				$skipped++; # older or same
                $tmsg = 'Skip';
			} else {
				$newercnt++;
                $tmsg = 'Upd';
			}
		}
		if (length($out_file)) {
            my $clncnt = sprintf("%5d", scalar @lines);
			prt( "$tmsg: Put $clncnt lines to [$out_file] ... from [$in_file] ...\n" );
			write_out_file( $out_file ); # write out results, using HTML format ...
            my $txtfil = $out_folder.'/txt/'.$txt_file;
            copy($in_file, $txtfil) or pgm_exit(1,"Failed to copy file [$in_file] to [$txtfil]!\n");
			$donecnt++;
		}
	}
	if ($skipped > 0) {
		prt( "Skipped $skipped already existing, and where time is not later ...\n" );
	}
	prt( "Processed $donecnt files, $newercnt were newer, ".($donecnt - $newercnt)." as new... skipped $skipped\n" );
	get_old_index( $in_index );	# load HTML table, and get set of files ...
	###generate_index() if (($write_index > 0)||($no_index > 0)); # output @ind_files - array of files to index.htm
	generate_index() if ($write_index > 0); # output @ind_files - array of files to index.htm
} else {
	prt( "FAILED to find any perl files in [$in_folder] ...\n" );
}

if ($efix_cnt) {
	my $eff = scalar @efix_files;
	prt("Note: $efix_cnt email changes were made, in $eff files ...\n");
	if ($dbg5) {
		##foreach my $fxf (@efix_files) {
		for (my $i = 0; $i < $eff; $i++) {
			my $fxf = $efix_files[$i][0];
			my $sm = $efix_files[$i][1];
			my $mm = $efix_files[$i][2];
			prt( "In [$fxf] found [$sm], to [$mm] ...\n" ) ;
		}
	}
}

show_warnings();

$t1 = [gettimeofday];
$elapsed = tv_interval ( $t0, $t1 );
prt( "$pgmname - processing took $elapsed seconds ...\n" );
if ($out_log) {
	close($LF);
	system($log_file);
}
exit 0;
#####################################################################

#######################
### only subs below ###
#######################

sub mycmp_decend2 {
	my $off = 1;
	if (${$a}[$off] < ${$b}[$off]) {
		prt( "+[".${$a}[$off]."] < [".${$b}[$off]."]\n" ) if $verb3;
		return 1;
	}
	if (${$a}[$off] > ${$b}[$off]) {
		prt( "-[".${$a}[$off]."] < [".${$b}[$off]."]\n" ) if $verb3;
		return -1;
	}
	prt( "=[".${$a}[$off]."] == [".${$b}[$off]."]\n" ) if $verb3;
	return 0;
}

sub is_valid_link($) {
	my ($f_l) = shift;
	my $ff = $out_folder . "\\" . $f_l;
	if (($f_l =~ /\./) && ( -f $ff )) {
		return 1;
	}
	return 0;
}

sub has_valid_files($) {
	my ($tx) = shift;
	my @atmp = split(/\s/,$tx); # get a list
	my $f = '';
	foreach $f (@atmp) {
		if (is_valid_link($f)) {
			return 1;
		}
	}
	return 0;
}

# push(@AFileNames, $ind_file); store the file
# push(@AFileHashs, \%hr); # and store the functions used ...
sub add_jump_table($) {
	my ($oh) = shift;
	my $acnt = scalar @AFileNames;
	my $bcnt = scalar @AFileHashs;
	my ($itm, $bi, $b3, $msg);
	my @bijumps = ();
	my %nh = ();
	my @b2 = ();
	%nh = %HOldbifs; # get any OLD, from the OLD index
	@b2 = keys %nh;
	$b3 = scalar @b2;
	if ($acnt != $bcnt) {
		prtw("WARNING: THESE TWO COUNTS SHOULD BE THE SAME!!! $acnt vs $bcnt ???\n");
	}
	prt("Adding jump table for $acnt ($bcnt) new hashes ... plus $b3 from OLD index ...\n");
	for ($itm = 0; $itm < $acnt; $itm++) {
		my $fl = $AFileNames[$itm];
		my $hr = $AFileHashs[$itm];
		my $nfl = '';
		prt("Processing file [$fl] ...\n") if ($verb4);
		###my @kys = keys %{$hr}; # get built-ins for this file
		my @kys = keys %{$AFileHashs[$itm]}; # get built-ins for this file
		if (@kys) {
			foreach my $ky (@kys) {
				$nfl = '';
				if (exists $nh{$ky} ) {
					$nfl = $nh{$ky};
				}
				if ( $nfl =~ /$fl/i ) {
					prt("$ky - File [$fl] aready in [$nfl] ...\n") if ($verb4);
				} else {
					if (length($nfl) && !($nfl =~ /\s$/) ) {
						$nfl .= ' '; # add space
					}
					prt("$ky - Adding [$fl] to [$nfl] ...\n") if ($verb4);
					$nfl .= $fl; # add file with this built-in
					$nh{$ky} = $nfl; # store or create built-in with this, these files
				}
				
			}
		} else {
			prt("Failed ... NO KEYS for file [$fl] ... check ...\n");
		}
	}
	# done generation of a set of built in, with each file that contains that built-in
	@b2 = sort keys %nh;
	$b3 = scalar @b2;
	if ( @b2 && ($b3 > 0)) {
		my $allbi = ' '.join(' ', @BuiltIns).' '; # ensure begin and end with space
		prt("Adding 3rd table with $b3 built-ins ...\n");
		out_link_line($oh, 4); # avoid jumptable
		$msg = "<a name=\"bm_jumptable\"\n id=\"bm_jumptable\"></a>\n";
		$msg .= "<p>This is a link/jump table for built-in functions. ";
		$msg .= "The link is to file(s) using that function. Enjoy ;=))</p>\n";
		print $oh $msg;
		$menu_wrap = 0;
		my $mwrap = $wrap_menu;

		# *TABLE* FUNCTION TABLE - jumptable
		print $oh '<table width="100%" border="1" summary="jump index to Perl samples">'."\n";
		print $oh '<caption>Jump index to Perl samples</caption>'."\n";
		print $oh '<tr><th>Built-In</th><th>Jump file(s)</th></tr>'."\n";
		foreach $bi (@b2) {
			my $v = $nh{$bi};
			# check if the 'value' has any valid file to link to
			if (has_valid_files($v)) {
				$msg = "<tr>\n";
				$allbi =~ s/\s+$bi\s+/ /; # delete this entry
				# set to 1 to add anchor names (bookmarks) to index table 3 ...
				$msg .= '<td class="bif" valign="top">';
				$msg .= "<a name=\"$bi\"\n  id=\"$bi\"></a>" if ($add_link);
				$msg .= $bi."</td>\n";
				push(@bijumps, $bi);
				###$msg .= '<td>'.$v."</td>\n";
				my @tmpa = split(/\s/,$v);
				$msg .= "<td>\n";
				###foreach my $tmpf (@tmpa) {
				foreach my $tmpf (sort @tmpa) { # put jumps in alphabetic order
					if (is_valid_link($tmpf)) {
						$msg .= " <a href=\"$tmpf\">$tmpf</a>\n";
					} else {
						# this needs to be FIXED - I think it is from the reading of the OLD
						prt( "DISCARDED: [$bi] file [$tmpf] ...\n" ) if ($dbg6);
					}
				}
				if (length($msg) > $maxcelltxt ) { # = (8 * 12 * 12 * 2)
					$msg .= "\npage links: ";
					$msg .= get_link_txt(0); 
					$menu_wrap = 0;
				}
				$msg .= "</td>\n";
				$msg .= "</tr>\n";
				print $oh $msg;	# PRINT EACH LINE, but text in 2nd cell can mean MANY lines ...

				$menu_wrap++;
				if ($mwrap && ($menu_wrap > $mwrap)) {
					$msg = get_menu_row( 2 );
					print $oh $msg;
					$menu_wrap = 0;
				}
			} else {
				prt( "DISCARD: bif=[$bi] has no valid files [$v]!!!\n" );
			}
		}
		$allbi = trim_line($allbi);
		if (length($allbi)) {
			$msg = "<tr>\n";
			$msg .= "<td>missed</td>\n";
			$msg .= "<td class=\"bif\">$allbi</td>\n";
			$msg .= "</tr>\n";
			print $oh $msg;
		}
		print $oh "</table>\n";
		if (@bijumps) {
			$msg = '';
			$msg .= '<p class="ctr">';
			$msg .= get_link_txt( 0 );
			$msg .= "</p>\n";
			print $oh $msg;
			$msg = '';
			$msg .= '<p class="ctr">';
			$msg .= "<a name=\"bm_functions\"\n  id=\"bm_functions\"></a>";
			$msg .= "Alphabetic link list, into the Function Table.<br>";
			foreach $bi (@bijumps) {
				$msg .= '<a href="#' . $bi . '"><span class="bif">' . $bi . '</span></a>&nbsp;' . "\n";
			}
			$msg .= "</p>\n";
			print $oh $msg;
		}
	} else {
		prt( "Failed ... no keys in %nh ... NO JUMP TABLE DONE!\n" );
	}
}

###########################################################################
# out link line
# This navigation line is pepered throughout the index file
#
# out_link_line($OF, $num);
# name="<something>"
# get_link_txt(0); # get em all
# get_link_txt(1); # avoid adding top
# get_link_txt(2); # avoid adding alphabetc
# get_link_txt(3); # avoid dateindex
# get_link_txt(4); # avoid jumptable
# get_link_txt(5); # avoid packages
# get_link_txt(6); # avoid end
# get_link_txt(7); # avoid functions
###########################################################################

sub get_link_txt {
	my ($num) = shift;
	my $msg = '';
	$msg .= '[ <a href="../index.htm">Back</a> ]'."\n";
	$msg .= '[ <a href="#bm_top">top</a> ]'."\n" if ($num != 1);
	$msg .= '[ <a href="#bm_alphabetic">Alphabetic</a> ]'."\n" if ($num != 2);
	$msg .= '[ <a href="#bm_dateindex">Date Order</a> ]'."\n" if ($num != 3);
	$msg .= '[ <a href="#bm_jumptable">Functions</a> ]'."\n" if ($num != 4);
	$msg .= '[ <a href="#bm_functions">Sorted Func.</a> ]'."\n" if ($num != 7);
	$msg .= '[ <a href="#bm_packages">Packages</a> ]'."\n" if ($num != 5);
	$msg .= '[ <a href="#bm_end">end</a> ]'."\n" if ($num != 6);
	return $msg;
}

#	out_link_line($OF, 0); # avoid none
sub out_link_line($$) {
	my ($oh, $num) = @_;
	my $txt = get_link_txt( $num );
	print $oh '<p class="ctr">';
	print $oh $txt;
	print $oh "</p>\n";
}

sub get_menu_row {
	my ($wp) = shift;
	my $ms = '';
	$ms .= "<tr>\n";
	if ($wp) {
		$ms .= "<td colspan=$wp";
	} else {
		$ms .= "<td";
	}
	$ms .= " class=\"ctr\">";
	$ms .= get_link_txt( 0 );	# get ALL
	$ms .= "</td>";
	$ms .= "</tr>\n";
	return $ms;
}

sub add_new_table($) {
	my ($oh) = shift;
	my @ind_sort = sort mycmp_decend2 @ind_files;
	my $icnt = scalar @ind_sort;
	my $cnt = 0;
	my $i = 0;
	my $line = '';
	my $date = '';
	my $sz = 0;
	my $msg = '';
	prt("Adding 2nd table ...\n");
	out_link_line($oh, 3); # avoid dateindex
	$msg = "<a name=\"bm_dateindex\"\n   id=\"bm_dateindex\"></a>\n";
	$msg .= "<p>This is a repeated table in date order, with the latest, most recent listed first.";
	$msg .= " Enjoy ;=))</p>\n";
	print $oh $msg;
	# *TABLE* FILES - DATE INDEX TABLE - dateindex
	print $oh '<table width="100%" border="1" summary="Date index to Perl samples">'."\n";
	print $oh '<caption>Date index to Perl samples</caption>'."\n";
	# actual output of SORTED generated lines
	$cnt = 0;
	my $mwrap = $wrap_menu;	# get default wrap
	$menu_wrap = 0;	# start line counter

	for ($i = 0; $i < $icnt; $i++) {
		$line = $ind_sort[$i][0];
		$date = YYYYMMDD($ind_sort[$i][1]);
		$sz = get_nn($ind_sort[$i][2]);
		$msg = '';
		if ($cnt == 0) {
			$msg = "<tr>\n";
		}
		###mark_old_index($line);
		$msg .= "<td align=\"center\">$date<br><a href=\"$line\">$line</a><br>$sz</td>\n";
		$cnt++;
		if ($cnt == $wrap) {
			$msg .= "</tr>\n";
			$menu_wrap++;	# count another LINE - row in the table
			$cnt = 0;
		}
		print $oh $msg;
		if (($cnt == 0) && $mwrap && ($menu_wrap > $mwrap)) {
			$msg = get_menu_row( $wrap );
			print $oh $msg;
			$menu_wrap = 0;
		}
	}
	if ($cnt) {
		$msg = '';
		while ($cnt < $wrap) {
			$msg .= "<td>&nbsp; </td>";
			$cnt++;
		}
		$msg .= "\n</tr>\n";
		print $oh $msg;
	}

	print $oh "</table>\n";
}

sub my_file_name {
   my ($f) = shift;
   my @a = split(/\./, $f);
   my $cnt = scalar @a;
   if ($cnt > 1) {
      pop @a;
      return join( '.', @a);
   }
   return $f;
}

sub my_file_ext_NOT_USED {
   my ($f) = shift;
   my @a = split(/\./, $f);
   my $cnt = scalar @a;
   if ($cnt > 1) {
      return $a[-1];
   }
   return '';
}

##########################################
# my file type
# check the extension for .pl and .cgi
# ignore those that being with 'temp...'
##########################################

sub my_file_type {
	my ($f) = shift;
	my ($nm, $dir, $ext) = fileparse( $f, qr/\.[^.]*/ );
	my $lcext = lc($ext);
	if (($lcext eq '.pl')||($lcext eq '.cgi')) {
		if ($nm =~ /^temp/i) {	# ignore 'temp*' files
			return 0;
		}
		return 1;
	}
	return 0;
}

sub in_existing($) {
	my ($cf) = shift;
	my $ef = '';
	foreach $ef (@existing) {
		if ($ef eq $cf) {
			return 1;
		}
	}
	return 0;
}

###################################################################
# get existing files, and fix missing files in destination.
#
# Scan the DESTINATION, and collect any EXISTING files.
# Also check that the CSS, JPG, and GIF files exist.
# If NOT, create CSS, and COPY JPG and GIF from a source location.
#
###################################################################
sub get_existing_files {
	my ($dir) = shift;
	my $df = '';
	prt( "Getting list of EXISTING files in out folder [$dir] ...\n" );
	opendir( THEDIR, $dir ) or mydie( "ERROR: Unable to open folder [$dir] ...\n" );
	my @dfiles = readdir(THEDIR); # slurp in ALL directories, and files, (and . & ..!)
	closedir(THEDIR);
	my $fndcss = 0;
	my $fndjpg = 0;
	my $fndval = 0;
	my $fndchk = 0;
	my $fcnt = scalar @dfiles;
	foreach my $dfile (@dfiles) {
		$df = $dir . '/' . $dfile; # get full name
		if ($dir eq '.') {
			$df = $dfile;
		}
		if ( -d $df ) { # is directory?
			# if ($dfile eq '.' || $dfile eq '..') or
			if ($dfile =~ '^\.$' || $dfile =~ '^\.\.$') {
				# do nothing with DOT and DOUBLE DOT
			} else {
				push(@dir_list, $df); # save local DIRECTORY LIST
				$tot_dirs++;
			}
		} else { # it is a FILE
			$tot_files++;
			push(@existing, $dfile);
			if ($dfile eq 'perl.css') {
				prt( "NOTE: [$df] already exists ...\n" );
				$fndcss = 1;
			} elsif ($dfile eq $jpg_file) {
				prt( "NOTE: [$df] already exists ...\n" );
				$fndjpg = 1;
			} elsif ($dfile eq $v401_file) {
				prt( "NOTE: [$df] already exists ...\n" );
				$fndval = 1;
			} elsif ($dfile eq $tidy_file) {
				prt( "NOTE: [$df] already exists ...\n" );
				$fndchk = 1;
			}
		}
	}
	if (!$fndcss) {
		$df = $dir.'/perl.css';
		prt( "NOTE: Creating [$df] ...\n" );
		write2file( $perlcss, $df );
	}
	if (!$fndjpg) {
		prt( "NOTE: Copying [$jpg_src] to [$jpg_des] ...\n" );
		if ( ! -f $jpg_src ) {
			mydie( "ERROR: Unable to LOCATE [$jpg_src] ... check name, location!\n" );
		}
		copy( $jpg_src, $jpg_des ) or mydie("ERROR: Failed to COPY [$jpg_src]!\n");
	}
	if (!$fndval) {
		prt( "NOTE: Copying [$v401_src] to [$v401_des] ...\n" );
		if ( ! -f $v401_src ) {
			mydie( "ERROR: Unable to LOCATE [$v401_src] ... check name, location!\n" );
		}
		copy( $v401_src, $v401_des ) or mydie("ERROR: Failed to COPY [$v401_src]!\n");
	}
	if (!$fndchk) {
		prt( "NOTE: Copying [$tidy_src] to [$tidy_des] ...\n" );
		if ( ! -f $tidy_src ) {
			mydie( "ERROR: Unable to LOCATE [$tidy_src] ... check name, location!\n" );
		}
		copy( $tidy_src, $tidy_des ) or mydie("ERROR: Failed to COPY [$tidy_src]!\n");
	}

}

###################################################################################
# get input files( $in_folder ); # find perl scripts, and put in @in_files
#
# Scan the PERL folder, and collect ALL existing .pl, or .cgi files there.
# see my_file_type for items included.
# Output 'added name' if $dbg1 is ON ...
###################################################################################

sub get_input_files {
	my ($dir) = shift;
	prt( "Openning folder [$dir] ...\n" ) if ($dbg1);
	opendir( THEDIR, $dir ) or mydie( "ERROR: Unable to open folder [$dir] ...\n" );
	my @dfiles = readdir(THEDIR); # slurp in ALL directories, and files, (and . & ..!)
	closedir(THEDIR);
	prt( "Got ".scalar @dfiles." from folder [$dir] ...\n" ) if ($dbg1);
	foreach my $dfile (@dfiles) {
		my $df = $dir . '/' . $dfile; # get full name
		if ($dir eq '.') {
			$df = $dfile;
		}
		if ( -d $df ) { # is directory?
			# if ($dfile eq '.' || $dfile eq '..') or
			if ($dfile =~ '^\.$' || $dfile =~ '^\.\.$') {
				# do nothing with DOT and DOUBLE DOT
			} else {
				push(@dir_list, $df); # save local DIRECTORY LIST
				prt( "Added [$df] to folder list ...\n" ) if ($dbg1);
				$tot_dirs++;
			}
		} else { # it is a FILE
			$tot_files++;
			if (my_file_type($dfile)) {
				prt( "Added [$df] to list ...\n" ) if ($dbg1);
				push(@in_files, [$df, $dfile]); # store full, and base names
			} else {
				prt( "Skipping [$df] ...\n" ) if ($dbg1);
			}
		}
	}
}

sub reset_variables {
	# done at start of each file
	@lines = (); # no lines, yet
	$doc_total = 0;
	$out_total = 0;
	# these are really just DEBUG counters
	$a_cnt = 0;
	$b_cnt = 0;
	$c_cnt = 0;
	$d_cnt = 0;
	$e_cnt = 0;
	$f_cnt = 0;
	$o_cnt = 0;
	$v_cnt = 0;
	$q_cnt = 0;
	%HResWdFnd = ();
	%HFuncsFnd = ();
}

sub add_use_table { # ($OF) if ($add_used);
	my ($oh) = shift;
	my $cnt = scalar keys(%HUsedpack);
	my $k = '';
	my $v = '';
	my @a = ();
	my $f = '';
	my $m = '';
	prt( "Outing table with $cnt 'use' items from \%HUsedpack ...\n" );
	if ($cnt) {
		prt("Adding 4th table with packages ...\n");
		out_link_line($oh, 5); # avoid packages
		$m = '';
		$m .= '<p>';
		$m .= "<a name=\"bm_packages\"\n id=\"bm_packages\"></a>\n";
		$m .= "List of 'packages' found, during the perl parsing ... more or less in alphabetic order";
		$m .= "</p>\n";
		print $oh $m;
		# *TABLE* PACKAGE TABLE - packages
		print $oh '<table width="100%" border="2" summary="Sorted index of packages used in samples">'."\n";
		print $oh '<caption>Sorted index of packages used in samples</caption>'."\n";
		print $oh "<tr><th>use</th><th>links to files</th></tr>\n";
		my $mwrap = $wrap_menu;	# get default wrap
		$menu_wrap = 0;	# start line counter
		foreach $k (sort keys(%HUsedpack)) {
			$v = trimall($HUsedpack{$k});
			if (has_valid_files($v)) {
				###prt( "k=[$k] v=[$v]\n" );
				@a = split(/\s+/, $v);
				$m = "<tr>\n";
				$m .= "<td valign=\"top\">\n";
				$m .= html_line($k) . "\n";
				$m .= "</td>\n";
				print $oh $m;
				$m = "<td>\n";
				foreach $f (@a) {
					if (is_valid_link($f)) {
						$m .= "<a href=\"$f\">$f</a>&nbsp;\n";
					} else {
						prtw( "WARNING: Discarding [$f] from use links ...\n" );
					}
				}
				if (length($m) > $maxcelltxt ) { # = (8 * 12 * 12 * 2)
					$m .= "\npage links: ";
					$m .= get_link_txt( 0 ); 
					$menu_wrap = 0;
				}

				$m .= "</td>\n";
				$m .= "</tr>\n";
				print $oh $m;
				$menu_wrap++;
				if ($mwrap && ($menu_wrap > $mwrap)) {
					$m = get_menu_row( 2 );
					print $oh $m;
					$menu_wrap = 0;
				}
			} else {
				prtw( "WARNING: NO VALID FILES! k=[$k] v=[$v]\n" );
			}
		}
		print $oh "</table>\n";
		out_link_line($oh, 0); # avoid none
	}
}

#########################################################################
# generate index
#
# This index contains lots of information about what is in each specific
# file. It provides a sort of cross reference to all the perl samples,
# showing -
# table file list - alphabetic
# table file list - date order
# table of the built-in functions used, and an alphabetic link set.
# table of used packages
########################################################################

sub generate_index { # output @ind_files - array of files to index.htm
	my $icnt = scalar @ind_files;
	my $cnt = 0;
	my $msg = '';
	my $i = 0;
	my $dcnt = 0;
	my $ocnt = 0;
	my $acnt = 0; # added to index.htm
	if ($icnt == 0) {
		prt( "No index.htm generated - no files to list ...\n" );
		return;
	}
	my $slatest = YYYYMMDD($latest);
	my $searly = YYYYMMDD($earliest);
	my $of = $in_index; ## "$out_folder/$indexhtm";	# = something line 'index.htm';
	open $OF, ">$of" or mydie("ERROR: Unable to generate index file ...aborting ...\n");
	prt( "\nWriting [$of] HTML with $icnt files ...\n" );
	print $OF "$m_doctype\n";
	print $OF <<"EOF";

<html>

<head>
<title>Index to Perl HTML Samples</title>
<meta http-equiv="Content-Language" content="en-au">
<meta http-equiv="Content-Type" content="text/html; charset=windows-1252">
EOF

	add_metas($OF, 0);

	print $OF <<"EOF";
<link rel=stylesheet href="perl.css" type="text/css">
</head>

<body>
EOF

	print $OF <<"EOF";
<h1><a name="bm_top"
   id="bm_top"></a>Index to Perl HTML Samples</h1>

EOF

	out_link_line($OF, 1); # avoid adding bm_top
	print $OF <<"EOF";

<p>This is a rather random sample of the Perl scripts I have generated over the last few years
($searly - $slatest), $icnt files. Some represent complete Perl applications, aimed at a particular
purpose, while others are just samples, sometimes not functional! And some, like logfile.pl, are
only 'include' files, ie require 'logfile.pl'. A small amount of script has been scraped from
various web site, to test some suggested functionality, but most are largely my own fun and games
with Perl.</p>

<p>Most are for command line use, rather than as CGI, on the WWW, but a few CGI are included. 
When there is a series numbered 01, 02, 03, etc, this usually means the latest is the largest 
number, but sometimes they are different samples. However, the date following each file name 
link is a further indication of the age of the sample. And the original file size, in bytes, follows 
that.</p>

<p>Each of these HTML files are generated from the Perl script, p2hall[series].pl, with colour coding added, 
and, as can be read in the preamble to $pgmname, this means sometimes a simple 
copy and paste will fail, due mainly to a 'translation' of certain characters. 
But most of the time it should be ok, or only require minor fixes.</p>

<p>As always, <font size="2" color="red"><b>*** USE AT OWN RISK ***</b></font>. These are in the 
'public domain' thus there is no 'licence' to worry about. Of course you MUST have a Perl runtime
installed, and in some special cases, additional Perl 'libraries' installed, to run those 
particular files.</p>
	
<a name="bm_alphabetic"
  id="bm_alphabetic"></a>
<p>The file table is repeated. The first should be more or less in file name alphabetic order, 
the second is in <a href="#bm_dateindex"><b>date order</b></a> table, with the latest listed first. Then 
there is a <a href="#bm_jumptable"><b>'jump'</b></a> table, where each Perl built-in function is listed, 
with links to the file(s) that use that built-in. Then a sorted used
<a href="#bm_functions"><b>'function'</b></a> list, and a 
<a href="#bm_packages"><b>'package'</b></a> list. Enjoy ;=))
</p>

EOF

	out_link_line($OF, 2); # avoid adding alphabetc
	# *TABLE* FILES - ALPHABETIC - alphabetic
	print $OF '<table width="100%" border="0" summary="Alphabetic index to Perl samples">'."\n";
	print $OF '<caption>Alphabetic index to Perl samples</caption>'."\n";
	# actual output of generated lines
	$cnt = 0; # for $wrap
	my $add_menu = ($icnt > 25);
	my $mwrap = $wrap_menu;	# get default wrap
	$menu_wrap = 0;	# start line counter

	#foreach $line (@ind_files) {
	for ($i = 0; $i < $icnt; $i++) {
		$line = $ind_files[$i][0];
		####$date = $ind_files[$i][1];
		$date = YYYYMMDD($ind_files[$i][1]);
		$sz = get_nn($ind_files[$i][2]);
		$msg = '';
		if ($cnt == 0) {
			$msg = "<tr>\n";
		}
		mark_old_index($line);
		$msg .= "<td><a href=\"$line\">$line</a><br>$date<br>$sz</td>\n";
		$cnt++;
		if ($cnt == $wrap) {
			$msg .= "</tr>\n";
			$menu_wrap++;	# count another LINE - row in the table
			$cnt = 0;
		}
		print $OF $msg;
		$acnt++; # bump added
		if (($cnt == 0) && $mwrap && ($menu_wrap > $mwrap)) {
			$msg = get_menu_row( $wrap );
			print $OF $msg;
			$menu_wrap = 0;
		}
	}
	my $tsc = scalar @tbl_set;
	$ocnt = 0;
	for ($i = 0; $i < $tsc; $i++ ) {
		if ($tbl_set[$i][7] == 0) {
			$ocnt++;
		}
	}
	prt("Checked $tsc files from old index, and found $ocnt NOT MARKED ...\n");
	#		           0     1     2    3    4    5    6    7
	# push(@tbl_set, [$hrf, $fil, $dt, $sz, $yr, $mt, $dy, 0]);
	for ($i = 0; $i < $tsc; $i++ ) {
		if ($tbl_set[$i][7] == 0) {
			$line = $tbl_set[$i][0];
			if (in_existing($line)) {
				$date = $tbl_set[$i][2];
				$sz   = $tbl_set[$i][3];
				$msg = '';
				if ($cnt == 0) {
					$msg = "<tr>\n";
				}
				###mark_old_index($line);
				$tbl_set[$i][7] = 2;
				$msg .= "<td><a href=\"$line\">$line</a><br>$date<br>$sz</td>\n";
				$cnt++;
				if ($cnt == $wrap) {
					$msg .= "</tr>\n";
					$cnt = 0;
				}
				print $OF $msg;
				prt( "NOTE ADDED [$line][$date][$sz] from OLD index ...\n" );
				$dcnt++;
			} else {
				prtw( "WARNING: File [$line] is NO LONGER IN FOLDER! Now dumped!!\n" );
			}
		}
	}
	if ($cnt) {
		$msg = '';
		while ($cnt < $wrap) {
			$msg .= "<td>&nbsp; </td>\n";
			$cnt++;
		}
		$msg .= "</tr>\n";
		print $OF $msg;
	}
	print $OF "</table>\n";
	prt( "Done primary table ".($acnt + $dcnt)." ... now to do date sorted table ...\n" );
	add_new_table($OF); # add new table sorted by time
	add_jump_table($OF); # put a jump table of build-in function
	out_link_line($OF, 0) if (!$add_used); # avoid none, if not inserted before the table
	add_use_table($OF) if ($add_used); # add packages
	# add 4.01 validation ...
	print $OF <<"EOF";
<p><a name="bm_end"
   id="bm_end"></a>
<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>

EOF


	$msg = "<!-- GA.".YYYYMMDD(time())." generated by $pgmname for geoffair.net/mperl/samples -->\n";
	$msg .= "<!-- ". localtime(time()) . " -->\n";
	print $OF $msg;

	print $OF "</body>\n";
	print $OF "</html>\n";
	close($OF);
	prt( "Done file [$of] with $icnt files, plus $dcnt of $tsc from previous ...\n" );
	###system($of);	# load the INDEX

}

##########################################################################
# The main file OUTPUT - that is the HTML file.
# It establishes the HTML header, which includes the CSS style
# information. then outputs each of the 'converted' lines ...
# this is what it is all about - to generate a HTML document
##########################################################################
sub write_out_file {
	my ($of) = shift;
	open $OF, ">$of" or mydie( "ERROR: Unable to create $of ... aborting ...\n" );
	print $OF "$m_doctype\n";
	print $OF <<"EOF";
<html>
<head>
<title>$in_file to HTML</title>
<meta http-equiv="Content-Language"
      content="en-us">
<meta http-equiv="Content-Type"
      content="text/html; charset=us-ascii">
EOF

	add_metas($OF, 1);

	print $OF <<"EOF";
<link rel="stylesheet"
      href="perl.css"
      type="text/css">
</head>
<body>
EOF

   print $OF "<a name=\"bm_top\" id=\"bm_top\"></a>\n";
   print $OF "<h1>$in_file to HTML.</h1>\n\n";
   print $OF '<p class="top"><a href="'.$indexhtm.'">index</a> -|- <a href="#bm_end">end</a></p>'."\n\n";
   print $OF '<p class="nob">Generated: ' . localtime(time()) . " from $in_file ";
   print $OF YYYYMMDD($in_date).' '.b2KMG($in_size).". <a target=\"_blank\" href=\"txt/$txt_file\">text copy</a></p>\n\n";
   if ($add_table) {
      print $OF '<table width="100%" border="1" summary="Simple HTML of $in_file"><tr><td>'."\n";
   } elsif ($add_pre) {
      print $OF '<pre class="cd">'."\n";
   }
   # actual output of generated lines
   foreach $line (@lines) {
      $out_total += length($line);
      print $OF $line;
   }

   if ($add_table) {
      print $OF '</td></tr></table>'."\n";
   } elsif ($add_pre) {
      print $OF '</pre>'."\n\n";
   }

   if ($add_chart) {
      # mainly only for DEBUG
	  print $OF <<"EOF";
Chart of Colours Used<br>
<table border="1" summary="Table of colours, and count of times used">
<tr>
	<th>Class</th><th>Colour</th><th>Use</th><th>Count</th>
</tr>
<tr>
<td><span class="$a_class">class='$a_class'</span></td>
<td><span class="$a_class">$a_color RED</span></td>
<td><span class="$a_class">Built-in Functions</span></td>
<td><span class="$a_class">$a_cnt</span></td>
</tr>
<tr>
<td><span class="$b_class">class='$b_class'</span></td>
<td><span class="$b_class">$b_color BLUEGREEN</span></td>
<td><span class="$a_class">Comments (following #)</span></td>
<td><span class="$b_class">$b_cnt</span></td>
</tr>
<tr>
<td><span class="$c_class">class='$c_class'</span></td>
<td><span class="$c_class">$c_color BLUE</span></td>
<td><span class="$a_class">Reserved Words</span></td>
<td><span class="$c_class">$c_cnt</span></td>
</tr>
<tr>
<td><span class="$d_class">class='$d_class'</span></td>
<td><span class="$d_class">$d_color BROWN</span></td>
<td><span class="$a_class">Inside qw(...)</span></td>
<td><span class="$d_class">$d_cnt</span></td>
</tr>
<tr>
<td><span class="$e_class">class='$e_class'</span></td>
<td><span class="$e_class">$e_color DARKBLUE</span></td>
<td><span class="$a_class">Scalar Variables</span></td>
<td><span class="$e_class">$e_cnt</span></td>
</tr>
<tr>
<td><span class="$f_class">class='$f_class'</span></td>
<td><span class="$f_class">$f_color GREY</span></td>
<td><span class="$a_class">Inside EOF thingy</span></td>
<td><span class="$f_class">$f_cnt</span></td>
</tr>
<tr>
<td><span class="$o_class">class='$o_class'</span></td>
<td><span class="$o_class">$o_color ORANGE</span></td>
<td><span class="$a_class">Array Variables</span></td>
<td><span class="$o_class">$o_cnt</span></td>
</tr>
<tr>
<td><span class="$v_class">class='$v_class'</span></td>
<td><span class="$v_class">$v_color OLIVE</span></td>
<td><span class="$a_class">Hash Variables</span></td>
<td><span class="$v_class">$v_cnt</span></td>
</tr>
<tr>
<td><span class="$t_class">class='$t_class'</span></td>
<td><span class="$t_class">$t_color GREEN</span></td>
<td><span class="$a_class">Single and Double Quotes</span></td>
<td><span class="$t_class">$q_cnt</span></td>
</tr>
</table>
<br>End of chart<br>
EOF

      my $tot = ($a_cnt+$b_cnt+$c_cnt+$d_cnt+$e_cnt+$f_cnt+$o_cnt+$v_cnt+$q_cnt);
      my $diff = $out_total - $doc_total;
      print $OF "This use of $tot colour span sequences added $diff bytes. In=$doc_total Out=$out_total<br>\n";
   }

   print $OF '<p class="top"><a href="'.$indexhtm.'">index</a> -|- <a href="#bm_top">top</a></p>'."\n\n";

	# add 4.01 validation ...
   print $OF <<"EOF";
<p><a name="bm_end"
   id="bm_end"></a><a target="_blank"
   href="http://tidy.sourceforge.net/"><img border="0"
     src="checked_by_tidy.gif"
     alt="checked by tidy"
     width="32"
     height="32"></a>&nbsp; <a href="http://validator.w3.org/check?uri=referer"
   target="_blank"><img src="valid-html401.gif"
     alt="Valid HTML 4.01 Transitional"
     width="88"
     height="31"></a></p>
EOF

   print $OF '<!-- ' . YYYYMMDD(time()).' geoffair.net/mperl/samples -->'."\n";

   print $OF "</body>\n";

   print $OF "</html>\n";

   close($OF);
}

#########################################################
# A small set of 9 services which add in the CSS class,
# using <span class="???">.thetext.</span>
#
# Each one does a different class, and the class
# is extracted to variables set above. This means
# they can easily be adjusted to new, different
# values ...
#
# They also accumulate statistic information on how
# many time each is used ...
#########################################################
# built-in functions
sub add_red {
   my ($t) = shift;
   $a_cnt++;
   return ('<span class="'.$a_class.'">'.$t.'</span>');
}
# perl comments
sub add_class_b {
   my ($t) = shift;
   $b_cnt++;
   return ('<span class="'.$b_class.'">'.$t.'</span>');
}
# perl reserved words
sub add_blue {
   my ($t) = shift;
   $c_cnt++;
   return ('<span class="'.$c_class.'">'.$t.'</span>');
}
# perl qw set
sub add_class_d {
   my ($t) = shift;
   $d_cnt++;
   return ('<span class="'.$d_class.'">'.$t.'</span>');
}
sub add_class_e {
   my ($t) = shift;
   $e_cnt++;
   return ('<span class="'.$e_class.'">'.$t.'</span>');
}
sub add_class_f {
   my ($t) = shift;
   $f_cnt++;
   return ('<span class="'.$f_class.'">'.$t.'</span>');
}
sub add_class_o {
   my ($t) = shift;
   $o_cnt++;
   return ('<span class="'.$o_class.'">'.$t.'</span>');
}
sub add_class_v {
   my ($t) = shift;
   $v_cnt++;
   return ('<span class="'.$v_class.'">'.$t.'</span>');
}
sub add_quote {
   my ($t) = shift;
   $q_cnt++;
   return ('<span class="'.$t_class.'">'.$t.'</span>');
}
#########################################################


# search the @ResWord array for an entry
sub in_res_words {
   my ($t) = shift;
   foreach my $rw (@ResWords) {
      if ($t eq $rw) {
         $last_resword = $rw;
		 if (exists $HResWdFnd{$rw}) {
			$HResWdFnd{$rw}++; # another count
		 } else {
			$HResWdFnd{$rw} = 1; # start count
		 }
         return 1;
      }
   }
   return 0;
}

# search the @BuiltIns array for an entry
sub is_built_in {
   my ($t) = shift;
   foreach my $rw (@BuiltIns) {
      if ($t eq $rw) {
         return 1;
      }
   }
   return 0;
}

sub in_built_in {
   my ($t) = shift;
   if (is_built_in($t)) {
      $last_builtin = $t;
	  if (exists $HFuncsFnd{$t}) {
		### prt ( "Bumped Funcs [$t] ...\n" );
		$HFuncsFnd{$t}++; # another count
	 } else {
		### prt ( "Created Funcs [$t] ...\n" );
		$HFuncsFnd{$t} = 1; # start count
	 }
     return 1;
   }
   return 0;
}

sub in_built_in_ok {
   my ($t) = shift;
   foreach my $rw (@BuiltIns) {
      if ($t eq $rw) {
         $last_builtin = $rw;
		 if (exists $HFuncsFnd{$rw}) {
			### prt ( "Bumped Funcs $rw ...\n" );
			$HFuncsFnd{$rw}++; # another count
		 } else {
			### prt ( "Created Funcs $rw ...\n" );
			$HFuncsFnd{$rw} = 1; # start count
		 }
         return 1;
      }
   }
   return 0;
}


sub is2lt {
   my $t = shift;
   $t =~ s/&lt;/</g;
   if ( (length($t) >= 2 ) && ( $t =~ /<<$/ ) ) {
      return 1;
   }
   return 0;
}

sub sans_quotes {
   my $t = shift;
   $t =~ s/"//g;
   $t =~ s/'//g;
   return $t;
}

######################################################
# Converting SPACES to '&nbsp;'
# Of course this could be done just using perl's
# powerful search and replace, but this handles
# any number of spaces, only converting the number
# minus 1 to &nbsp; ... not sure how to have
# this level of control with regex replacement
######################################################
sub conv_spaces {
   my $t = shift;
   my ($c, $i, $nt, $ln, $sc, $sp);
   $nt = ''; # accumulate new line here
   $ln = length($t);
   for ($i = 0; $i < $ln; $i++) {
      $c = substr($t,$i,1);
      if ($c eq ' ') {
         $i++; # bump to next 
         $sc = 0;
         $sp = '';
         for ( ; $i < $ln; $i++) {
            $c = substr($t,$i,1);
            if ($c ne ' ') {
               last; # exit
            }
            $sc++;
            $sp .= $c;
         }
         if ($sc) {
            $sp =~ s/ /&nbsp;/g;
            $nt .= $sp;
         }
         $i--; # back up one
         $c = ' '; # add back the 1 space
      }
      $nt .= $c;
   }
   prt( "conv_space: from [$t] to [$nt] ...\n" ) if $debug_on;
   return $nt;
}

###########################################################################
# VERY IMPORTANT SERVICE
# This converts the 'text' into HTML text, but only does a partial job!
# 1. Convert '&' to '&amp;' to avoid interpreting as replacement
# 2. Convert '<' to '&lt;' to avoid interpreting as HTML
# 3. Convert '"' to '&quot;'
# 4. Convert '\t' to SPACES
# 5. Finally, if there are double or more SPACES, convert to '&nbsp;'
###########################################################################
sub html_line {
   my $t = shift;
   my $ot = $t;
   $t =~ s/&/&amp;/g; # all '&' become '&amp;'
   $t =~ s/</&lt;/g; # make sure all '<' is/are swapped out
   $t =~ s/\"/&quot;/g; # and all quotes become &quot;
   $t =~ s/\t/$tab_space/g; # tabs to spaces
   if ($t =~ /\s\s/) { # if any two consecutive white space
      return conv_spaces($t);
   }
   prt( "html_line: from [$ot] to [$t] ...\n" ) if $debug_on;
   return $t;
}

##########################################################
# The following two functions 'convert' scalar variables
# to colour codes spans, in the print <<EOF = get_uform,
# and withing double quoted text "this $cnt ..." ...
# THESE ADD LOTS OF WEIGHT TO THE FILE
##########################################################
sub get_uform {
	my $ln = shift;
	my $tok = ''; # colour up the USER scalar variables within
	my $len = length($ln);
	my $nline = '';
	for (my $i = 0; $i < $len; $i++) {
		my $ch = substr($ln, $i, 1);
		if (($ch eq '$') && (($i + 1) < $len) && (substr($ln,$i+1,1) =~ /\w/) ) {
			$nline .= add_class_f(html_line($tok)) if (length($tok));
			$tok = $ch;
			$i++;
			for ( ; $i < $len; $i++) {
				$ch = substr($ln, $i, 1);
				if ( ! ($ch =~ /\w/) ) {
					# end of token
					$nline .= add_class_e(html_line($tok));
					$tok = '';
					last;
				}
				$tok .= $ch;
			}
		}
		$tok .= $ch;
    }
	$nline .= add_class_f(html_line($tok)) if (length($tok));
	return $nline;
}

sub add_quote2 {
	my ($ln) = shift;
	my $len = length($ln);
	my $ch = '';
	my $ch2 = '';
	my $pc = '';
	my $pc2 = '';
	my $nl = ''; # put the NEW line in here
	my $tok = ''; # colour up the USER scalar variables within DOUBLE quotes
	for (my $i = 0; $i < $len; $i++ ) {
		$ch = substr($ln, $i, 1);
		$ch2 = (($i + 1) < $len) ? substr($ln,$i+1,1) : '';
		# if a scalar variable, and not 'escaped', or the escape escaped and next is 'an_'
		if (($ch eq '$') && (($pc ne '\\')||(($pc eq '\\') && ($pc2 eq '\\'))) &&
			(($i + 1) < $len) && ($ch2 =~ /\w/) ) {
			$nl .= add_quote(html_line($tok)) if (length($tok));
			$tok = $ch;
			$i++;
			for ( ; $i < $len; $i++) {
				$ch = substr($ln, $i, 1);
				if ( ! ($ch =~ /\w/) ) {
					# end of token
					$nl .= add_class_e(html_line($tok));
					$tok = '';
					last; # exit
				}
				$tok .= $ch;
			}
		}
		$tok .= $ch;
		$pc2 = $pc;
		$pc = $ch;
	}
	$nl .= add_quote(html_line($tok)) if (length($tok));
	return $nl;	
}

sub add_2_lines {
	my $t = shift;
	if ( ! $add_pre ) {
		$t .= "<br>";
	}
    prt( "nline[$t]\n" ) if $debug_on;
	$t .= "\n";
	push(@lines, $t);
}

sub get_balance {
	my ($t) = shift;
	if ($t =~ /#/) {
		my $off = index($t, '#');
		if ($off != -1) {
			$t = substr($t,0,$off);
		}
	}
	return $t;
}

sub get_comment {
	my ($t) = shift;
	my $off = index($t, '#');
	if ($off != -1) {
		$t = substr($t,$off);
	} else {
		$t = '';
	}
	return $t;
}

sub add_2_used($$$) {
	my ($xlne, $x, $rlns) = @_;
    my $lne = $xlne;
	my $ll = length($lne);
	my $i2 = index($lne, ';');
	my $dn = 0;
	my $pkg = '';
	my $v = '';
    if ($i2 < 0) {
        # FIX20090122 - note now have use constant { ... maybe many lines
        $i2 = index($lne, '{');
    }
    if (($i2 > 4)&&(length($ind_file))) {
		$lne = substr($lne,0,$i2);
		###print "[$lne]\n";
		if ($lne =~ /^use\s+(.+)/) {
			$pkg = trimall($1);
			###print "[$pkg]\n";
			if ( defined $HUsedpack{$pkg} ) {
				$v = $HUsedpack{$pkg};
				if ( $v =~ /$ind_file/ ) {
					$dn = 3;
				} else {
					$v .= ' ' . $ind_file;
					$HUsedpack{$pkg} = $v;
					$dn = 2;
				}
			} else {
				$HUsedpack{$pkg} = $ind_file;
				$dn = 1;
			}
		}
	}
	if ($dn) {
		if ($dn == 1) {
			prt( "New USE [$pkg] in [$in_file] out [$ind_file] ... [$_[0]]\n" ) if ($verb5);
		} elsif ($dn == 3) {
			prt( "Repeat USE [$pkg] in [$in_file] out [$ind_file] ...[$_[0]]\n" ) if ($verb5);
		} else {
			prt( "Added USE [$pkg] in [$in_file] out [$ind_file] ...[$_[0]]\n" ) if ($verb5);
		}
	} else {
		prtw( "WARNING: failed USE with $xlne ... [$in_file] out [$ind_file]\n" );
	}
}

#################################################################
# The MAIN file processing
# The input file is openned, and all the lines read
# into an array @lns, then each line is processed,
# cheracter by character ...
# It does it mainly via a state, $st
# $st == 0 - processing white space
# $st == 1 - processing alphanumeric, plus _
# $st == 2 - processing nither space nor alphanumeric, here
#            referred to as 'an_' ...
# $st == 3 - Locked in one of << thingies, until the end
#            token located, or until end of file ...
# $st == 4 - Processing a qw(...) function, of qw/.../ if 
# enabled.
#
# Generally the 'tokens' are stored in $tok, as the line
# is processed, added to the $nline at various change
# points, and finally the $nline is stored in the array
# @lines, for later output ...
#
# Setting $debug_on will give a BIG TRACE of where the
# code is handling something ...
#
# Setting $add_uvars to on will add colour code user variables
# but this adds a lot of extra weight to the file.
#
# At this time, the global variable $ind_file contains the
# HTML output file name ...
#
# At this time, the global variable $txt_file contains the
# TEXT copy file name ...
#################################################################
sub process_file {
   my ($in_file, $bn) = @_;	# input and base name
   my ($IF);
   my ($ch1,$ch2,$ch3,$ch4);
   open $IF, "<$in_file" or die "ERROR: Unable to open $in_file ... aborting ...\n";
   my @lns = <$IF>; # slurp into line array
   close($IF);
   my $max = scalar @lns;
   prt( "\nGot $max lines to process from $in_file ...\n" ) if ($verb6 || $debug_on);
   my $st = 0; # current status
   my $nst = 0;
   my $pc = '';
   my $pc2 = '';
   my $ch = '';
   my $tok = '';
   my $ltok = ''; # last token
   my $ltok1 = '';
   my $ltok2 = '';
   my $qtok = ''; # print <<"EOF" or ANY <<'until_end', token
   my $end_qw = '/';
   my $i = 0;
   my ($x);
   # foreach my $ln (@lns) {
   for ($x = 0; $x < $max; $x++) {
       my $ln = $lns[$x];
      $doc_total += length($ln);
      chomp $ln;
      $ln =~ s/\r$//; # and remove CR, if present
	  $ln = fix_email($ln, $bn); # keep list where email is present
      my $len = length($ln);
      my $nline = '';
      prt( "\nline=[$ln] ...\n" ) if $debug_on;
      $pc = '';
	  $pc2 = '';
      $tok = '';
      $ltok = ''; # last token
      $ltok1 = ''; # token stack
      $ltok2 = '';
      $i = 0;
      $nst = 0; # if fall through, next status is IN space
	  add_2_used($ln, $x, \@lns) if ($ln =~ /^use\s+/); # if line BEGINS with 'use '
      if ($st == 3) {
         # locked in a 'print' string to end token
		 if ($add_uvars) {
			 $nline = get_uform( $ln );
		 } else {
			 $nline = add_class_f(html_line($ln));
		 }
		 add_2_lines($nline);
         if ($ln =~ /^$qtok/) {
            $st = 0;
         }
         next; # next LINE of file
      } elsif ($st == 4) {
         # processing a 'qw' block - only if $brown_qw is ON
         $tok = '';
         for ( ; $i < $len; $i++) {
            $ch = substr($ln, $i, 1);
            if ($ch eq $end_qw) { # either '/' or ')' depending on start
               $nline .= add_class_d(html_line($tok)) if (length($tok));
               $tok = '';
               last;
            }
            $tok .= $ch;
         }
         if ($i < $len) {
            $nst = 2; # fall through to continue line
         } else {
            $nline = add_class_d(html_line($ln));
			add_2_lines($nline);
            next;
         }
      }
      $st = $nst;
      for ( ; $i < $len; $i++) {
         $ch = substr($ln, $i, 1);
         # make a BIG exception of '&lt;' ...
         if (($ch eq '&') && (($i + 3) < $len)) {
            $ch1 = substr($ln, $i, 4);
			if ($ch1 eq '&lt;') {
			   $tok .= $ch1;
			   $i += 3;
			   $st = 2;
			   $pc = ';';
		       next;
			}
		 }
         if ($st == 0) {
            # IN white space territory
            if ($ch =~ /\S/) {
               prt( "IN ws, changed to NOT with [$ch] ".
                  "\$tok=[$tok] \$ltok[$ltok] \$ltok1[$ltok1] \$ltok2[$ltok2] html\n" ) if $debug_on; 
               $nline .= html_line($tok); # add any white space to new line
               $ltok2 = $ltok1;
               $ltok1 = $ltok;
               $ltok = $tok;
               $tok = '';
			   # if NOT escape, or escaped escape character
               if ( ($pc ne '\\') || (($pc eq '\\') && ($pc2 eq '\\')) ){
                  if ($ch eq '#') {
                     # start of a COMMENT
                     prt( "start of a COMMENT [$ch] ".
                        "tok=[$tok] ltok[$ltok] ltok1[$ltok1] ltok2[$ltok2] html\n" ) if $debug_on; 
                     $tok = substr($ln, $i); 
                     $nline .= add_class_b(html_line($tok));
                     $tok = '';
                     $st = 0;
                     last;
                  } elsif (($ch eq '"')||($ch eq "'")) {
                     my $bch = $ch;
                     prt( "start of a QUOTE [$ch] ".
                        "tok=[$tok] ltok[$ltok] ltok1[$ltok1] ltok2[$ltok2]\n" ) if $debug_on; 
                     $tok = $ch;
                     $i++;
					 $pc2 = '';
                     for ( ; $i < $len; $i++ ) {
                        $ch = substr($ln, $i, 1);
						# if the PREVIOUS is NOT an ESCAPE, OR the previous and previous ARE
						# that is a ESCAPED ESCAPE character, which is NOT an escape at all ;=))
                        if ( ($pc ne '\\') || (($pc eq '\\')&&($pc2 eq '\\')) ) {
                           if ($ch eq $bch) {
                              $tok .= $ch;
                              prt( "End of a QUOTE [$ch] ".
                                 "tok=[$tok] ltok[$ltok] ltok1[$ltok1] ltok2[$ltok2] html\n" ) if $debug_on; 
							  if ($add_uvars && ($bch eq '"')) {
								  $nline .= add_quote2($tok);
							  } else {
								  $nline .= add_quote(html_line($tok));
							  }
                              $tok = '';
							  $pc2 = $pc;
                              $pc = $ch;
                              last;
                           }
                        }
                        $tok .= $ch;
						$pc2 = $pc;
                        $pc = $ch;
                     }
                     $pc = $ch;
                     next;
                  }
               }
               $tok = $ch;
               if ($ch =~ /\w/) {
				   prt( "Start tok with $ch ... sw st [$st] to 1\n" ) if $debug_on;
                  $st = 1;
               } else {
				   prt( "Start tok with $ch ... sw st [$st] to 2\n" ) if $debug_on;
                  $st = 2;
               }
			   $pc2 = $pc;
               $pc = $ch;
               next;
            } else {
               # staying in white space
               $tok .= $ch;
			   $pc2 = $pc;
               $pc = $ch;
               next;
            }
         } elsif ($st == 1) {
            # dealing with alphanumberic + _
            if ($ch =~ /\w/) {
               $tok .= $ch;
			   $pc2 = $pc;
               $pc = $ch;
               next; # continue alphanumeric + _
            }
            prt( "IN an_, no longer an_ with [$ch] ... tok=[$tok]\n" ) if $debug_on;
            if (length($tok)) {
               if (in_res_words($tok) ) {
                  $nline .= add_blue(html_line($tok));
                  if ($brown_qw && (($ch eq '(')||($ch eq '/')) && ($last_resword eq 'qw')) {
					 # entering a qw list
					 $end_qw = '/';
					 $end_qw = ')' if ($ch eq '(');
                     prt( "Excepting a qw list ... Begin $ch, End $end_qw ...\n" ) if $debug_on;
                     $i++;
                     $nline .= $ch;
                     $tok = ''; # no token
                     for ( ; $i < $len ; $i++) {
                        $ch = substr($ln,$i,1);
                        if ($ch eq $end_qw) { # end on '/' or ')' depending on start
                           $nline .= add_class_d(html_line($tok)) if (length($tok));
                           $nline .= $ch;
                           $tok = '';
                           last;
                        }
                        $tok .= $ch;
                     }
                     if ($i < $len) {
                        next; # get next character
                     } # else, we have ended the line, still in a 'qw' ...
                     $nline .= add_class_d(html_line($tok)) if (length($tok));
                     $tok = '';
                     $st = 4;
                     last; # end of THIS line
                  }
               } elsif (in_built_in($tok)) {
                  $nline .= add_red(html_line($tok));
               } else {
				   if ($add_uvars) { # colour code user variables
				      $ch1 = substr($tok,0,1);
					  if ($ch1 eq '$') {
						  $nline .= add_class_e(html_line($tok));
					  } elsif ($ch1 eq '@') {
						  $nline .= add_class_o(html_line($tok));
					  } elsif ($ch1 eq '%') {
						  $nline .= add_class_v(html_line($tok));
					  } else {
		                  $nline .= html_line($tok);
					  }
				   } else {
					   $nline .= html_line($tok);
				   }
               }
               $ltok2 = $ltok1;
               $ltok1 = $ltok;
               $ltok = $tok;
               $tok = '';
            }
            $tok = $ch;
            if ($ch =~ /\s/) {
               $st = 0; # goto SPACE mode
            } elsif ($ch =~ /\w/) {
               $st = 1; # goto AN_ mode
            } else {
               $st = 2; # goto NOT SPACE or AN_ mode
            }
			$pc2 = $pc;
            $pc = $ch;
            next;
         } elsif ($st == 2) {
            # not IN space or IN an_
            if ($ch =~ /\s/) {
               prt( "IN 2 - change back to space with [$ch] ... tok=[$tok]\n" ) if $debug_on;
               if ( is2lt($tok) ) {
                  $ch1 = get_balance(substr($ln,$i)); # get balance of line
                  $ch1 =~ s/\s+$//; # remove any trailing white space
                  ##if ( ($ch1 =~ /;$/) && ($ltok =~ /=/) ) { mod20060829 add ltok2 also
                  if ( ($ch1 =~ /;$/) && (($ltok =~ /=/)||($ltok1 =~ /=/)) ) {
                     $ch1 =~ s/^\s+//; # remove any leading spaces
                     $ch1 =~ s/;$//; # remove colon
                     $ch1 =~ s/\s+$//; # now again remove any trailing white space
                     if ( !($ch1 =~ /\s/) ) {
                        $qtok = sans_quotes($ch1); # STORE THE END MARKER !!!
                        prt( "Got <<EOH type tok[$tok] $ch1 ltok[$ltok] ltok1[$ltok1] ltok2[$ltok2]... qtok[$qtok]\n" ) if $debug_on;
                        $nline .= html_line($tok);
                        $tok = '';
						$ch1 = substr($ln,$i);
						if ($ch1 =~ /#/) {
							$nline .= html_line(get_balance($ch1)); # add this part
							$ch1 = get_comment($ch1);
							if (length($ch1)) {
								$nline .= add_class_b(html_line($ch1));
							}
						} else {
							$nline .= html_line($ch1); # get balance of line
						}
                        $st = 3;
                        last; # done this line
                     } else {
                        prt( "NOT 1 <<EOH type tok[$tok] $ch1 ltok[$ltok] ltok1[$ltok1] ltok2[$ltok2]... qtok[$qtok]\n" ) if $debug_on;
					 }
                  } else {
                     prt( "NOT 2 <<EOH type tok[$tok] tbol=[$ch1] ltok[$ltok] ltok1[$ltok1] ltok2[$ltok2]... abol=[".
						 substr($ln,$i)."]\n" ) if $debug_on;
				  }
               }
               $nline .= html_line($tok);
               $ltok2 = $ltok1;
               $ltok1 = $ltok;
               $ltok = $tok;
               $tok = $ch;
               $st = 0;
			   $pc2 = $pc;
               $pc = $ch;
               next;
            } elsif ($ch =~ /\w/) { # alphanumeric, including _
               prt( "IN 2 - change back to an_ with [$ch] ... tok=[$tok]\n" ) if $debug_on;
               if ( is2lt($tok) ) {
                  $ch1 = get_balance(substr($ln,$i)); # get balance of line
                  $ch1 =~ s/\s+$//; # remove any trailing white space
                  ##if ( ($ch1 =~ /;$/) && ($ltok =~ /=/) ) { mod20060829 add ltok2 also
                  if ( ($ch1 =~ /;$/) && (($ltok =~ /=/)||($ltok1 =~ /=/)) ) {
                     $ch1 =~ s/^\s+//; # remove any leading spaces
                     $ch1 =~ s/;$//; # remove colon
                     $ch1 =~ s/\s+$//; # now again remove any trailing white space
                     if ( !($ch1 =~ /\s/) ) {
                        $qtok = sans_quotes($ch1); # STORE THE END MARKER !!!
                        prt( "Got <<EOH type tok[$tok] $ch1 ltok[$ltok] ltok1[$ltok1] ltok2[$ltok2]... qtok[$qtok]\n" ) if $debug_on;
                        $nline .= html_line($tok);
                        $tok = '';
						$ch1 = substr($ln,$i);
						if ($ch1 =~ /#/) {
							$nline .= html_line(get_balance($ch1)); # add this part
							$ch1 = get_comment($ch1);
							if (length($ch1)) {
								$nline .= add_class_b(html_line($ch1));
							}
						} else {
							$nline .= html_line($ch1); # get balance of line
						}
                        $st = 3;
                        last; # done this line
                     } else {
                        prt( "NOT 1 <<EOH type tok[$tok] $ch1 ltok[$ltok] ltok1[$ltok1] ltok2[$ltok2]... qtok[$qtok]\n" ) if $debug_on;
					 }
                  } else {
                     prt( "NOT 2 <<EOH type tok[$tok] tbol=[$ch1] ltok[$ltok] ltok1[$ltok1] ltok2[$ltok2]... abol=[".
						 substr($ln,$i)."]\n" ) if $debug_on;
				  }
               }

               if (($tok eq '$')||($tok eq '@')||($tok eq '%')) {
                  $tok .= $ch;
               } else {
				   prt( "Not \$, \@, or \% - html\n" ) if $debug_on;
                  $nline .= html_line($tok);
                  $ltok2 = $ltok1;
                  $ltok1 = $ltok;
                  $ltok = $tok;
                  $tok = $ch;
               }
               $st = 1;
			   $pc2 = $pc;
               $pc = $ch;
               next;
            }
			## NOT space or alphanumeric, including _ ...
            ###if (($pc ne '\\') && (($ch eq '#') || ($ch eq '"') || ($ch eq "'"))) {
            if ((($pc ne '\\')||(($pc eq '\\')&&($pc2 eq '\\'))) &&
				((($ch eq '#')&&($pc ne '$')) || ($ch eq '"') || ($ch eq "'"))) {
				prt( "add in current tok[$tok] ltok[$ltok] ltok1[$ltok1] ltok2[$ltok2] ...\n" ) if $debug_on;
               if ( is2lt($tok) ) {
                  $ch1 = get_balance(substr($ln,$i)); # get balance of line
                  $ch1 =~ s/\s+$//; # remove any trailing white space
                  ##if ( ($ch1 =~ /;$/) && ($ltok =~ /=/) ) { mod20060829 add ltok2 also
                  if ( ($ch1 =~ /;$/) && (($ltok =~ /=/)||($ltok1 =~ /=/)) ) {
                     $ch1 =~ s/^\s+//; # remove any leading spaces
                     $ch1 =~ s/;$//; # remove colon
                     $ch1 =~ s/\s+$//; # now again remove any trailing white space
                     if ( !($ch1 =~ /\s/) ) {
                        $qtok = sans_quotes($ch1); # STORE THE END MARKER !!!
                        prt( "Got <<EOH type tok[$tok] $ch1 ltok[$ltok] ltok1[$ltok1] ltok2[$ltok2]... qtok[$qtok]\n" ) if $debug_on;
                        $nline .= html_line($tok);
                        $tok = '';
						$ch1 = substr($ln,$i);
						if ($ch1 =~ /#/) {
							$nline .= html_line(get_balance($ch1)); # add this part
							$ch1 = get_comment($ch1);
							if (length($ch1)) {
								$nline .= add_class_b(html_line($ch1));
							}
						} else {
							$nline .= html_line($ch1); # get balance of line
						}
                        $st = 3;
                        last; # done this line
                     } else {
                        prt( "NOT 1 <<EOH type tok[$tok] $ch1 ltok[$ltok] ltok1[$ltok1] ltok2[$ltok2]... qtok[$qtok]\n" ) if $debug_on;
					 }
                  } else {
                     prt( "NOT 2 <<EOH type tok[$tok] tbol=[$ch1] ltok[$ltok] ltok1[$ltok1] ltok2[$ltok2]... abol=[".
						 substr($ln,$i)."]\n" ) if $debug_on;
				  }
               }

               $nline .= html_line($tok); # add in current token
               $ltok2 = $ltok1;
               $ltok1 = $ltok;
               $ltok = $tok;
               $tok = '';
               if ($ch eq '#') {
                  prt("# start of a COMMENT ...\n") if $debug_on;
                  $tok = substr($ln, $i); 
                  $nline .= add_class_b(html_line($tok));
                  $tok = '';
                  $st = 0;
                  last;
               } elsif (($ch eq '"')||($ch eq "'")) {
                  my $bch = $ch;
                  $tok = $ch;
                  $i++;
				  $pc2 = '';
                  for ( ; $i < $len; $i++ ) {
                     $ch = substr($ln, $i, 1);
                     if ( ($pc ne '\\') || ( ($pc eq '\\') && ($pc2 eq '\\') ) ) {
                        if ($ch eq $bch) {
                           $tok .= $ch;
                           $qtok = sans_quotes($tok);
						   if ($add_uvars && ($bch eq '"')) {
							  $nline .= add_quote2($tok);
						   } else {
							  $nline .= add_quote(html_line($tok));
						   }
                           $tok = '';
						   $pc2 = $pc;
                           $pc = $ch;
                           last;
                        }
                     }
                     $tok .= $ch;
					 $pc2 = $pc;
                     $pc = $ch;
                  }
                  # check for 'print ... <<"EOF";'
                  if (($i < $len) && 
					  ($last_builtin eq 'print') &&
					  (length($ltok) >= 2) && 
					  is2lt($ltok) && 
					  length($qtok) ) {
					 $qtok = sans_quotes($qtok);	# strip any DOUBLE/SINGLE quotes
                     prt( "Got print [$last_builtin] ltok[$ltok] qtok[$qtok] ...\n" ) if $debug_on;
                     $i++;
                     $nline .= html_line(substr($ln,$i));
                     $tok = '';
                     $st = 3;
                     last; # done this line
                  }
				  $pc2 = $pc;
                  $pc = $ch;
                  next;
               }
            }

			if ($add_uvars && (($ch eq '$')||($ch eq '@')||($ch eq '%'))) {
				prt( "In add_uvars and got \$\@\% [$ch] add tok 2 line ... reset tok\n" ) if $debug_on;
               $nline .= html_line($tok); # add in current token
               $ltok2 = $ltok1;
               $ltok1 = $ltok;
               $ltok = $tok;
               $tok = '';
			} else {
				prt( "NOT space or alphanumeric, including _, or special, or \$\@\% [$ch] add2tok ...\n" ) if $debug_on;
			}
            $tok .= $ch;
         }
		 $pc2 = $pc;
         $pc = $ch;
      }

      $nline .= html_line($tok);
	  add_2_lines($nline);	# push(@lines, $nline); after appending EOL
   }
}

####################################
# Reducing a line to bare bones
# used when loading
# the EditPlus 2 perl.stx file.
# and getting used packages
####################################
sub trim_line($) {
   my ($l) = shift;
   chomp $l; # remove LF
   $l =~ s/\r$//; # and remove CR, if present
   $l =~ s/\t/ /g; # tabs to a space
   $l =~ s/\s\s/ /g while ($l =~ /\s\s/); # duplicate space to single
   $l = substr($l,1) while ($l =~ /^\s/); # each off leading space
   $l = substr($l,0,length($l)-1) while (($l =~ /\s$/)&&(length($l))); # and trailing space
   return $l;
}
sub trimall($) {
	return( trim_line($_[0]) );
}

########################################
# Loading the reserved words, and
# perl built-in functions from a
# special EditPlus 2, perl.stx file,
# but there are arrays already included
# if you do not have this file.
########################################
sub load_stx_file {
   my ($infil) = shift;
   my ($IF);
   my @stx = ();
   my %dchk = ();
   open $IF, "<$infil" or mydie( "ERROR: Unable to open $infil ... aborting ...\n" );
   @stx = <$IF>; # slurp entire file into array
   close($IF);
   my $scnt = scalar @stx;
   prt( "Got $scnt lines in $infil to process ...\n" );
   my $st = 0;
   foreach my $ln (@stx) {
      my $tln = trim_line($ln);
      my $ll = length($tln);
      next if ($ll == 0);
      if( $tln =~ /^\#KEYWORD=Reserved words/ ) {
         $st = 1;
         next;
      } elsif ($tln =~ /^\#KEYWORD=Built-in functions/ ) {
         $st = 2;
         next;
      } elsif (($tln =~ /^\#/) || ($tln =~ /^;/)) {
         $st = 0;
         next;
      }

      if (exists $dchk{$tln}) {
         prt( "Warning: Avoiding duplicate of [$tln] ...\n" );
         next;
      }
      $dchk{$tln} = 1;

      if( $st == 1 ) {
         push(@ResWords, $tln);
      } elsif ($st == 2) {
         push(@BuiltIns, $tln);
      }
   }

	# this was ONLY used to get the internal list
	# so this file becomes unneccessary ...
	if ($out_lists) {
      my $max = 85;
      my $cnt = 20;
      prt( '@ResWords = qw(' );
      foreach my $ln (@ResWords) {
         prt( $ln.' ' );
         $cnt += length($ln);
         if ($cnt > $max) {
            prt("\n");
            $cnt = 0;
         }
      }
      prt( ");\n" );
      $cnt = 20;
      prt( '@BuiltIns = qw(' );
      foreach my $ln (@BuiltIns) {
         prt( $ln.' ' );
         $cnt += length($ln);
         if ($cnt > $max) {
            prt("\n");
            $cnt = 0;
         }
      }
      prt( ");\n" );
   }
}

sub in_efix_list {
	my ($fn) = shift;
	my $cc = scalar @efix_files;
	###foreach my $n (@efix_files) {
	for (my $i = 0; $i < $cc; $i++) {
		my $n = $efix_files[$i][0];
		if ($n eq $fn) {
			return 1;
		}
	}
	return 0;
}

################################################
# sadly, this is to mangle my email, so
# it does not 'appear' to web scrapers
################################################
sub fix_email {
	my ($eml, $bfn) = @_;	# get line, and base name
	my $nem = $eml;
	if ($eml =~ /$emreg/i) {
		my $nm = $1.$2;
		my $sm = mangled_email($nm);
		my $ind = index($eml, $nm);
		if (!($ind == 1)) {
			$nem = substr($eml,0,$ind);
			$nem .= $sm;
			$nem .= substr($eml, $ind+length($nm));
			$efix_cnt++;
			push(@efix_files, [$bfn, $nm, $sm]) if (!in_efix_list($bfn));
		}
		print "got [$nm] ... now [$sm] ... ind $ind ...\n" if $dbgem;
	} else {
		print "failed\n" if $dbgem;
	}
	return $nem;
}

sub mangled_email {
	my ($em) = shift;
	$em =~ s/geoffmclane/geoffair/i;
	$em =~ s/\./ _dot_ /;
	$em =~ s/\@/ _at_ /;
	return $em;
}

################################################
# My particular time 'translation'
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;
}

##################################################
# 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;
}

##################################################
# My particular bytes to K, M, G
sub b2KMG($) {
	my ($d) = shift;
	if ($d < 1000) {
		return $d;
	}
	my $oss;
	my $kss;
	my $lg = 0;
	my $ks = ($d / 1024); #// get Ks
	my $div = 1;
    if( $ks < 1000 ) {
      $div = 1;
      $oss = "KB";
    } elsif ( $ks < 1000000 ) {
	  $div = 1000;
      $oss = "MB";
    } elsif ( $ks < 1000000000 ) {
      $div = 1000000;
      $oss = "GB";
    } else {
      $div = 1000000000;
      $oss = "TB";
    }
    $kss = $ks / $div;
    $kss += 0.05;
    $kss *= 10;
    $lg = int($kss);
    return( ($lg / 10) . " " . $oss );
   ###return( ($lg / 10) . $oss );
}

################################################
# A small 'print' service, that not only
# sends the output to STDOUT, but also
# directs it to a LOG file. I find it
# quite difficult to watch the console
# messages FLASH by ... Of course the
# output can be command line RE-DRIECTED,
# IF you are running it from the command
# line ... most of the time I run it
# from withing the Editor tool, thus thus
# provides a convenient look-back at what
# happend ... this is especially true when
# $debug_on is set ...
################################################
sub prt {
   my ($m) = shift;
   print $m;
   print $LF $m if $out_log;
}

sub mydie {
	my ($m) = shift;
	prt($m);
	die "Got above error ... aborting ...\n";
}

sub write2file {
	my ($txt,$fil) = @_;
	open WOF, ">$fil" or mydie("ERROR: Unable to open $fil!!!\n");
	print WOF $txt;
	close WOF;
}

#########################################################
######## keep the OLD index
### this is needed IF files have been DELETED ...
# ===============================================
sub get_old_index($) {
	my ($ind) = shift;
	$tacnt = 0;
	$tacnt3 = 0;
	if (open IF, "<$ind") {
		@larr = <IF>; # slurp it all in ...
		close(IF);
		$lncnt = scalar @larr;
		prt( "Got $lncnt lines to process ... from [$ind]\n" );
		###write2file( join('',@larr), 'tempout.txt');
		$ln = tag2newline( join('',@larr), 'td' );
		###$ln = tag2newline( $ln, 'br' );
		@larr2 = split(/\n/, $ln);
		###write2file( join("\n",@larr2), 'tempout3.txt');
		if (get_table_array()) {
			$tacnt = scalar @tbl_arr;
			$tacnt3 = scalar @tbl_arr3;
			prt( "Got $tacnt and $tacnt3 lines to process ... from [$ind]...\n" );
		} else {
			prt( "Failed to find table $tbl_num or $tbl_num3 ... in [$ind]...\n" );
		}
	} else {
		prtw( "Warning: Failed to open $ind ...\n" );
		### $no_index = 1;
	}

	if ($tacnt > 0) {
		my $cc = 0;
		for (my $i = 0; $i < $tacnt ; $i++) {
			$ln = $tbl_arr[$i]; # extract a line
			if ($ln =~ /<td.*>/i) {
				while ( !($ln =~ /<\/td>/i) ) {
					$i++;
					if ($i < $tacnt) {
						$ln .= ' '.$tbl_arr[$i]; # extract a line
					} else {
						last;
					}
				}
				# got begin and end of <td>...</td> block
				if ($ln =~ /(<td.*?>)(.*)(<\/td>)/i) {
					my $tds = $1;
					my $inb = $2;
					my $tde = $3;
					# like Line [<td><a href="adjrt01.htm">adjrt01.htm</a> <br>2006/05/23 <br>10,213</td>] = 
					# [<td>][<a href="adjrt01.htm">adjrt01.htm</a> <br>2006/05/23 <br>10,213][</td>] ...
					prt( "Line [$ln] = \nBlocks [$tds][$inb][$tde] ...\n" ) if ($dbg21);
					###if ($inb =~ /<a\s*href=\"(.*)\">(.*)<\/a>/) {
					##if ($inb =~ /<a\s*href=\"(.*)\">(.*)<\/a>\s*<br>(\d{4}\S*)\s*<br>/i) {
					#if ($inb =~ /<a\s*href=\"(.*)\">(.*)<\/a>\s*<br>(\d{4}\S*)\s*<br>(\d{1}\S*)/i) {
					if ($inb =~ /<a\s*href=\"(.*)\">(.*)<\/a>\s*<br>(\d{4}\S*)\s*<br>(\d{1}\S*)\s*/i) {
						my $hrf = $1;
						my $fil = $2;
						my $dt = $3;
						my $sz = $4;
						my ($yr, $mt, $dy) = split(/\//,$dt);
						###$sz =~ s/,//g;
						if ( !($hrf =~ /\./) || !($fil =~ /\./)) {
							# no DOT!!!
							prt( "NOTE tbl_arr: Discarding [$hrf] [$fil] ...\n" );
						} else {
							#               0     1     2    3    4    5    6    7
							push(@tbl_set, [$hrf, $fil, $dt, $sz, $yr, $mt, $dy, 0]);
						}
						prt("href=[$hrf], file=[$fil], date=[$dt][$yr][$mt][$dy], size=[$sz]...\n") if ($dbg22);
					} else {
						prt("HREF not found - CHECK!\n") if ($dbg22);
					}
				}
			}
		}
	}
	if ($tacnt3 > 0) {
		my $cc = 0;
		my $ff = 0; # since just two columns - flip flop
		my $bif = '';
		my $fil = '';
		for (my $i = 0; $i < $tacnt3 ; $i++) {
			$ln = $tbl_arr3[$i]; # extract a line
			if ($ln =~ /<td.*>/i) {
				$cc = length($ln);
				prt( "$i - Line [$ln] $cc...\n" ) if ($dbg24);
				while ( !($ln =~ /<\/td>/i) ) {
					$i++;
					if ($i < $tacnt3) {
						$ln .= ' '.$tbl_arr3[$i]; # extract a line
					} else {
						last;
					}
				}
				if ($cc != length($ln)) {
					$cc = length($ln);
					prt( "$i - Line [$ln] $cc...\n" ) if ($dbg24);
				}

				# got begin and end of <td>...</td> block
				# 2006.09.11 '?' added to STOP greedy parsing
				if ($ln =~ /(<td.*?>)(.*)(<\/td>)/i) {
					my $tds = $1;
					my $inb = $2;
					my $tde = $3;
					prt( "$i - td[$tds] in[$inb] te[$tde]...\n" ) if ($dbg24);
					if ($ff > 0) {
						$fil = collecthrefs($inb, 1); # remove HREF
						$fil = trim_line($fil);
						if (is_built_in($bif)) {
							push(@tbl_set3, [$bif, $fil, 0]);
							prt( " push(\@tbl_set3, [$bif, $fil, 0]); ...\n" ) if ($dbg23);
						} else {
							prt( " Advice: Skipping [$bif] - NOT BUILT IN FUNCTION!\n" );
						}
						$ff = 0;
					} else {
						$bif = collecthrefs($inb,1); # remove <a ...> and </a>, if any ...
						$bif =~ s/\[//;
						$bif =~ s/\]//;
						$bif = 	trim_line($bif);
						$ff = 1;
					}
				} else {
					prt( "CHECK ME: Missed <td> ... </td> \n");
				}
			}
		}
	}
	transfer_old_table3();
}

sub transfer_old_table3() {
	$tacnt3 = scalar @tbl_set3;
	if ($tacnt3 > 0) {
		prt( "Collected $tacnt3 in \@tbl_set3 ... need to intialise built-in hash ...\n" );
		## load into my %HOldbifs = ();
		my $elimcnt = 0;
		my $elimcnt2 = 0;
		for (my $i = 0; $i < $tacnt3; $i++) {
			my $bif = $tbl_set3[$i][0];
			my $fss = $tbl_set3[$i][1];
			if (is_built_in($bif)) {
				# each new htm file written is kept in -
				# push(@AFileNames, $ind_file   );
				# and for each of these a new hash of built ins has been kept
				# push(@AFileHashs, \%th); # store the functions used ...
				# so these files can be (safely) eliminated, since they will be added later
				foreach my $nhf (@AFileNames) {
					if ($fss =~ /$nhf/i) {
						$fss =~ s/$nhf//;
						$elimcnt++;
					}
				}
				$fss = trim_line($fss);
				if (length($fss)) {
					if (exists $HOldbifs{$bif}) {
						prtw("WARNING: [$bif] appears DUPLICATED ...\n had=[".$HOldbifs{$bif}."\nadding [$fss]\n\n");
						$HOldbifs{$bif} .= $fss;
					} else {
						$HOldbifs{$bif} = $fss;
					}
				} else {
					$elimcnt2++;
				}
			} else {
				prtw("WARNING: DISCARDING [$bif] - NOT BUILT-IN!\n");
			}
		}
		my $nwcnt = scalar keys %HOldbifs;
		if ($elimcnt > 0) {
			prt( "Elimated old files $elimcnt times, avoiding $elimcnt2 bifs being added...\n" );
		}
		prt( "Done $tacnt3 in \@tbl_set3 ... now $nwcnt in \%HOldbifs ...\n" );
	}
}


sub mark_old_index($) {
	my ($f) = shift;
	my $tsc = scalar @tbl_set;
	for (my $i = 0; $i < $tsc; $i++ ) {
		if ($tbl_set[$i][0] eq $f) {
			$tbl_set[$i][7] = 1;
			last;
		}
	}
}

sub get_table_array {
	my $fnd = 0;
	$lncnt = scalar @larr2;
	for (my $i = 0; $i < $lncnt ; $i++) {
		$ln = $larr2[$i]; # extract a line
		chomp $ln; # remove LF (\n)
		$ln =~ s/\r$//; # and remove CR, if present
		if ($ln =~ /<table.*>/i) {
			prt( "FOUND TABLE: [$ln] ...\n" );
			$tblcnt++; # bump table counter
			if ($tblcnt == $tbl_num) {
				prt( "Is my TABLE [$tblcnt] ...\n" ) if ($dbg20);
				push(@tbl_arr,$ln);
				if ( !($ln =~ /<\/table>/i) ) {
					$i++; # move to next line
					for ( ; $i < $lncnt; $i++) {
						$ln = $larr2[$i]; # extract a line
						chomp $ln; # remove LF (\n)
						$ln =~ s/\r$//; # and remove CR, if present
						if ( $ln =~ /<\/table>/i ) {
							prt( "END TABLE $tbl_num: [$ln] ...\n" ) if ($dbg20);
							push(@tbl_arr,$ln);
							$fnd++;
							last;
						}
						push(@tbl_arr,$ln);
					}
				}
			} elsif ($tblcnt == $tbl_num3) {
				prt( "Is also my TABLE [$tblcnt] ...\n" ) if ($dbg20);
				push(@tbl_arr3,$ln);
				if ( !($ln =~ /<\/table>/i) ) {
					$i++; # move to next line
					for ( ; $i < $lncnt; $i++) {
						$ln = $larr2[$i]; # extract a line
						chomp $ln; # remove LF (\n)
						$ln =~ s/\r$//; # and remove CR, if present
						if ( $ln =~ /<\/table>/i ) {
							prt( "END TABLE $tbl_num3: [$ln] ...\n" ) if ($dbg20);
							push(@tbl_arr3,$ln);
							$fnd++;
							last;
						}
						push(@tbl_arr3,$ln);
					}
				}
			}
		}
	}
	return $fnd;
}

###################################################################
# COPIED OUT OF htmltools.pl, since I do NOT want to include it, just now ...
sub tag2newline { # ($txt2,'td');
	my ($txt, $tag) = @_;
	my $len = length($txt);
	my $ntxt = '';
	my $i;
	my $ch = '';
	my $ft = '';
	my $lcnt = 0;
	for ($i = 0; $i < $len; $i++ ) {
		$ch = substr($txt,$i,1);
		if ($lcnt && ($ch eq '<')) {
			$ft = $ch;
			$i++;
			for ( ; $i < $len; $i++ ) {
				$ch = substr($txt,$i,1);
				$ft .= $ch;
				if ($ch eq '>') {
					if ($ft =~ /^<$tag/i) {
						$ft = "\n".$ft;
					}
					last;
				}
			}
			$ntxt .= $ft;
		} else {
			$ntxt .= $ch;
			if ($ch eq "\n") {
				$lcnt = 0;
			} else {
				$lcnt++;
			}
		}
	}
	return $ntxt;
}

sub collecthrefs {
	my ($txt,$del) = @_;
	my $ntxt = '';
	my $len = length($txt);
	my $ch = '';
	my $hrf = '';
	my $i;
	for ($i = 0; $i < $len; $i++) {
		$ch = substr($txt,$i,1);
		if ($ch eq '<') {
			$hrf = $ch;
			$i++;
			for ( ; $i < $len; $i++) {
				$ch = substr($txt,$i,1);
				$hrf .= $ch;
				if ($ch eq '>') {
					last;
				}
			}

			if ($hrf =~ /^<a\s/i) {
				if ($del == 0) {
					$ntxt .= $hrf;
				}
				### prt("Got [$hrf] ...\n");
				if ($hrf =~ /href=["'](\S+)["']./i) {
					$hrf = $1;
					push(@hrefs,$hrf);
					### prt("Got [$hrf] ...\n");
				}
			} elsif ($hrf =~ /^<\/a>$/i) {
				if ($del == 0) {
					$ntxt .= $hrf;
				}
			} else {
				$ntxt .= $hrf;
			}
		} else {
			$ntxt .= $ch;
		}
	}
	return $ntxt;
}

###################################################################

sub add_metas($$) {
	my ($oh, $ad) = @_;
	my $m = '';
	my $m2 = '';
	prt( "Add metas to handle ...\n" ) if ($dbg4);
	$m = '<meta name="author" content="geoff mclane">'."\n";
	$m .= '<meta name="keywords" content="geoff, mclane, geoffmclane, computer, consultant, programmer,'."\n";
	$m2 = 'perl, scripts, samples, examples';
	if ($ad) {
		foreach my $k (keys %HFuncsFnd) {
			if (length($m2) > 76) {
				$m2 .= ",\n";
				$m .= $m2;
				$m2 = $k;
			} else {
				$m2 .= ', '.$k;
			}
		}
	} else {
		my $bcnt = scalar @AFileHashs; # collection of HASHES from each file
		my $nkys = ' ';
		my $ky = '';
		my @kys = ();
		for (my $ih = 0; $ih < $bcnt; $ih++) { # for each HASH
			@kys = keys %{$AFileHashs[$ih]}; # get built-ins used for this file
			foreach $ky (@kys) {	# go through the keys
				if ( !($nkys =~ / $ky /) ) { # if NOT already in the list
					$nkys .= $ky.' '; # add it
				}
			}
		}
		@kys = split(/ /, $nkys); # split the list into an array
		foreach $ky (@kys) {	# and add each from the array
			if (length($ky)) {
				if (length($m2) > 76) {
					$m2 .= ",\n";
					$m .= $m2;
					$m2 = $ky;
				} else {
					$m2 .= ', '.$ky;
				}
			}
		}
	}
	$m .= $m2;
	$m .= ', free">'."\n";
	$m .= '<meta name="description" content="page of a computer programmer, with sample perl scripts">'."\n";
	print $oh $m;
	prt("$m") if ($dbg25);
}

sub prtw {
    my ($tx) = shift;
    $tx =~ s/\n$//;
    prt("$tx\n");
    push(@warnings,$tx);
}

sub show_warnings {
    if (@warnings) {
        prt( "\nGot ".scalar @warnings." WARNINGS ...\n" );
        foreach my $line (@warnings) {
            prt("$line\n" );
        }
        prt("\n");
    } else {
        prt("\nNo warnings issued.\n\n");
    }
}

# eof - p2hall03.pl