added the state filtering stuff
authorminima <minima>
Sun, 13 Oct 2002 19:35:41 +0000 (19:35 +0000)
committerminima <minima>
Sun, 13 Oct 2002 19:35:41 +0000 (19:35 +0000)
tried to speed up the AUTOLOADING
tried to fix the near dupe check again

18 files changed:
Changes
cmd/Commands_en.hlp
cmd/load/usdb.pl
cmd/show/prefix.pl
perl/AnnTalk.pm
perl/Bands.pm
perl/DXChannel.pm
perl/DXDb.pm
perl/DXMsg.pm
perl/DXProt.pm
perl/DXUser.pm
perl/Filter.pm
perl/Prefix.pm
perl/Prot.pm
perl/Route.pm
perl/Spot.pm
perl/USDB.pm
perl/cluster.pl

diff --git a/Changes b/Changes
index e6cab4615ccad0cf7cdfbb7a2e37a5da5c5f1686..193f9cc0184c2b9db56394b018a2f9b8bb65fa9d 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,25 @@
+13Oct02=======================================================================
+1. A large change has occurred. There is now some (optional) US state recog-
+nition. This is in its early stages but appears to work for me. You will need
+to download the database at http://www.dxcluster.org/download/usdbraw, save it
+in /spider/data and the run /spider/perl/create_usdb.pl. BE WARNED this will
+take several minutes. You can do this while the node is running. There is a 
+planned method of keeping the US DB up to date with smaller (ie < 5Mb) patch
+files once a week but you will have to wait a bit for the code to bed down 
+first. You can filter on routes, spots and announces using 'call_state' or
+'by_state' and a comma separated list of state codes. The HELP has been 
+updated (which may help...). 
+
+Once you have run the create_usdb.pl you will need to restart.
+
+If you don't need this, then don't run create_usdb.pl it will simply be
+a waste of time. The run-time version is 24Mb and has 840,000 odd entries
+in it. This does not replace or supplant sh/qrz (sorry Charlie [who put me
+up to this]). 
+
+2. There are a number of other niff-naff changes which I hope will improve
+rather than hinder your user experience (including check forward as well as
+back for those speedy clocked dupes mentioned below).  
 12Oct02=======================================================================
 1. attempt to improve the "check back for 5 minutes to see if this spot is 
 the same as a previous one but for the time spotted" dupe check.
index 4058c8c72f3ebe833cbc8278caef4a4d37d2a09b..eca6dacb8e46479ee8a30a0c33d5e770ffdeafdd 100644 (file)
@@ -32,9 +32,11 @@ You can use any of the following things in this line:-
   origin_dxcc <prefixes or numbers>    eg: 61,62 (from eg: sh/pre G)
   origin_itu <prefixes or numbers>     or: G,GM,GW
   origin_zone <prefixes or numbers>
+  origin_state <states>                eg: VA,NH,RI,NH
   by_dxcc <prefixes or numbers>
   by_itu <prefixes or numbers>
   by_zone <prefixes or numbers>
+  by_state <states>
   channel <prefixes>
   wx 1                     filter WX announces
   dest <prefixes>          eg: 6MUK,WDX      (distros)
@@ -47,6 +49,10 @@ some examples:-
 or
   acc/ann by G,M,2 
 
+for american states
+
+  acc/ann by_state va,nh,ri,nh
+
 You can use the tag 'all' to accept everything eg:
 
   acc/ann all
@@ -74,16 +80,25 @@ You can use any of the following things in this line:-
   call_dxcc <prefixes or numbers>    eg: 61,62 (from eg: sh/pre G)
   call_itu <prefixes or numbers>     or: G,GM,GW
   call_zone <prefixes or numbers>
+  call_state <states>                eg: VA,NH,RI,NH
   origin <prefixes>      really the interface it came in on
   origin_dxcc <prefixes or numbers>    eg: 61,62 (from eg: sh/pre G)
   origin_itu <prefixes or numbers>     or: G,GM,GW
   origin_zone <prefixes or numbers>
+  origin_state <states>                eg: VA,NH,RI,NH
 
 some examples:-
 
   acc/route gb7djk call_dxcc 61,38 (send only UK+EIRE nodes)
   acc/route gb7djk call gb7djk     (equiv to SET/ISOLATE)
 
+you can now use 'by' as a synonym for 'call' so:
+
+  by = call
+  by_dxcc = call_dxcc 
+
+and so on
+
 You can use the tag 'all' to accept everything eg:
 
   acc/route all
