+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.
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)
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
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
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 -
acc/spot 3 all
+for US states
+
+ acc/spots by_state VA,NH,RI,MA,ME
+
but this probably for advanced users...
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:-
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:-
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)
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 -
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:-
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:-
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);
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);
['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);
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;
}
-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} ;
}
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;
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;
# 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;
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 {
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;
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
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) {
use Data::Dumper;
use DXDebug;
use DXUtil;
+use USDB;
use LRU;
use strict;
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);
}
#
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++;
dbg("Partial prefix: $pref $s $part" );
}
if (@out && $out[0] eq $s) {
- $lru->put($_, \@out) for @partials;
return @out;
}
}
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;
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;
}
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;
}
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;
}
if (@nout) {
dbg("got prefix: $call = $nout[0]") if isdbg('prefix');
$misses++;
- $lru->put($call, \@nout);
+ lru_put($call, \@nout);
push @out, @nout;
next;
}
}
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;
# we are a pirate!
@nout = matchprefix('Q');
$misses++;
- $lru->put($call, \@nout);
+ lru_put($call, \@nout);
push @out, @nout;
}
# nc = dxcc
# ni = itu
# nz = zone
+# ns = state
#
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;
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
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;
dxcc => '0,Country Code',
itu => '0,ITU Zone',
cq => '0,CQ Zone',
+ state => '0,State',
+ city => '0,City',
);
$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');
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);
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;
['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;
# 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
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);
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
untie %dbn;
rename "$dbfn.new", $dbfn;
+ return ();
}
1;
# load Prefixes
dbg("loading prefixes ...");
Prefix::load();
+USDB::init();
# load band data
dbg("loading band data ...");