From 4b3a266a60049cbadb409a936e0888759b9b1fb6 Mon Sep 17 00:00:00 2001
From: minima <minima>
Date: Sun, 29 Sep 2002 00:26:49 +0000
Subject: [PATCH] more detail changes

---
 perl/Prefix.pm | 48 ++++++++++++++++++++++++++++++++++--------------
 1 file changed, 34 insertions(+), 14 deletions(-)

diff --git a/perl/Prefix.pm b/perl/Prefix.pm
index cb626269..484f462a 100644
--- a/perl/Prefix.pm
+++ b/perl/Prefix.pm
@@ -24,28 +24,38 @@ $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0))
 $main::build += $VERSION;
 $main::branch += $BRANCH;
 
-use vars qw($db  %prefix_loc %pre %cache $lasttime $hits $matchtotal);
+use vars qw($db  %prefix_loc %pre %cache $misses $hits $matchtotal $lasttime);
 
 $db = undef;					# the DB_File handle
 %prefix_loc = ();				# the meat of the info
 %pre = ();						# the prefix list
 %cache = ();					# a runtime cache of matched prefixes
 $lasttime = 0;					# last time this cache was cleared
-$hits = $matchtotal = 1;		# cache stats
+$hits = $misses = $matchtotal = 1;		# cache stats
+
+#my $cachefn = "$main::data/prefix_cache";
 
 sub load
 {
+	# untie every thing
+#	unlink $cachefn;
+	
 	if ($db) {
 		undef $db;
 		untie %pre;
 		%pre = ();
 		%prefix_loc = ();
+		untie %cache;
 	}
-	$db = tie(%pre, "DB_File", undef, O_RDWR|O_CREAT, 0666, $DB_BTREE) or confess "can't tie \%pre ($!)";  
+
+	# tie the main prefix database
+	$db = tie(%pre, "DB_File", undef, O_RDWR|O_CREAT, 0664, $DB_BTREE) or confess "can't tie \%pre ($!)";  
 	my $out = $@ if $@;
 	do "$main::data/prefix_data.pl" if !$out;
 	$out = $@ if $@;
-	#  print Data::Dumper->Dump([\%pre, \%prefix_loc], [qw(pre prefix_loc)]);
+
+	# tie the prefix cache
+#	tie (%cache, "DB_File", $cachefn, O_RDWR|O_CREAT, 0664, $DB_HASH) or confess "can't tie prefix cache to $cachefn $!";
 	return $out;
 }
 
@@ -145,11 +155,12 @@ sub matchprefix
 		if ($p) {
 			$hits++;
 			if (isdbg('prefix')) {
-				my $percent = sprintf "%.1f", $hits * 100 / $matchtotal;
-				dbg("Partial Prefix Cache Hit: $s Hits: $hits of $matchtotal = $percent\%");
+				my $percent = sprintf "%.1f", $hits * 100 / $misses;
+				dbg("Partial Prefix Cache Hit: $s Hits: $hits/$misses of $matchtotal = $percent\%");
 			}
 			return @$p;
 		} else {
+			$misses++;
 			push @partials, $s;
 			my @out = get($s);
 			if (isdbg('prefix')) {
@@ -158,7 +169,7 @@ sub matchprefix
 				dbg("Partial prefix: $pref $s $part" );
 			} 
 			if (@out && $out[0] eq $s) {
-				$cache{$_} = \@out for @partials;
+				$cache{$_} = [ @out ] for @partials;
 				return @out;
 			} 
 		}
@@ -181,17 +192,17 @@ sub extract
 	my $p;
 	my @parts;
 	my ($call, $sp, $i);
-  
+
 	# clear out the cache periodically to stop it growing for ever.
-	if ($main::systime - $lasttime >= 15*60) {
+	if ($main::systime - $lasttime >= 20*60) {
 		if (isdbg('prefix')) {
-			my $percent = sprintf "%.1f", $hits * 100 / $matchtotal;
-			dbg("Prefix Cache Cleared, Hits: $hits of $matchtotal = $percent\%") ;
+			my $percent = sprintf "%.1f", $hits * 100 / $misses;
+			dbg("Prefix Cache Cleared, Hits: $hits/$misses of $matchtotal = $percent\%") ;
 		}
 		%cache =();
 		$lasttime = $main::systime;
 		$hits = $matchtotal = 0;
-	} 
+	}
 
 LM:	foreach $call (split /,/, $calls) {
 
@@ -203,14 +214,15 @@ LM:	foreach $call (split /,/, $calls) {
 		if ($p) {
 			$hits++;
 			if (isdbg('prefix')) {
-				my $percent = sprintf "%.1f", $hits * 100 / $matchtotal;
-				dbg("Prefix Cache Hit: $call Hits: $hits of $matchtotal = $percent\%");
+				my $percent = sprintf "%.1f", $hits * 100 / $misses;
+				dbg("Prefix Cache Hit: $call Hits: $hits/$misses of $matchtotal = $percent\%");
 			}
 			push @out, @$p;
 			next;
 		} else {
 			@nout =  get($call);
 			if (@nout && $nout[0] eq $call) {
+				$misses++;
 				$cache{$call} = \@nout;
 				dbg("got exact prefix: $nout[0]") if isdbg('prefix');
 				push @out, @nout;
@@ -231,6 +243,7 @@ LM:	foreach $call (split /,/, $calls) {
 			@nout = get($s);
 			if (@nout && $nout[0] eq $s) {
 				dbg("got exact multipart prefix: $call $s") if isdbg('prefix');
+				$misses++;
 				$cache{$call} = \@nout;
 				push @out, @nout;
 				next;
@@ -250,6 +263,7 @@ LM:	foreach $call (split /,/, $calls) {
 				my @try = get($s);
 				if (@try && $try[0] eq $s) {
 					dbg("got 3 part prefix: $call $s") if isdbg('prefix');
+					$misses++;
 					$cache{$call} = \@try;
 					push @out, @try;
 					next;
@@ -272,6 +286,7 @@ LM:	foreach $call (split /,/, $calls) {
 				my @try = get($s);
 				if (@try && $try[0] eq $s) {
 					dbg("got 2 part prefix: $call $s") if isdbg('prefix');
+					$misses++;
 					$cache{$call} = \@try;
 					push @out, @try;
 					next;
@@ -287,6 +302,7 @@ LM:	foreach $call (split /,/, $calls) {
 			@nout = matchprefix($parts[0]);
 			if (@nout) {
 				dbg("got prefix: $call = $nout[0]") if isdbg('prefix');
+				$misses++;
 				$cache{$call} = \@nout;
 				push @out, @nout;
 				next;
@@ -331,13 +347,16 @@ L1:		for ($n = 0; $n < @parts; $n++) {
 						dbg("Compound prefix: $try $part" );
 					}
 					if (@try && $try eq $try[0]) {
+						$misses++;
 						$cache{$call} = \@try;
 						push @out, @try;
 					} else {
+						$misses++;
 						$cache{$call} = \@nout;
 						push @out, @nout;
 					}
 				} else {
+					$misses++;
 					$cache{$call} = \@nout;
 					push @out, @nout;
 				}
@@ -347,6 +366,7 @@ L1:		for ($n = 0; $n < @parts; $n++) {
 
 		# we are a pirate!
 		@nout = matchprefix('Q');
+		$misses++;
 		$cache{$call} = \@nout;
 		push @out, @nout;
 	}
-- 
2.43.0