From: minima Date: Sat, 28 Sep 2002 22:11:01 +0000 (+0000) Subject: debuging changes X-Git-Tag: PRE-1-52~189 X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=f8bcb6f0239cfcec6d31a37b08c7f7e28cbf7628;p=spider.git debuging changes --- diff --git a/perl/Prefix.pm b/perl/Prefix.pm index 005d3309..5b223e9f 100644 --- a/perl/Prefix.pm +++ b/perl/Prefix.pm @@ -138,14 +138,28 @@ sub matchprefix my $pref = shift; for (my $i = length $pref; $i; $i--) { + $matchtotal++; my $s = substr($pref, 0, $i); - my @out = get($s); - if (isdbg('prefix')) { - my $part = $out[0] || "*"; - $part .= '*' unless $part eq '*' || $part eq $s; - dbg("Partial prefix: $pref $s $part" ); - } - return @out if @out && $out[0] eq $s; + my $p = $cache{$s}; + if ($p) { + $hits++; + if (isdbg('prefix')) { + my $percent = $hits * 100 / $matchtotal; + dbg("Partial Prefix Cache Hit: $s Hits: $hits of $matchtotal = $percent\%"); + } + return @$p; + } else { + my @out = get($s); + if (isdbg('prefix')) { + my $part = $out[0] || "*"; + $part .= '*' unless $part eq '*' || $part eq $s; + dbg("Partial prefix: $pref $s $part" ); + } + if (@out && $out[0] eq $s) { + $cache{$s} = \@out; + return @out; + } + } } return (); } @@ -170,7 +184,7 @@ sub extract if ($main::systime - $lasttime >= 15*60) { if (isdbg('prefix')) { my $percent = $hits * 100 / $matchtotal; - dbg("Prefix Cache Cleared, Hits: $hits of $matchtotal = $percent\%") + dbg("Prefix Cache Cleared, Hits: $hits of $matchtotal = $percent\%") ; } my $percent = $hits * 100 / $matchtotal; dbg("Prefix Cache Cleared, $percent\% hits") if isdbg('prefix'); @@ -190,7 +204,7 @@ LM: foreach $call (split /,/, $calls) { $hits++; if (isdbg('prefix')) { my $percent = $hits * 100 / $matchtotal; - dbg("Prefix Cache Hit: $call Hits: $hits of $matchtotal = $percent\%") + dbg("Prefix Cache Hit: $call Hits: $hits of $matchtotal = $percent\%"); } push @out, @$p; next; @@ -272,7 +286,7 @@ LM: foreach $call (split /,/, $calls) { if (@parts == 1) { @nout = matchprefix($parts[0]); if (@nout) { - dbg("got prefix: $call ]") if isdbg('prefix'); + dbg("got prefix: $call = $nout[0]") if isdbg('prefix'); $cache{$call} = \@nout; push @out, @nout; next;