@@ -106,12 +121,16 @@ You can use any of the following things in this line:-
   call_dxcc <prefixes or numbers>    eg: 61,62 (from eg: sh/pre G)
   call_itu <prefixes or numbers>     or: G,GM,GW
   call_zone <prefixes or numbers>
+  call_state <states>                eg: VA,NH,RI,ME
   by_dxcc <prefixes or numbers>
   by_itu <prefixes or numbers>
   by_zone <prefixes or numbers>
+  by_state <states>                eg: VA,NH,RI,ME
   origin <prefixes>
   channel <prefixes>
 
+'call' means the callsign that has spotted 'by' whoever.
+
 For frequencies, you can use any of the band names defined in
 SHOW/BANDS and you can use a subband name like: cw, rtty, data, ssb -
 thus: hf/ssb. You can also just have a simple range like: 0/30000 -
@@ -127,6 +146,10 @@ You can use the tag 'all' to accept everything, eg:
 
   acc/spot 3 all
 
+for US states 
+
+  acc/spots by_state VA,NH,RI,MA,ME
+
 but this probably for advanced users...
 
 
@@ -598,7 +621,7 @@ you have specified is taken (ie reject means ignore it and accept
 means gimme it).
 
 The important thing to remember is that if you specify a 'reject'
-filter (all the lines in it say 'reject/spots' (for instance) then if
+filter (all the lines in it say 'reject/spots' (for instance)) then if
 a spot comes in that doesn't match any of the lines then you will get
 it BUT if you specify an 'accept' filter then any spots that don't
 match are dumped. For example if I have a one line accept filter:-
@@ -625,6 +648,10 @@ you are confortable with the way it works. Yes, you can mix them
 don't try this at home until you can analyse the results that you get
 without ringing up the sysop for help.
 
+Another useful addition now is filtering by US state
+
+  accept/spots by_state VA,NH,RI,ME
+
 You can arrange your filter lines into logical units, either for your
 own understanding or simply convenience. I have one set frequently:-
 
@@ -954,9 +981,11 @@ You can use any of the following things in this line:-
   origin_dxcc <prefixes or numbers>    eg: 61,62 (from eg: sh/pre G)
   origin_itu <prefixes or numbers>     or: G,GM,GW
   origin_zone <prefixes or numbers>
+  origin_state <states>                eg: VA,NH,RI,ME
   by_dxcc <prefixes or numbers>
   by_itu <prefixes or numbers>
   by_zone <prefixes or numbers>
+  by_state <states>                eg: VA,NH,RI,ME
   channel <prefixes>
   wx 1                     filter WX announces
   dest <prefixes>          eg: 6MUK,WDX      (distros)
@@ -996,12 +1025,16 @@ You can use any of the following things in this line:-
   call_dxcc <prefixes or numbers>    eg: 61,62 (from eg: sh/pre G)
   call_itu <prefixes or numbers>     or: G,GM,GW
   call_zone <prefixes or numbers>
+  call_state <states>                eg: VA,NH,RI,ME
   by_dxcc <prefixes or numbers>
   by_itu <prefixes or numbers>
   by_zone <prefixes or numbers>
+  by_state <states>                eg: VA,NH,RI,ME
   origin <prefixes>
   channel <prefixes>
 
+'call' means the callsign that has spotted 'by' whoever.
 For frequencies, you can use any of the band names defined in
 SHOW/BANDS and you can use a subband name like: cw, rtty, data, ssb -
 thus: hf/ssb. You can also just have a simple range like: 0/30000 -
@@ -1032,10 +1065,12 @@ You can use any of the following things in this line:-
   call_dxcc <prefixes or numbers>    eg: 61,62 (from eg: sh/pre G)
   call_itu <prefixes or numbers>     or: G,GM,GW
   call_zone <prefixes or numbers>
+  call_state <states>                eg: VA,NH,RI,ME
   origin <prefixes>      really the interface it came in on
   origin_dxcc <prefixes or numbers>    eg: 61,62 (from eg: sh/pre G)
   origin_itu <prefixes or numbers>     or: G,GM,GW
   origin_zone <prefixes or numbers>
+  origin_state <states>                eg: VA,NH,RI,ME
 
 some examples:-
 
@@ -1045,6 +1080,8 @@ You can use the tag 'all' to reject everything eg:
 
   rej/route all     (equiv to [very] restricted mode)
 
+as with ACCEPT/ROUTE 'by' is now a synonym for 'call'.
+
 === 8^REJECT/SPOTS <call> [input] [0-9] <pattern>^Spot filter sysop version
 This version allows a sysop to set a filter for a callsign as well as the
 default for nodes and users eg:-
index 7ed76067a9dc4082ca2b8820597ba4cf698d28e7..bd45547d106e8d5cd7c52a8fd054c58d7c4afe89 100644 (file)
@@ -18,5 +18,6 @@ return (1, $self->msg('e5')) if $self->priv < 9;
 return (1, $self->msg('e3', "load/usdb", $line)) if $line && !-r $line;
 $line = "$main::data/usdbraw" unless $line;
 push @out, (USDB::load($line));
+USDB::init() unless @OUT;
 @out = ($self->msg('ok')) unless @out;
 return (1, @out); 
index 200a4f1ee5331f98d547b49c3acab674a99b19cc..df0f192c451632807d5bbbcb9ef7612ea2f3e40a 100644 (file)
@@ -20,6 +20,9 @@ foreach $l (@list) {
                push @out, sprintf "%s DXCC: %d ITU: %d CQ: %d LL: %s %s (%s, %s)", uc $l, $a->dxcc, $a->itu, $a->cq, slat($a->lat), slong($a->long), $pre, $a->name;
                $l = " " x length $l;
        }
+       if ($ans[0]->state) {
+               push @out, sprintf "%s City: %s State: %s", $l, join (' ', map {ucfirst} split(/\s+/, lc $ans[0]->city)), $ans[0]->state;
+       }
 }
 
 return (1, @out);
