added misses to be cleared
[spider.git] / perl / Prefix.pm
index 484f462ac24feee8bc338acedd703c79207de3df..a2316a2bf3b49244f8643aa29d77fc4a864481f8 100644 (file)
@@ -151,6 +151,7 @@ sub matchprefix
        for (my $i = length $pref; $i; $i--) {
                $matchtotal++;
                my $s = substr($pref, 0, $i);
+               push @partials, $s;
                my $p = $cache{$s};
                if ($p) {
                        $hits++;
@@ -158,10 +159,10 @@ sub matchprefix
                                my $percent = sprintf "%.1f", $hits * 100 / $misses;
                                dbg("Partial Prefix Cache Hit: $s Hits: $hits/$misses of $matchtotal = $percent\%");
                        }
+                       $cache{$_} = $p for @partials;
                        return @$p;
                } else {
                        $misses++;
-                       push @partials, $s;
                        my @out = get($s);
                        if (isdbg('prefix')) {
                                my $part = $out[0] || "*";
@@ -169,7 +170,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;
                        } 
                }
@@ -201,7 +202,7 @@ sub extract
                }
                %cache =();
                $lasttime = $main::systime;
-               $hits = $matchtotal = 0;
+               $hits = $misses = $matchtotal = 0;
        }
 
 LM:    foreach $call (split /,/, $calls) {
@@ -209,6 +210,7 @@ LM: foreach $call (split /,/, $calls) {
                # first check if the whole thing succeeds either because it is cached
                # or because it simply is a stored prefix as callsign (or even a prefix)
                $matchtotal++;
+               $call =~ s/-\d+$//;             # ignore SSIDs
                my $p = $cache{$call};
                my @nout;
                if ($p) {