Generated: Tue Feb 2 17:54:46 2010 from oldindex.pl 2006/09/18 12.7 KB.
#!/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;