index 58c2a4394460d2cdd11671a10f2e94678601557c..30f8964c4aee36ae463effa203b2c9a9dd935cd0 100644 (file)
@@ -34,6 +34,8 @@ $filterdef = bless ([
                          ['origin_dxcc', 'nc', 10],
                          ['origin_itu', 'ni', 11],
                          ['origin_zone', 'nz', 12],
+                         ['by_state', 'nz', 13],
+                         ['origin_state', 'nz', 14],
                         ], 'Filter::Cmd');
 
 use vars qw($VERSION $BRANCH);
index 069c8ccd1503e9dc0104c9a860060664d6f7b7c5..65849c9a5d0c3e732420e44eb175f7951930625b 100644 (file)
@@ -137,18 +137,21 @@ sub field_prompt
        return $valid{$ele};
 }
 
-no strict;
+#no strict;
 sub AUTOLOAD
 {
+       no strict;
        my $self = shift;
        my $name = $AUTOLOAD;
        return if $name =~ /::DESTROY$/;
-       $name =~ s/.*:://o;
+       $name =~ s/^.*:://o;
   
        # this clever line of code creates a subroutine which takes over from autoload
        # from OO Perl - Conway
-       *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
-       @_ ? $self->{$name} = shift : $self->{$name} ;
+       *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};
+       &$AUTOLOAD($self, @_);
+#      *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
+#      @_ ? $self->{$name} = shift : $self->{$name} ;
 }
 
 1;
index e6e0d1b42634e365022c66650788ce979c36e862..372599af1a3806dec7c1c37e540345ce58804e45 100644 (file)
@@ -622,20 +622,23 @@ sub broadcast_list
 }
 
 
-no strict;
+#no strict;
 sub AUTOLOAD
 {
        my $self = shift;
+       no strict;
        my $name = $AUTOLOAD;
        return if $name =~ /::DESTROY$/;
-       $name =~ s/.*:://o;
+       $name =~ s/^.*:://o;
   
        confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
 
        # this clever line of code creates a subroutine which takes over from autoload
        # from OO Perl - Conway
-       *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
-    @_ ? $self->{$name} = shift : $self->{$name} ;
+       *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};
+       &$AUTOLOAD($self, @_);
+#      *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
+#    @_ ? $self->{$name} = shift : $self->{$name} ;
 }
 
 
index 03e84e0cf9ad7c1c43c056fa5dfb393751146002..b7a886716df0181f76f4fe694179cde9340afee8 100644 (file)
@@ -345,19 +345,22 @@ sub field_prompt
        return $valid{$ele};
 }
 
