#!/Perl
use strict;
use warnings;
package oldindex;
####require "logfile.pl" or die "ERROR: Can not load logfile.pl ...\n";
####use $dbg20, $dbg21, $dbg22, $dbg23, $dbg24;

my $oi_stand_alone = 0;
my $oi_tbl_num = 1;
my $oi_tbl_num3 = 3;

my $tacnt = 0;
my $tacnt3 = 0;

my @oi_larr = ();
my @oi_larr2 = ();
my @oi_hrefs = ();

my @tbl_set = ();
my @tbl_set3 = ();
my @tbl_arr = ();
my @tbl_arr3 = ();
my $no_index = 0;


#########################
## package connection
sub oi_prt($) {
	my ($tx) = shift;
	main::prt( $tx );
}

#sub add_2_array($$) {
#	my ($kw, $tx) = @_;
#	oi_prt("Adding [$kw] [$tx] ...\n");
#	if ($kw == 1) {
#		push((@main::stxRW), $tx);
#	} elsif ($kw == 2) {
#		push((@main::stxBI), $tx);
#	} elsif ($kw == 3) {
#		push((@main::stxVA), $tx);
#	}
#}

#sub add_2_old($$) {
#	my ($k,$v) = @_;
#	###oi_prt( "Adding key [$k]: [$v]...\n" );
#	if (exists $main::HOldbifs{$k}) {
#		oi_prt("\nWARNING: [$k] appears DUPLICATED ...\n had=[".$main::HOldbifs{$k}."\nadding [$v]\n\n");
#		$main::HOldbifs{$k} .= $v;
#	} else {
#		$main::HOldbifs{$k} = $v;
#	}
#}

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

sub trim_line_ends($) {
   my ($ml) = shift;
   $ml = substr($ml,1) while ($ml =~ /^\s/); # each off leading space
   $ml = substr($ml,0,length($ml)-1) while (($ml =~ /\s$/)&&(length($ml))); # and trailing space
   return $ml;
}

#Loading PHP stx [C:/Program Files/EditPlus 2/php.stx] ...
#Got KEYWORD [Reserved words] ...
#Got KEYWORD [Built-in functions] ...
#Got KEYWORD [Variables] ...
sub load_php_stx($) {
	my ($fil) = shift;
	my $kwn = 0;
	my $nal = '';
	my $kw = '';
	my $aln = '';
	oi_prt("Loading PHP stx [$fil] ...\n");
	open IF, "<$fil" or mydie( "ERROR: Unable to open [$fil] ...\n" );
	my @la = <IF>;
	close IF;
	foreach $aln (@la) {
		chomp $aln;
		$aln =~ s/\r$//;
		oi_prt( "Doing [$aln] ...\n" ) if ($dbg25);
		if ($aln =~ /^#/) {
			if ($aln =~ /^#KEYWORD=(.*)/) {
				$kw = $1;
				oi_prt( "Got KEYWORD [$kw] ...\n" );
				if ($kw eq 'Reserved words') {
					$kwn = 1;
					oi_prt( "Set KEYWORD [$kwn] ...\n" ) if ($dbg25);
					next;
				} elsif ($kw eq 'Built-in functions') {
					$kwn = 2;
					oi_prt( "Set KEYWORD [$kwn] ...\n" ) if ($dbg25);
					next;
				} elsif ($kw eq 'Variables') {
					$kwn = 3;
					oi_prt( "Set KEYWORD [$kwn] ...\n" ) if ($dbg25);
					next;
				}
			}
			$kwn = 0;
			oi_prt( "Set KEYWORD [$kwn] ...\n" ) if ($dbg25);
			next;
		} elsif ($aln =~ /^;/) { # skip these 'comments'
			oi_prt( "Skipped [$aln] ...\n" ) if ($dbg25);
			next;
		}
		$nal = trim_line_ends($aln);
		##if (length($aln)) {
		##	main::add_2_array( $kwn, $aln );
		##} else {
		##	oi_prt("OOPS: Failed to get a line???\n");
		##}
		if (length($nal)) {
			main::add_2_array( $kwn, $nal );
		} else {
			oi_prt("OOPS: Failed to get a line???\n") if ($dbg25);
		}
	}
}

