oldindex.pl to HTML.

index -|- end

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;

index -|- top

checked by tidy  Valid HTML 4.01 Transitional