-no strict;
+#no strict;
 sub AUTOLOAD
 {
        my $self = shift;
+       no strict;
        my $name = $AUTOLOAD;
        return if $name =~ /::DESTROY$/;
-       $name =~ s/.*:://o;
+       $name =~ s/^.*:://o;
   
        confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
        # this clever line of code creates a subroutine which takes over from autoload
        # from OO Perl - Conway
-       *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
-       @_ ? $self->{$name} = shift : $self->{$name} ;
+       *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};
+       &$AUTOLOAD($self, @_);
+#      *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
+#      @_ ? $self->{$name} = shift : $self->{$name} ;
 }
 
 1;
index 3ea3211542a9cd80e4c1956833730b67a680d5de..10d1e4dc77bb816157501d3bf30a66a2f4d0431f 100644 (file)
@@ -1506,19 +1506,22 @@ sub import_one
        return @out;
 }
 
-no strict;
+#no strict;
 sub AUTOLOAD
 {
        my $self = shift;
+       no strict;
        my $name = $AUTOLOAD;
        return if $name =~ /::DESTROY$/;
-       $name =~ s/.*:://o;
+       $name =~ s/^.*:://o;
        
        confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
        # this clever line of code creates a subroutine which takes over from autoload
        # from OO Perl - Conway
-       *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
-       @_ ? $self->{$name} = shift : $self->{$name} ;
+       *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};
+       &$AUTOLOAD($self, @_);
+#      *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
+#      @_ ? $self->{$name} = shift : $self->{$name} ;
 }
 
 1;
index 9a4f367339a7699459028bcec4bb813a2e36afb7..2bfb9e5e61fa7ac44a7ae669fd18b21f230c78ff 100644 (file)
@@ -1498,24 +1498,27 @@ sub send_announce
 
        # obtain country codes etc 
        my ($ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq) = (0..0);
