From b463dee2efa3edb72fab9bf1c64364ea38408bec Mon Sep 17 00:00:00 2001 From: minima Date: Wed, 23 Jun 2004 17:05:51 +0000 Subject: [PATCH] tidy up prefix handling add extra clause handling for sh/dx --- Changes | 2 + cmd/show/dx.pl | 104 ++++++++++++++++++++++++++++++++++++++++++-- data/prefix_data.pl | 2 +- data/wpxloc.raw | 2 +- perl/DXProt.pm | 86 ++++++++---------------------------- perl/Prefix.pm | 7 ++- perl/Route.pm | 11 ++--- perl/Spot.pm | 61 ++++++++++---------------- 8 files changed, 152 insertions(+), 123 deletions(-) diff --git a/Changes b/Changes index 900cf7b9..9941a76c 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,5 @@ +23Jun04======================================================================= +1. Add zone, by_zone, itu, by_itu, state and by_state searches to sh/dx 22Jun04======================================================================= 1. Add the show/mydx command which *may* filter your spots using your spot filter. diff --git a/cmd/show/dx.pl b/cmd/show/dx.pl index bfeabf4c..ecb5dddc 100644 --- a/cmd/show/dx.pl +++ b/cmd/show/dx.pl @@ -21,6 +21,12 @@ my $expr; my $hint; my $dxcc; my $real; +my $zone; +my $byzone; +my $state; +my $bystate; +my $itu; +my $byitu; my $fromdxcc; my ($doqsl, $doiota, $doqra, $dofilter); @@ -104,6 +110,30 @@ while ($f = shift @list) { # next field $doqra = '\b([A-Z][A-Z]\d\d|[A-Z][A-Z]\d\d[A-Z][A-Z])\b' unless $doqra; next; } + if (lc $f eq 'zone') { + $zone = shift @list if @list; + next; + } + if (lc $f =~ /^by_?zone/) { + $byzone = shift @list if @list; + next; + } + if (lc $f eq 'itu') { + $itu = shift @list if @list; + next; + } + if (lc $f =~ /^by_?itu/) { + $byitu = shift @list if @list; + next; + } + if (lc $f eq 'state') { + $state = uc shift @list if @list; + next; + } + if (lc $f =~ /^by_?state/) { + $bystate = uc shift @list if @list; + next; + } if (!$pre) { $pre = uc $f; } @@ -152,19 +182,19 @@ if ($pre) { # now deal with any frequencies specified if (@freq) { $expr .= ($expr) ? " && (" : "("; - $hint .= ($hint) ? " && (" : "("; +# $hint .= ($hint) ? " && (" : "("; my $i; for ($i = 0; $i < @freq; $i += 2) { $expr .= "(\$f0 >= $freq[$i] && \$f0 <= $freq[$i+1]) ||"; my $r = Spot::ftor($freq[$i], $freq[$i+1]); # $hint .= "m{$r\\.} ||" if $r; # $hint .= "m{\d+\.} ||"; - $hint .= "1 ||"; +# $hint .= "1 ||"; } chop $expr; chop $expr; - chop $hint; chop $hint; +# chop $hint; chop $hint; $expr .= ")"; - $hint .= ")"; +# $hint .= ")"; } # any info @@ -219,6 +249,72 @@ if ($spotter) { } } +# zone requests +if ($zone) { + my @expr; + my @hint; + for (split /[:,]/, $zone) { + push @expr, "\$f9==$_"; + push @hint, "m{$_}"; + } + $expr .= @expr > 1 ? '(' . join(' || ', @expr) . ')' : $expr[0]; + $hint .= @hint > 1 ? '(' . join(' || ', @hint) . ')' : $hint[0]; +} +if ($byzone) { + my @expr; + my @hint; + for (split /[:,]/, $byzone) { + push @expr, "\$f11==$_"; + push @hint, "m{$_}"; + } + $expr .= @expr > 1 ? '(' . join(' || ', @expr) . ')' : $expr[0]; + $hint .= @hint > 1 ? '(' . join(' || ', @hint) . ')' : $hint[0]; +} + +# itu requests +if ($itu) { + my @expr; + my @hint; + for (split /[:,]/, $itu) { + push @expr, "\$f8==$_"; + push @hint, "m{$_}"; + } + $expr .= @expr > 1 ? '(' . join(' || ', @expr) . ')' : $expr[0]; + $hint .= @hint > 1 ? '(' . join(' || ', @hint) . ')' : $hint[0]; +} +if ($byitu) { + my @expr; + my @hint; + for (split /[:,]/, $byitu) { + push @expr, "\$f10==$_"; + push @hint, "m{$_}"; + } + $expr .= @expr > 1 ? '(' . join(' || ', @expr) . ')' : $expr[0]; + $hint .= @hint > 1 ? '(' . join(' || ', @hint) . ')' : $hint[0]; +} + +# state requests +if ($state) { + my @expr; + my @hint; + for (split /[:,]/, $state) { + push @expr, "\$f12 eq '$_'"; + push @hint, "m{$_}"; + } + $expr .= @expr > 1 ? '($f12 && (' . join(' || ', @expr) . '))' : "(\$f12 && $expr[0])"; + $hint .= @hint > 1 ? '(' . join(' || ', @hint) . ')' : $hint[0]; +} +if ($bystate) { + my @expr; + my @hint; + for (split /[:,]/, $bystate) { + push @expr, "\$f13 eq '$_'"; + push @hint, "m{$_}"; + } + $expr .= @expr > 1 ? '($f13 && (' . join(' || ', @expr) . '))' : "(\$f13 && $expr[0])"; + $hint .= @hint > 1 ? '(' . join(' || ', @hint) . ')' : $hint[0]; +} + # qsl requests if ($doqsl) { $expr .= " && " if $expr; diff --git a/data/prefix_data.pl b/data/prefix_data.pl index 7d55dd35..990f38ca 100644 --- a/data/prefix_data.pl +++ b/data/prefix_data.pl @@ -4369,7 +4369,7 @@ 334 => bless( { name => 'Paraguay-ZP', dxcc => 333, itu => 14, cq => 11, utcoff => 4.0, lat => -25.3, long => -57.7 }, 'Prefix'), 335 => bless( { name => 'So-Africa-ZS1-ZS', dxcc => 265, itu => 57, cq => 38, utcoff => -2.0, lat => -33.9, long => 18.4 }, 'Prefix'), 336 => bless( { name => 'Marion-Is-ZS8', dxcc => 266, itu => 57, cq => 38, utcoff => -2.0, lat => -46.8, long => 37.8 }, 'Prefix'), - 337 => bless( { name => 'Pirat_Country', dxcc => 666, itu => 17, cq => 14, utcoff => -0.0, lat => 0, long => 0 }, 'Prefix'), + 337 => bless( { name => 'Pirat_Country', dxcc => 666, itu => 0, cq => 0, utcoff => -0.0, lat => 0, long => 0 }, 'Prefix'), 338 => bless( { name => 'Agalega-3B6', dxcc => 272, itu => 53, cq => 39, utcoff => -4.0, lat => -10.4, long => 56.6 }, 'Prefix'), 339 => bless( { name => 'Fiji-Is-3D2/F', dxcc => 277, itu => 56, cq => 32, utcoff => -12.0, lat => -17, long => 178 }, 'Prefix'), 340 => bless( { name => 'Russia-Antarcti-CE9(OLD_4K1)', dxcc => 102, itu => 67, cq => 12, utcoff => -4.0, lat => -65, long => -64 }, 'Prefix'), diff --git a/data/wpxloc.raw b/data/wpxloc.raw index 81227440..9e03ca7a 100644 --- a/data/wpxloc.raw +++ b/data/wpxloc.raw @@ -1612,6 +1612,6 @@ ZS8 Marion-Is-ZS8 266 57 38 -2.0 46 48 0 S 37 48 0 E @ V50,V51 Namibia-V5 267 57 38 -2.0 22 36 0 S 17 6 0 E 4W East-Timor-4W 340 54 28 -8.0 8 73 0 S 126 30 0 E TX0 Chesterfield-Is-TX0 341 56 30 -11.0 19 31 0 S 158 11 0 E -T0,SSB,1B,X5,X8,ZC6,10G,50V,Q,0,MAJ Pirat_Country 666 17 14 -0.0 0 0 0 S 0 0 0 E @ +T0,SSB,1B,X5,X8,ZC6,10G,50V,Q,0,MAJ Pirat_Country 666 0 0 -0.0 0 0 0 S 0 0 0 E @ diff --git a/perl/DXProt.pm b/perl/DXProt.pm index a7a82a7b..707dc583 100644 --- a/perl/DXProt.pm +++ b/perl/DXProt.pm @@ -1703,20 +1703,8 @@ sub send_wwv_spot my $line = shift; my @dxchan = DXChannel->get_all(); my $dxchan; - my ($wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq) = (0..0); - my @dxcc = Prefix::extract($_[6]); - if (@dxcc > 0) { - $wwv_dxcc = $dxcc[1]->dxcc; - $wwv_itu = $dxcc[1]->itu; - $wwv_cq = $dxcc[1]->cq; - } - @dxcc = Prefix::extract($_[7]); - if (@dxcc > 0) { - $org_dxcc = $dxcc[1]->dxcc; - $org_itu = $dxcc[1]->itu; - $org_cq = $dxcc[1]->cq; - } - + my @dxcc = ((Prefix::cty_data($_[6]))[0..2], (Prefix::cty_data($_[7]))[0..2]); + # send it if it isn't the except list and isn't isolated and still has a hop count # taking into account filtering and so on foreach $dxchan (@dxchan) { @@ -1725,7 +1713,7 @@ sub send_wwv_spot my $routeit; my ($filter, $hops); - $dxchan->wwv($line, $self->{isolate}, @_, $self->{call}, $wwv_dxcc, $wwv_itu, $wwv_cq, $org_dxcc, $org_itu, $org_cq); + $dxchan->wwv($line, $self->{isolate}, @_, $self->{call}, @dxcc); } } @@ -1749,19 +1737,7 @@ sub send_wcy_spot my $line = shift; my @dxchan = DXChannel->get_all(); my $dxchan; - my ($wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq) = (0..0); - my @dxcc = Prefix::extract($_[10]); - if (@dxcc > 0) { - $wcy_dxcc = $dxcc[1]->dxcc; - $wcy_itu = $dxcc[1]->itu; - $wcy_cq = $dxcc[1]->cq; - } - @dxcc = Prefix::extract($_[11]); - if (@dxcc > 0) { - $org_dxcc = $dxcc[1]->dxcc; - $org_itu = $dxcc[1]->itu; - $org_cq = $dxcc[1]->cq; - } + my @dxcc = ((Prefix::cty_data($_[10]))[0..2], (Prefix::cty_data($_[11]))[0..2]); # send it if it isn't the except list and isn't isolated and still has a hop count # taking into account filtering and so on @@ -1769,7 +1745,7 @@ sub send_wcy_spot next if $dxchan == $main::me; next if $dxchan == $self; - $dxchan->wcy($line, $self->{isolate}, @_, $self->{call}, $wcy_dxcc, $wcy_itu, $wcy_cq, $org_dxcc, $org_itu, $org_cq); + $dxchan->wcy($line, $self->{isolate}, @_, $self->{call}, @dxcc); } } @@ -1813,28 +1789,13 @@ 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; - } - + my @a = Prefix::cty_data($_[0]); + my @b = Prefix::cty_data($_[4]); if ($self->{inannfilter}) { my ($filter, $hops) = $self->{inannfilter}->it(@_, $self->{call}, - $ann_dxcc, $ann_itu, $ann_cq, - $org_dxcc, $org_itu, $org_cq, $ann_state, $org_state); + @a[0..2], + @b[0..2], $a[3], $b[3]); unless ($filter) { dbg("PCPROT: Rejected by input announce filter") if isdbg('chanerr'); return; @@ -1853,7 +1814,8 @@ sub send_announce foreach $dxchan (@dxchan) { next if $dxchan == $main::me; next if $dxchan == $self && $self->is_node; - $dxchan->announce($line, $self->{isolate}, $to, $target, $text, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq); + $dxchan->announce($line, $self->{isolate}, $to, $target, $text, @_, $self->{call}, + @a[0..2], @b[0..2]); } } @@ -1883,28 +1845,13 @@ sub send_chat } # 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; - } - + my @a = Prefix::cty_data($_[0]); + my @b = Prefix::cty_data($_[4]); if ($self->{inannfilter}) { my ($filter, $hops) = $self->{inannfilter}->it(@_, $self->{call}, - $ann_dxcc, $ann_itu, $ann_cq, - $org_dxcc, $org_itu, $org_cq, $ann_state, $org_state); + @a[0..2], + @b[0..2], $a[3], $b[3]); unless ($filter) { dbg("PCPROT: Rejected by input announce filter") if isdbg('chanerr'); return; @@ -1934,7 +1881,8 @@ sub send_chat } } - $dxchan->chat($is_ak1a ? $ak1a_line : $line, $self->{isolate}, $target, $_[1], $text, @_, $self->{call}, $ann_dxcc, $ann_itu, $ann_cq, $org_dxcc, $org_itu, $org_cq); + $dxchan->chat($is_ak1a ? $ak1a_line : $line, $self->{isolate}, $target, $_[1], + $text, @_, $self->{call}, @a[0..2], @b[0..2]); } } diff --git a/perl/Prefix.pm b/perl/Prefix.pm index 65074b83..bc8a0edf 100644 --- a/perl/Prefix.pm +++ b/perl/Prefix.pm @@ -473,14 +473,17 @@ sub to_ciz return @out; } -# get the full country data (dxcc, itu, cq, state) as a list +# get the full country data (dxcc, itu, cq, state, city) as a list # from a callsign. sub cty_data { my $call = shift; my @dxcc = extract($call); - return @dxcc ? ($dxcc[1]->dxcc, $dxcc[1]->itu, $dxcc[1]->cq, $dxcc[1]->state) : (); + if (@dxcc) { + return ($dxcc[1]->dxcc, $dxcc[1]->itu, $dxcc[1]->cq, $dxcc[1]->state, $dxcc[1]->city); + } + return (666,0,0,'',''); } my %valid = ( diff --git a/perl/Route.pm b/perl/Route.pm index a9f80fea..0f52e39b 100644 --- a/perl/Route.pm +++ b/perl/Route.pm @@ -68,14 +68,9 @@ sub new dbg("create $pkg with $call") if isdbg('routelow'); # add in all the dxcc, itu, zone info - my @dxcc = Prefix::extract($call); - if (@dxcc > 0) { - $self->{dxcc} = $dxcc[1]->dxcc; - $self->{itu} = $dxcc[1]->itu; - $self->{cq} = $dxcc[1]->cq; - $self->{state} = $dxcc[1]->state; - $self->{city} = $dxcc[1]->city; - } + ($self->{dxcc}, $self->{itu}, $self->{cq}, $self->{state}, $self->{city}) = + Prefix::cty_data($call); + $self->{flags} = here(1); return $self; diff --git a/perl/Spot.pm b/perl/Spot.pm index 796b5e9c..44cb5728 100644 --- a/perl/Spot.pm +++ b/perl/Spot.pm @@ -121,34 +121,21 @@ sub prepare # normalise frequency $_[0] = sprintf "%.1f", $_[0]; - # remove ssids if present on spotter + # remove ssids and /xxx if present on spotter $out[4] =~ s/-\d+$//o; + $out[4] =~ s|/\w+$||o; # 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]); - 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]); - 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; + my @spd = Prefix::cty_data($out[1]); + push @out, $spd[0]; + my @spt = Prefix::cty_data($out[4]); + push @out, $spt[0]; push @out, $_[5]; - return (@out, $spotted_itu, $spotted_cq, $spotter_itu, $spotter_cq, $spotted_state, $spotter_state); + return (@out, @spd[1,2], @spt[1,2], $spd[3], $spt[3]); } sub add @@ -216,9 +203,21 @@ sub search $to = $from + $maxspots if $to - $from > $maxspots || $to - $from <= 0; - $expr =~ s/\$f(\d)/\$ref->[$1]/g; # swap the letter n for the correct field name + $expr =~ s/\$f(\d\d?)/\$ref->[$1]/g; # swap the letter n for the correct field name # $expr =~ s/\$f(\d)/\$spots[$1]/g; # swap the letter n for the correct field name + my $checkfilter; + $checkfilter = qq ( + if (\@s < 9) { + my \@a = (Prefix::cty_data(\$s[1]))[1..3]; + my \@b = (Prefix::cty_data(\$s[4]))[1..3]; + push \@s, \@a[0,1], \@b[0,1], \$a[2], \$a[2]; + } + my (\$filter, \$hops) = \$dxchan->{spotsfilter}->it(\@s); + next unless (\$filter); + ) if $dxchan; + $checkfilter ||= ' '; + dbg("hint='$hint', expr='$expr', spotno=$from-$to, day=$dayfrom-$dayto\n") if isdbg('search'); # build up eval to execute @@ -226,29 +225,15 @@ sub search while (<\$fh>) { $hint; chomp; - push \@spots, [ split '\\^' ]; + my \@s = split /\\^/; + $checkfilter; + push \@spots, \\\@s; } my \$c; my \$ref; for (\$c = \$#spots; \$c >= 0; \$c--) { \$ref = \$spots[\$c]; if ($expr) { - if (\$dxchan && \$dxchan->{spotsfilter}) { - if (\@\$ref < 9) { - my \@dxcc = Prefix::cty_data(\$ref->[1]); - if (\@dxcc) { - pop \@dxcc; - push \@\$ref, \@dxcc; - } - \@dxcc = Prefix::cty_data(\$ref->[4]); - if (\@dxcc) { - pop \@dxcc; - push \@\$ref, \@dxcc; - } - } - my (\$filter, \$hops) = \$dxchan->{spotsfilter}->it(\@\$ref); - next unless (\$filter); - } \$count++; next if \$count < \$from; # wait until from push(\@out, \$ref); -- 2.34.1