####################################
# Reducing a line to bare bones
# Only presently used when loading
# the EditPlus 2 perl.stx file.
####################################
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;
}

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

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

#########################################################
######## keep the OLD index
### this is needed IF files have been DELETED ...

sub get_old_index($) {
	my ($ind) = shift;
	$tacnt = 0;
	$tacnt3 = 0;
	my $lncnt = 0;
	my $ln = '';
	if (open IF, "<$ind") {
		@oi_larr = <IF>; # slurp it all in ...
		close(IF);
		$lncnt = scalar @oi_larr;
		oi_prt( "Got $lncnt lines to process ... from [$ind]\n" );
		###write2file( join('',@oi_larr), 'tempout.txt');
		$ln = tag2newline( join('',@oi_larr), 'td' );
		###$ln = tag2newline( $ln, 'br' );
		@oi_larr2 = split(/\n/, $ln);
		###write2file( join("\n",@oi_larr2), 'tempout3.txt');
		if (get_table_array()) {
			$tacnt = scalar @tbl_arr;
			$tacnt3 = scalar @tbl_arr3;
			oi_prt( "Got $tacnt and $tacnt3 lines to process ... from [$ind]...\n" );
		} else {
			oi_prt( "Failed to find table tbl_num or tbl_num3 ... in [$ind]...\n" );
		}
	} else {
		oi_prt( "Warning: Failed to open $ind ...\n" );
		$no_index = 1;
	}

	if ($tacnt > 0) {
		for (my $i1 = 0; $i1 < $tacnt ; $i1++) {
			$ln = $tbl_arr[$i1]; # extract a line
			if ($ln =~ /<td.*>/i) {
				while ( !($ln =~ /<\/td>/i) ) {
					$i1++;
					if ($i1 < $tacnt) {
						$ln .= ' '.$tbl_arr[$i1]; # extract a line
					} else {
						last;
					}
				}
				# got begin and end of <td>...</td> block
				if ($ln =~ /(<td.*?>)(.*)(<\/td>)/i) {
					my $tds1 = $1;
					my $inb1 = $2;
					my $tde1 = $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>] ...
					oi_prt( "Line [$ln] = \nBlocks [$tds1][$inb1][$tde1] ...\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 ($inb1 =~ /<a\s*href=\"(.*)\">(.*)<\/a>\s*<br>(\d{4}\S*)\s*<br>(\d{1}\S*)\s*/i) {
						my $hrf = $1;
						my $tfil = $2;
						my $dt = $3;
						my $sz = $4;
						my ($yr, $mt, $dy) = split(/\//,$dt);
						###$sz =~ s/,//g;
						#               0     1     2    3    4    5    6    7
						push(@tbl_set, [$hrf, $tfil, $dt, $sz, $yr, $mt, $dy, 0]);
						oi_prt("href=[$hrf], file=[$tfil], date=[$dt][$yr][$mt][$dy], size=[$sz]...\n") if ($dbg22);
					} else {
						oi_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 $fil3 = '';
		for (my $i3 = 0; $i3 < $tacnt3 ; $i3++) {
			$ln = $tbl_arr3[$i3]; # extract a line
			if ($ln =~ /<td.*>/i) {
				$cc = length($ln);
				oi_prt( "$i3 - Line [$ln] $cc...\n" ) if ($dbg24);
				while ( !($ln =~ /<\/td>/i) ) {
					$i3++;
					if ($i3 < $tacnt3) {
						$ln .= ' '.$tbl_arr3[$i3]; # extract a line
					} else {
						last;
					}
				}
				if ($cc != length($ln)) {
					$cc = length($ln);
					oi_prt( "$i3 - 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 $tds3 = $1;
					my $inb3 = $2;
					my $tde3 = $3;
					oi_prt( "$i3 - td[$tds3] in[$inb3] te[$tde3]...\n" ) if ($dbg24);
					if ($ff > 0) {
						$fil3 = collecthrefs($inb3, 1); # remove HREF
						$fil3 = trim_line($fil3);
						if (main::is_built_in($bif)) {
							push(@tbl_set3, [$bif, $fil3, 0]);
							oi_prt( " push(\@tbl_set3, [$bif, $fil3, 0]); ...\n" ) if ($dbg23);
						} else {
							if (($bif =~ /unused/i)||($bif =~ /missed/i)) {
								oi_prt( " Advice: Skipping [$bif] ...\n" );
							} else {
								oi_prt( " Advice: Skipping [$bif] - NOT BUILT IN FUNCTION!\n" );
							}
						}
						$ff = 0;
					} else {
						$bif = $inb3;
						$bif =~ s/\[//;
						$bif =~ s/\]//;
						$bif = 	trim_line($bif);
						if ($bif =~ /<.*?>(.*?)<\/.*?>/) {
							$bif = trim_line($1);
						}
						$ff = 1;
					}
				} else {
					oi_prt( "CHECK ME: Missed <td> ... </td> \n");
				}
			}
		}
	}
	transfer_old_table3();
}

sub transfer_old_table3() {
	$tacnt3 = scalar @tbl_set3;
	if ($tacnt3 > 0) {
		oi_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 (main::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 (@main::AFileNames) {
					if ($fss =~ /$nhf/i) {
						$fss =~ s/$nhf//;
						$elimcnt++;
					}
				}
				$fss = trim_line_ends($fss);
				if (length($fss)) {
					main::add_2_old($bif, $fss);
				} else {
					$elimcnt2++;
				}
			} else {
				oi_prt("WARNING: DISCARDING [$bif] - NOT BUILT-IN!\n");
			}
		}
		#my $nwcnt = scalar keys %HOldbifs;
		#if ($elimcnt > 0) {
		#	oi_prt( "Elimated old files $elimcnt times, avoiding $elimcnt2 bifs being added...\n" );
		#}
		#oi_prt( "Done $tacnt3 in \@tbl_set3 ... now $nwcnt in \%HOldbifs ...\n" );
	} else {
		oi_prt( "YEEK: tbl_set3 is NULL!\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;
	my $lncnt = scalar @oi_larr2;
	my $ln = '';
	my $tblcnt = 0;
	for (my $i = 0; $i < $lncnt ; $i++) {
		$ln = $oi_larr2[$i]; # extract a line
		chomp $ln; # remove LF (\n)
		$ln =~ s/\r$//; # and remove CR, if present
		if ($ln =~ /<table.*>/i) {
			oi_prt( "FOUND TABLE: [$ln] ...\n" );
			$tblcnt++; # bump table counter
			###if (is_table1($tblcnt)) {
			if ($tblcnt == $oi_tbl_num) {
				oi_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 = $oi_larr2[$i]; # extract a line
						chomp $ln; # remove LF (\n)
						$ln =~ s/\r$//; # and remove CR, if present
						if ( $ln =~ /<\/table>/i ) {
							oi_prt( "END TABLE $tblcnt: [$ln] ...\n" ) if ($dbg20);
							push(@tbl_arr,$ln);
							$fnd++;
							last;
						}
						push(@tbl_arr,$ln);
					}
				}
			###} elsif (is_table3($tblcnt)) {
			} elsif ($tblcnt == $oi_tbl_num3) {
				oi_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 = $oi_larr2[$i]; # extract a line
						chomp $ln; # remove LF (\n)
						$ln =~ s/\r$//; # and remove CR, if present
						if ( $ln =~ /<\/table>/i ) {
							oi_prt( "END TABLE $tblcnt: [$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;
				}
				### oi_prt("Got [$hrf] ...\n");
				if ($hrf =~ /href=["'](\S+)["']./i) {
					$hrf = $1;
					push(@oi_hrefs,$hrf);
					### oi_prt("Got [$hrf] ...\n");
				}
			} elsif ($hrf =~ /^<\/a>$/i) {
				if ($del == 0) {
					$ntxt .= $hrf;
				}
			} else {
				$ntxt .= $hrf;
			}
		} else {
			$ntxt .= $ch;
		}
	}
	return $ntxt;
}

###################################################################
if ($oi_stand_alone) {
	my $old = 'temp2/index.htm';
	my $php_stx = 'C:/Program Files/EditPlus 2/php.stx';

	load_php_stx( $php_stx );
	oi_prt( "Loaded ".scalar @main::stxRW." RW, ".scalar @main::stxBI." BI, and ".scalar @main::stxVA." vars\n" );
	get_old_index($old);
}

1;