+       my ($ann_state, $org_state) = ("", "");
        my @dxcc = Prefix::extract($_[0]);
        if (@dxcc > 0) {
                $ann_dxcc = $dxcc[1]->dxcc;
                $ann_itu = $dxcc[1]->itu;
                $ann_cq = $dxcc[1]->cq;                                         
+               $ann_state = $dxcc[1]->state;
        }
        @dxcc = Prefix::extract($_[4]);
        if (@dxcc > 0) {
                $org_dxcc = $dxcc[1]->dxcc;
                $org_itu = $dxcc[1]->itu;
                $org_cq = $dxcc[1]->cq;                                         
+               $org_state = $dxcc[1]->state;
        }
 
        if ($self->{inannfilter}) {
                my ($filter, $hops) = 
                        $self->{inannfilter}->it(@_, $self->{call}, 
                                                                         $ann_dxcc, $ann_itu, $ann_cq,
-                                                                        $org_dxcc, $org_itu, $org_cq);
+                                                                        $org_dxcc, $org_itu, $org_cq, $ann_state, $org_state);
                unless ($filter) {
                        dbg("PCPROT: Rejected by input announce filter") if isdbg('chanerr');
                        return;
@@ -1875,7 +1878,7 @@ sub send_route
                if (!$self->{isolate} && $self->{routefilter}) {
                        $filter = undef;
                        if ($r) {
-                               ($filter, $hops) = $self->{routefilter}->it($self->{call}, $self->{dxcc}, $self->{itu}, $self->{cq}, $r->call, $r->dxcc, $r->itu, $r->cq);
+                               ($filter, $hops) = $self->{routefilter}->it($self->{call}, $self->{dxcc}, $self->{itu}, $self->{cq}, $r->call, $r->dxcc, $r->itu, $r->cq, $self->{state}, $r->{state});
                                if ($filter) {
                                        push @rin, $r;
                                } else {
@@ -1976,7 +1979,7 @@ sub in_filter_route
        my ($filter, $hops) = (1, 1);
        
        if ($self->{inroutefilter}) {
-               ($filter, $hops) = $self->{inroutefilter}->it($self->{call}, $self->{dxcc}, $self->{itu}, $self->{cq}, $r->call, $r->dxcc, $r->itu, $r->cq);
+               ($filter, $hops) = $self->{inroutefilter}->it($self->{call}, $self->{dxcc}, $self->{itu}, $self->{cq}, $r->call, $r->dxcc, $r->itu, $r->cq, $self->state, $r->state);
                dbg("PCPROT: $self->{call}/" . $r->call . ' rejected by in_filter_route') if !$filter && isdbg('chanerr');
        }
        return $filter;
index 6b85afb3025c4883d247a46b3735f8220cf98d58..afc70cb0e08516f0331b19264782528950e8d823 100644 (file)
@@ -86,26 +86,29 @@ $lrusize = 2000;
                  build => '1,Build',
                 );
 
-no strict;
+#no strict;
 sub AUTOLOAD
 {
        my $self = shift;
+       no strict;
        my $name = $AUTOLOAD;
   
        return if $name =~ /::DESTROY$/;
-       $name =~ s/.*:://o;
+       $name =~ s/^.*:://o;
   
        confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
        # this clever line of code creates a subroutine which takes over from autoload
        # from OO Perl - Conway
-       *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
-       if (@_) {
-               $self->{$name} = shift;
-       }
-       return $self->{$name};
+       *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};
+       &$AUTOLOAD($self, @_);
+#      *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
+#      if (@_) {
+#              $self->{$name} = shift;
+#      }
+#      return $self->{$name};
 }
 
-use strict;
+#use strict;
 
 #
 # initialise the system
index 66c3ff7acb2aceb64b1a1ec1265c2cda8d94bcf3..0ca71917db987cb5637ebe5bec404b1ddb611e64 100644 (file)
@@ -494,6 +494,11 @@ sub parse
                                                        my @pre = Prefix::to_ciz($cmd, @val);
                                                        return ('numpre', $dxchan->msg('e27', $_)) unless @pre;
                                                        $s .= "(" . join(' || ', map {"\$r->[$fref->[2]]==$_"} @pre) . ")";
+                                               } elsif ($fref->[1] =~ /^ns$/ ) {    # for DXCC, ITU, CQ Zone    
+                                                       my $cmd = $fref->[1];
+                                                       my @pre = Prefix::to_ciz($cmd, @val);
+                                                       return ('numpre', $dxchan->msg('e27', $_)) unless @pre;
+                                                       $s .= "(" . "!\$USDB::present || grep \$r->[$fref->[2]] eq \$_, qw(" . join(' ' ,map {uc} @pre) . "))";
                                                } elsif ($fref->[1] eq 'r') {
                                                        my @t;
                                                        for (@val) {
index 246dbb659eb2d53ead8a74d78c110140aec01cb9..5733ff0254c689dabde03a16371b1f412b442d48 100644 (file)
@@ -14,6 +14,7 @@ use DB_File;
 use Data::Dumper;
 use DXDebug;
 use DXUtil;
+use USDB;
 use LRU;
 
 use strict;
@@ -129,7 +130,32 @@ sub next
        return () if $db->seq($gotkey, $ref, R_NEXT);
        return () if $key ne substr $gotkey, 0, length $key;
   
-       return ($gotkey, map { $prefix_loc{$_} } split ',', $ref);
+       return ($gotkey,  map { $prefix_loc{$_} } split ',', $ref);
+}
+
+#
+# put the key LRU incluing the city state info
+#
+
+sub lru_put
+{
+       my ($call, $ref) = @_;
+       my @s = USDB::get($call);
+       
+       if (@s) {
+               # this is deep magic, because this is a reference to static data, it
+        # must be copied.
+               my $h = { %{$ref->[1]} };
+               bless $h, ref $ref->[1];
+               $h->{city} = $s[0];
+               $h->{state} = $s[1];
+               $ref->[1] = $h;
+       } else {
+               $ref->[1]->{city} = $ref->[1]->{state} = "" unless exists $ref->[1]->{state};
+       }
+       
+       dbg("Prefix::lru_put $call -> ($ref->[1]->{city}, $ref->[1]->{state})") if isdbg('prefix');
+       $lru->put($call, $ref);
 }
 
 # 
@@ -153,7 +179,7 @@ sub matchprefix
                                my $percent = sprintf "%.1f", $hits * 100 / $misses;
                                dbg("Partial Prefix Cache Hit: $s Hits: $hits/$misses of $matchtotal = $percent\%");
                        }
-                       $lru->put($_, $p) for @partials;
+                       lru_put($_, $p) for @partials;
                        return @$p;
                } else {
                        $misses++;
@@ -164,7 +190,6 @@ sub matchprefix
                                dbg("Partial prefix: $pref $s $part" );
                        } 
                        if (@out && $out[0] eq $s) {
-                               $lru->put($_, \@out) for @partials;
                                return @out;
                        } 
                }
