test9.pl to HTML.

index -|- end

Generated: Tue Feb 2 17:54:58 2010 from test9.pl 2006/10/27 4.9 KB.

#!/Perl -w
use strict;
my $txt = 'The quick brown fox jumps over the lazy dog';
my $txt2 = substr $txt, -1;
my %HUsedpack = ();
my $ind_file = '';
my @hrefs = ();
print "[$txt]\n";
print "[$txt2]\n";
$txt = 'use strict; # with comment ...';
$ind_file = 'file1.htm';
show_pack($txt);
show_pack('use Digest::MD5  qw(md5 md5_hex md5_base64);');
show_pack('use File::stat; # to get the file date');
$ind_file = 'file2.htm';
show_pack('use File::stat; # to get the file date');
$ind_file = 'file2.htm';
show_pack('use File::stat; # to get the file date');
$ind_file = 'file3.htm';
show_pack('use File::stat; # to get the file date');
my $cnt = scalar keys(%HUsedpack);
print "Got $cnt items in \%HUsedpack ...\n";
foreach my $k (keys %HUsedpack) {
   my $v = $HUsedpack{$k};
   print "k=[$k] v=[$v]\n";
}
my $tag = "<td valign=top style='width:396.3pt;border:outset 1.0pt;padding:\n 0cm 5.4pt 0cm 5.4pt;height:36.0pt'>";
my $t2 = $tag;
$t2 =~ s/\r/ /g;
$t2 =~ s/\n/ /g;
if ($t2 =~ m/^<td(.*)>/mi) {
   print "is TAG ...[$1] \n";
} else {
   print "NOT TAG \n";
}
my $tag2 = "<td valign=top style='width:396.3pt;border:outset 1.0pt;padding:\n 0cm 5.4pt 0cm 5.4pt;height:36.0pt'>";
my $tg3 = del_td_style($tag2);
print "New [$tg3]\n";
my $val1 = '"this is double quoted"';
my $val2 = "'this is single quoted'";
print "[$val1] becomes [" . strip_quotes($val1) ."]\n";
print "[$val2] becomes [" . strip_quotes($val2) ."]\n";
$txt = '<a href="URL">name</a>';
$t2 = collecthrefs($txt,1);
print "[$txt], now [$t2] ..\n";
$txt = '<a name="URL"></a>bif';
$t2 = collecthrefs($txt,1);
print "[$txt], now [$t2] ..\n";
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 strip_quotes {
   my ($tx) = shift;
   $tx =~ s/^('|")//;
   $tx =~ s/('|")$//;
   return $tx;
}
sub trim_tail {
   my ($ln) = shift;
   while ($ln =~ /\s$/m) {
      $ln = substr($ln,0, length($ln) - 1);
   }
   return $ln;
}
sub del_td_style {
   my ($td) = shift;
   my $mx = length($td);
   my ($j, $c, $d);
   my $ntd = '';
   my $hds = 0;
   my $ss = '';
   $d = '';
   for ($j = 0; $j < $mx; $j++) {
      $c = substr($td,$j,1);
      if ($hds && ($c =~ /s/i) && (($mx - $j) > 7)) {
         $ss = substr($td,$j); # get balance
         if ($ss =~ /^style=(.*)/) {
            $j += 6;
            $d = substr($td,$j,1); # get " or '
            if (($d eq '"')||($d eq "'")) {
               $j++;
            } else {
               $d = ' ';
            }
            for ( ; $j < $mx; $j++) {
               $c = substr($td,$j,1);
               if (($c eq $d)||($c eq '>')) {
                  last;
               }
            }
         }
      }
      if ($c =~ /\s/) {
         $hds = 1;
      } else {
         $hds = 0;
      }
      if ($c ne $d) {
         if ($c eq '>') {
            $ntd = trim_tail($ntd);
         }
         $ntd .= $c;
      }
      $d = '';
   }
   return $ntd;
}
sub trimall {
   my ($ln) = shift;
   chomp $ln;
   $ln =~ s/\r$//;
   $ln =~ s/\t/ /g;
   while ($ln =~ /\s\s/) {
      $ln =~ s/\s\s/ /g;
   }
   while ($ln =~ /^\s/) {
      $ln = substr($ln,1);
   }
   while ($ln =~ /\s$/) {
      $ln = substr($ln,0, length($ln) - 1);
   }
   return $ln;
}
sub show_pack_simple {
   my ($tx) = $_[0];
   if ($tx =~ /^use\s+/) {
      my $off = index($tx,';');
      if ($off > 3) {
         $tx = substr($tx,0,$off);
         print "[$tx]\n";
         if ($tx =~ /^use\s+(.+)/) {
            my $pkg = trimall($1);
            print "[$pkg]\n";
         }
      }
   }
}
sub prt {
   my ($t) = shift;
   print $t;
}
sub show_pack {
   my ($lne) = $_[0];
   my $ll = length($lne);
   my $i2 = index($lne, ';');
   my $dn = 0;
   my $pkg = '';
   my $v = '';
   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 [$ind_file] ... [$_[0]]\n" );
      } elsif ($dn == 3) {
         prt( "Repeat USE [$pkg] in [$ind_file] ...[$_[0]]\n" );
      } else {
         prt( "Added USE [$pkg] in [$ind_file] ...[$_[0]]\n" );
      }
   } else {
      prt( "WARNING: failed USE with $_[0] ...[$ind_file]\n" );
   }
}
# eof

index -|- top

checked by tidy  Valid HTML 4.01 Transitional