#!/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