@@ -205,10 +230,21 @@ LM:       foreach $call (split /,/, $calls) {
                        push @out, @$p;
                        next;
                } else {
-                       @nout =  get($call);
+                       
+                       # is it in the USDB, force a matchprefix to match?
+                       my @s = USDB::get($call);
+                       if (@s) {
+                               @nout = get($call);
+                               @nout = matchprefix($call) unless @nout;
+                               $nout[0] = $call if @nout;
+                       } else {
+                               @nout =  get($call);
+                       }
+
+                       # now store it
                        if (@nout && $nout[0] eq $call) {
                                $misses++;
-                               $lru->put($call, \@nout);
+                               lru_put($call, \@nout);
                                dbg("got exact prefix: $nout[0]") if isdbg('prefix');
                                push @out, @nout;
                                next;
@@ -229,7 +265,7 @@ LM: foreach $call (split /,/, $calls) {
                        if (@nout && $nout[0] eq $s) {
                                dbg("got exact multipart prefix: $call $s") if isdbg('prefix');
                                $misses++;
-                               $lru->put($call, \@nout);
+                               lru_put($call, \@nout);
                                push @out, @nout;
                                next;
                        }
@@ -249,7 +285,7 @@ LM: foreach $call (split /,/, $calls) {
                                if (@try && $try[0] eq $s) {
                                        dbg("got 3 part prefix: $call $s") if isdbg('prefix');
                                        $misses++;
-                                       $lru->put($call, \@try);
+                                       lru_put($call, \@try);
                                        push @out, @try;
                                        next;
                                }
@@ -272,7 +308,7 @@ LM: foreach $call (split /,/, $calls) {
                                if (@try && $try[0] eq $s) {
                                        dbg("got 2 part prefix: $call $s") if isdbg('prefix');
                                        $misses++;
-                                       $lru->put($call, \@try);
+                                       lru_put($call, \@try);
                                        push @out, @try;
                                        next;
                                }
@@ -288,7 +324,7 @@ LM: foreach $call (split /,/, $calls) {
                        if (@nout) {
                                dbg("got prefix: $call = $nout[0]") if isdbg('prefix');
                                $misses++;
-                               $lru->put($call, \@nout);
+                               lru_put($call, \@nout);
                                push @out, @nout;
                                next;
                        }
@@ -333,16 +369,16 @@ L1:               for ($n = 0; $n < @parts; $n++) {
                                        }
                                        if (@try && $try eq $try[0]) {
                                                $misses++;
-                                               $lru->put($call, \@try);
+                                               lru_put($call, \@try);
                                                push @out, @try;
                                        } else {
                                                $misses++;
-                                               $lru->put($call, \@nout);
+                                               lru_put($call, \@nout);
                                                push @out, @nout;
                                        }
                                } else {
                                        $misses++;
-                                       $lru->put($call, \@nout);
+                                       lru_put($call, \@nout);
                                        push @out, @nout;
                                }
                                next LM;
@@ -352,7 +388,7 @@ L1:         for ($n = 0; $n < @parts; $n++) {
                # we are a pirate!
                @nout = matchprefix('Q');
                $misses++;
-               $lru->put($call, \@nout);
+               lru_put($call, \@nout);
                push @out, @nout;
        }
        
@@ -369,6 +405,7 @@ L1:         for ($n = 0; $n < @parts; $n++) {
 # nc = dxcc
 # ni = itu
 # nz = zone
+# ns = state
 #
 
 sub to_ciz
@@ -377,18 +414,24 @@ sub to_ciz
        my @out;
        
        foreach my $v (@_) {
-               if ($v =~ /^\d+$/) {    
+               if ($cmd ne 'ns' && $v =~ /^\d+$/) {    
                        push @out, $v unless grep $_ eq $v, @out;
                } else {
-                       my @pre = Prefix::extract($v);
-                       return () unless @pre;
-                       shift @pre;
-                       foreach my $p (@pre) {
-                               my $n = $p->dxcc if $cmd eq 'nc' ;
-                               $n = $p->itu if $cmd eq 'ni' ;
-                               $n = $p->cq if $cmd eq 'nz' ;
-                               push @out, $n unless grep $_ eq $n, @out;
-                       }
+                       if ($cmd eq 'ns' && $v =~ /^[A-Z][A-Z]$/i) {
+                               push @out, uc $v unless grep $_ eq uc $v, @out;
+                       } else {
+                               my @pre = Prefix::extract($v);
+                               if (@pre) {
+                                       shift @pre;
+                                       foreach my $p (@pre) {
+                                               my $n = $p->dxcc if $cmd eq 'nc' ;
+                                               $n = $p->itu if $cmd eq 'ni' ;
+                                               $n = $p->cq if $cmd eq 'nz' ;
+                                               $n = $p->state if $cmd eq 'ns';
+                                               push @out, $n unless grep $_ eq $n, @out;
+                                       }
+                               }
+                       }                       
                }
        }
        return @out;
@@ -401,29 +444,27 @@ my %valid = (
                         name => '0,Name',
                         itu => '0,ITU',
                         cq => '0,CQ',
+                        state => '0,State',
+                        city => '0,City',
                         utcoff => '0,UTC offset',
                         cont => '0,Continent',
                        );
 
-no strict;
 sub AUTOLOAD
 {
        my $self = shift;
+       no strict;
        my $name = $AUTOLOAD;
   
        return if $name =~ /::DESTROY$/;
-       $name =~ s/.*:://o;
+       $name =~ s/^.*:://o;
   
        confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
        # this clever line of code creates a subroutine which takes over from autoload
        # from OO Perl - Conway
-       *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
-       if (@_) {
-               $self->{$name} = shift;
-       }
-       return $self->{$name};
+       *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
+       &$AUTOLOAD($self, @_);
 }
-use strict;
 
 #
 # return a prompt for a field
index be1d6282d5e947e132bd091fd10a0a5d1c983dfb..17e3d517edbee50a14ddf3b5ada207877ca93762 100644 (file)
@@ -53,15 +53,18 @@ sub new
 
 sub AUTOLOAD
 {
-       no strict "refs";
+#      no strict "refs";
        my $self = shift;
+       no strict;
        my $name = $AUTOLOAD;
        return if $name =~ /::DESTROY$/;
-       $name =~ s/.*:://o;
+       $name =~ s/^.*:://o;
   
        confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
-       *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
-    @_ ? $self->{$name} = shift : $self->{$name} ;
+       *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};
+       &$AUTOLOAD($self, @_);
+#      *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
+#    @_ ? $self->{$name} = shift : $self->{$name} ;
 }
 
 1;
index 7112734f0741a756a2585bab4f91f84f64e98a4d..387407669583ff325644bbc51d9517d1fc215de6 100644 (file)
@@ -35,6 +35,8 @@ use vars qw(%list %valid $filterdef);
                  dxcc => '0,Country Code',
                  itu => '0,ITU Zone',
                  cq => '0,CQ Zone',
+                 state => '0,State',
+                 city => '0,City',
                 );
 
 $filterdef = bless ([
@@ -44,9 +46,16 @@ $filterdef = bless ([
                          ['channel_itu', 'ni', 2],
                          ['channel_zone', 'nz', 3],
                          ['call', 'c', 4],
+                         ['by', 'c', 4],
                          ['call_dxcc', 'nc', 5],
+                         ['by_dxcc', 'nc', 5],
                          ['call_itu', 'ni', 6],
+                         ['by_itu', 'ni', 6],
                          ['call_zone', 'nz', 7],
+                         ['by_zone', 'nz', 7],
+                         ['channel_state', 'ns', 8],
+                         ['call_state', 'ns', 9],
+                         ['by_state', 'ns', 9],
                         ], 'Filter::Cmd');
 
 
@@ -63,7 +72,9 @@ sub new
        if (@dxcc > 0) {
                $self->{dxcc} = $dxcc[1]->dxcc;
                $self->{itu} = $dxcc[1]->itu;
-               $self->{cq} = $dxcc[1]->cq;                                             
+               $self->{cq} = $dxcc[1]->cq;
+               $self->{state} = $dxcc[1]->state;
+               $self->{city} = $dxcc[1]->city;
        }
        $self->{flags} = here(1);
        
@@ -370,16 +381,19 @@ sub field_prompt
 sub AUTOLOAD
 {
        my $self = shift;
+       no strict;
        my $name = $AUTOLOAD;
        return if $name =~ /::DESTROY$/;
-       $name =~ s/.*:://o;
+       $name =~ s/^.*:://o;
   
        confess "Non-existant field '$AUTOLOAD'" if !$valid{$name};
 
        # this clever line of code creates a subroutine which takes over from autoload
        # from OO Perl - Conway
-#      *{$AUTOLOAD} = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}} ;
-    @_ ? $self->{$name} = shift : $self->{$name} ;
+       *$AUTOLOAD = sub {@_ > 1 ? $_[0]->{$name} = $_[1] : $_[0]->{$name}};
+       &$AUTOLOAD($self, @_);
+
+#    @_ ? $self->{$name} = shift : $self->{$name} ;
 }
 
 1;
index 9b67cc5fb54f3a7d9e562e8247fc46c40b2ca29e..982f8db5e19b51dadcfe088adea403b969b58b23 100644 (file)
@@ -50,7 +50,10 @@ $filterdef = bless ([
                          ['call_zone', 'nz', 9],
                          ['by_itu', 'ni', 10],
                          ['by_zone', 'nz', 11],
-                         ['channel', 'c', 12],
+                         ['call_state', 'ns', 12],
+                         ['by_state', 'ns', 13],
+                         ['channel', 'c', 14],
+                                        
                         ], 'Filter::Cmd');
 $totalspots = $hfspots = $vhfspots = 0;
 
@@ -122,19 +125,28 @@ sub prepare
        # remove leading and trailing spaces
        $_[3] = unpad($_[3]);
        
+       my ($spotted_dxcc, $spotted_itu, $spotted_cq, $spotted_state) = (666, 0, 0, "");
+       my ($spotter_dxcc, $spotter_itu, $spotter_cq, $spotter_state) = (666, 0, 0, "");
+       
        # add the 'dxcc' country on the end for both spotted and spotter, then the cluster call
        my @dxcc = Prefix::extract($out[1]);
-       my $spotted_dxcc = (@dxcc > 0 ) ? $dxcc[1]->dxcc() : 666;
-       my $spotted_itu = (@dxcc > 0 ) ? $dxcc[1]->itu() : 0;
-       my $spotted_cq = (@dxcc > 0 ) ? $dxcc[1]->cq() : 0;
+       if (@dxcc) {
+               $spotted_dxcc = $dxcc[1]->dxcc();
+               $spotted_itu = $dxcc[1]->itu();
+               $spotted_cq = $dxcc[1]->cq();
+               $spotted_state = $dxcc[1]->state();
+       }
        push @out, $spotted_dxcc;
        @dxcc = Prefix::extract($out[4]);
-       my $spotter_dxcc = (@dxcc > 0 ) ? $dxcc[1]->dxcc() : 666;
-       my $spotter_itu = (@dxcc > 0 ) ? $dxcc[1]->itu() : 0;
-       my $spotter_cq = (@dxcc > 0 ) ? $dxcc[1]->cq() : 0;
+       if (@dxcc) {
+               $spotter_dxcc = $dxcc[1]->dxcc();
+               $spotter_itu = $dxcc[1]->itu();
+               $spotter_cq = $dxcc[1]->cq();
+               $spotter_state = $dxcc[1]->state();
+       }
        push @out, $spotter_dxcc;
        push @out, $_[5];
-       return (@out, $spotted_itu, $spotted_cq, $spotter_itu, $spotter_cq);
+       return (@out, $spotted_itu, $spotted_cq, $spotter_itu, $spotter_cq, $spotted_state, $spotter_state);
 }
 
 sub add
@@ -317,7 +329,7 @@ sub dup
        unpad($text);
        $text = pack("C*", map {$_ & 127} unpack("C*", $text));
        $text =~ s/[^a-zA-Z0-9]//g;
-       for (0,60,120,180,240,300) {
+       for (-60, -120, -180, -240, 0, 60, 120, 180, 240, 300) {
                my $dt = $d - $_;
                my $dupkey = "X$freq|$call|$dt|\L$text";
                return 1 if DXDupe::find($dupkey);
index ed519b4b86aa5e2cc03d6222ffcb824586774fbe..89cd9fe5661c9e1988e6e4a2954f58fdf9a2d85f 100644 (file)
@@ -28,7 +28,12 @@ $dbfn = "$main::data/usdb.v1";
 sub init
 {
        end();
-       tie %db, 'DB_File', $dbfn and $present = 1;
+       if (tie %db, 'DB_File', $dbfn, O_RDONLY, 0664, $DB_BTREE) {
+               $present = 1;
+               dbg("US Database loaded");
+       } else {
+               dbg("US Database not loaded");
+       }
 }
 
 sub end
@@ -122,6 +127,7 @@ sub load
        
        untie %dbn;
        rename "$dbfn.new", $dbfn;
+       return ();
 }
 
 1;
index 04a845d679fdf4cf3170fe603825b3b1d21d6982..c4a61fd29cdcd9948072658f96687ffda812f61e 100755 (executable)
@@ -396,6 +396,7 @@ dbg("DXSpider Version $version, build $build started");
 # load Prefixes
 dbg("loading prefixes ...");
 Prefix::load();
+USDB::init();
 
 # load band data
 dbg("loading band data ...");