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