From: Dirk Koopman Date: Sat, 16 Jun 2018 11:20:06 +0000 (+0100) Subject: some RBN prerequisite changes X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=8bb4b460148fbc97739e8645f627cb9ab049d512;p=spider.git some RBN prerequisite changes --- diff --git a/perl/DXChannel.pm b/perl/DXChannel.pm index a9dbd86d..fbdbeee3 100644 --- a/perl/DXChannel.pm +++ b/perl/DXChannel.pm @@ -300,62 +300,58 @@ sub del # is it a bbs sub is_bbs { - my $self = shift; - return $self->{sort} eq 'B'; + return $_[0]->{sort} eq 'B'; } sub is_node { - my $self = shift; - return $self->{sort} =~ /^[ACRSX]$/; + return $_[0]->{sort} =~ /^[ACRSX]$/; } # is it an ak1a node ? sub is_ak1a { - my $self = shift; - return $self->{sort} eq 'A'; + return $_[0]->{sort} eq 'A'; } # is it a user? sub is_user { - my $self = shift; - return $self->{sort} =~ /^[UW]$/; + return $_[0]->{sort} =~ /^[UW]$/; } # is it a clx node sub is_clx { - my $self = shift; - return $self->{sort} eq 'C'; + return $_[0]->{sort} eq 'C'; } # it is a Web connected user sub is_web { - my $self = shift; - return $self->{sort} eq 'W'; + return $_[0]->{sort} eq 'W'; } # is it a spider node sub is_spider { - my $self = shift; - return $self->{sort} eq 'S'; + return $_[0]->{sort} eq 'S'; } # is it a DXNet node sub is_dxnet { - my $self = shift; - return $self->{sort} eq 'X'; + return $_[0]->{sort} eq 'X'; } # is it a ar-cluster node sub is_arcluster { - my $self = shift; - return $self->{sort} eq 'R'; + return $_[0]->{sort} eq 'R'; +} + +sub is_rbn +{ + return $_[0]->{sort} eq 'N'; } # for perl 5.004's benefit diff --git a/perl/DXUtil.pm b/perl/DXUtil.pm index 9c14715c..3e47f6e9 100644 --- a/perl/DXUtil.pm +++ b/perl/DXUtil.pm @@ -385,8 +385,8 @@ sub is_callsign (?:(?:[A-Z]{1,2}\d* | \d[A-Z]{1,2}\d*)/)? # out of area prefix / (?:[A-Z]{1,2}\d+ | \d[A-Z]{1,2}\d+)? # main prefix one [A-Z]{1,5} # callsign letters - (?:-\d{1,2})? # - nn possibly (eg G8BPQ-8) - (?:/[0-9A-Z]{1,7})? # / another prefix, callsign or special label (including /MM, /P as well as /EURO or /LGT) possibly + (?:-(?:\d{1,2}|\#))? # - nn possibly (eg G8BPQ-8) or -# (an RBN spot) + (?:/[0-9A-Z]{1,7})? # / another prefix, callsign or special label (including /MM, /P as well as /EURO or /LGT) possibly $!x; # longest callign allowed is 1X11/1Y11XXXXX-11/XXXXXXX diff --git a/perl/Filter.pm b/perl/Filter.pm index b71ee95a..bcf081e6 100644 --- a/perl/Filter.pm +++ b/perl/Filter.pm @@ -519,7 +519,7 @@ sub parse } $s .= "(" . join(' || ', @t) . ")"; } else { - confess("invalid letter $fref->[1]"); + confess("invalid filter function $fref->[1]"); } ++$found; last; diff --git a/perl/Spot.pm b/perl/Spot.pm index ebc5d92c..b3eff00c 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -34,23 +34,23 @@ $duplth = 20; # the length of text to use in the deduping $dupage = 1*3600; # the length of time to hold spot dups $maxcalllth = 12; # the max length of call to take into account for dupes $filterdef = bless ([ - # tag, sort, field, priv, special parser - ['freq', 'r', 0, 0, \&decodefreq], - ['on', 'r', 0, 0, \&decodefreq], - ['call', 'c', 1], - ['info', 't', 3], - ['by', 'c', 4], - ['call_dxcc', 'nc', 5], - ['by_dxcc', 'nc', 6], - ['origin', 'c', 7, 9], - ['call_itu', 'ni', 8], - ['call_zone', 'nz', 9], - ['by_itu', 'ni', 10], - ['by_zone', 'nz', 11], - ['call_state', 'ns', 12], - ['by_state', 'ns', 13], - ['channel', 'c', 14], - + # tag, sort, field, priv, special parser + ['freq', 'r', 0, 0, \&decodefreq], + ['on', 'r', 0, 0, \&decodefreq], + ['call', 'c', 1], + ['info', 't', 3], + ['by', 'c', 4], + ['call_dxcc', 'nc', 5], + ['by_dxcc', 'nc', 6], + ['origin', 'c', 7, 9], + ['call_itu', 'ni', 8], + ['call_zone', 'nz', 9], + ['by_itu', 'ni', 10], + ['by_zone', 'nz', 11], + ['call_state', 'ns', 12], + ['by_state', 'ns', 13], + ['channel', 'c', 14], + ['rbn', 'a', 4, 0, \&filterrbnspot], ], 'Filter::Cmd'); $totalspots = $hfspots = $vhfspots = 0; $use_db_for_search = 0; @@ -94,6 +94,13 @@ sub decodefreq return (0, join(',', @out)); } +# filter setup for rbn spot so return the regex to detect it +sub filterrbnspot +{ + my $dxchan = shift; + return ('-#$'); +} + sub init { mkdir "$dirprefix", 0777 if !-e "$dirprefix";