X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=cmd%2Fshow%2Fdx.pl;h=192d252fce49addc2c46c79bb40c95d5497a5f81;hb=c5f4d6db53b0e8c62b61fd0c3f568a5a2934ea1d;hp=c3806f8795f801f73551384fc69c44c457ffc172;hpb=fd0973e8351e0fc5e762034da5fa02e2a715b6dd;p=spider.git diff --git a/cmd/show/dx.pl b/cmd/show/dx.pl index c3806f87..192d252f 100644 --- a/cmd/show/dx.pl +++ b/cmd/show/dx.pl @@ -1,15 +1,17 @@ # # show dx (normal) # -# $Id$ # +# + +require 5.10.1; my ($self, $line) = @_; my @list = split /\s+/, $line; # split the line up my @out; my $f; -my $call; +my $call = $self->call; my ($from, $to); my ($fromday, $today); my @freq; @@ -21,11 +23,20 @@ my $expr; my $hint; my $dxcc; my $real; -my $fromdxcc; -my ($doqsl, $doiota, $doqra); +my $zone; +my $byzone; +my $state; +my $bystate; +my $itu; +my $byitu; +my $fromdxcc = 0; +my $exact; +my ($doqsl, $doiota, $doqra, $dofilter); + +my $usesql = $main::dbh && $Spot::use_db_for_search; while ($f = shift @list) { # next field - # print "f: $f list: ", join(',', @list), "\n"; + dbg "arg: $f list: " . join(',', @list) if isdbg('shdx'); if (!$from && !$to) { ($from, $to) = $f =~ m|^(\d+)[-/](\d+)$|; # is it a from -> to count? next if $from && $to > $from; @@ -34,6 +45,10 @@ while ($f = shift @list) { # next field ($to) = $f =~ /^(\d+)$/o if !$to; # is it a to count? next if $to; } + if (lc $f eq 'exact') { + $exact = 1; + next; + } if (lc $f eq 'dxcc') { $dxcc = 1; next; @@ -43,17 +58,19 @@ while ($f = shift @list) { # next field next; } if (lc $f eq 'on' && $list[0]) { # is it freq range? - # print "yup freq\n"; - if ($list[0] =~ m|^(\d+)(?:\.\d+)?[-/](\d+)(?:\.\d+)?$|) { - push @freq, $1, $2; + dbg "freq $list[0]" if isdbg('shdx'); + if (my ($from, $to) = $list[0] =~ m|^(\d+)(?:\.\d+)?(?:[-/](\d+)(?:\.\d+)?)?$|) { + $to = $from unless defined $to; + dbg "freq '$from' '$to'" if isdbg('shdx'); + push @freq, $from, $to; shift @list; next; } else { my @r = split '/', lc $list[0]; - # print "r0: $r[0] r1: $r[1]\n"; + dbg "r0: $r[0] r1: $r[1]" if isdbg('shdx'); my @fr = Bands::get_freq($r[0], $r[1]); if (@fr) { # yup, get rid of extranous param - # print "freq: ", join(',', @fr), "\n"; + dbg "freq: " . join(',', @fr) if isdbg('shdx'); push @freq, @fr; # add these to the list shift @list; next; @@ -61,22 +78,26 @@ while ($f = shift @list) { # next field } } if (lc $f eq 'day' && $list[0]) { - # print "got day\n"; ($fromday, $today) = split m|[-/]|, shift(@list); + dbg "got day $fromday/$today" if isdbg('shdx'); next; } if (lc $f eq 'info' && $list[0]) { - # print "got info\n"; $info = shift @list; + dbg "got info $info" if isdbg('shdx'); next; } if ((lc $f eq 'spotter' || lc $f eq 'by') && $list[0]) { - # print "got spotter\n"; $spotter = uc shift @list; if ($list[0] && lc $list[0] eq 'dxcc') { $fromdxcc = 1; shift @list; } + dbg "got spotter $spotter fromdxcc $fromdxcc" if isdbg('shdx'); + next; + } + if (lc $f =~ /^filt/) { + $dofilter = 1 if $self && $self->spotsfilter; next; } if (lc $f eq 'qsl') { @@ -100,11 +121,37 @@ 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; } } +#$DB::single = 1; + # first deal with the prefix if ($pre) { my @ans; @@ -137,8 +184,14 @@ if ($pre) { } } unless (@ans) { - $pre .= '*' unless $pre =~ /[\*\?\[]/o; + $pre .= '*' unless $pre =~ /[\*\?\[]$/o; $pre = shellregex($pre); + if ($usesql) { + $pre =~ s/\.\*/%/g; + } else { + $pre =~ s/\.\*\$$//; + } + $pre .= '$' if $exact; $expr = "\$f1 =~ m{$pre}"; $pre =~ s/[\^\$]//g; $hint = "m{\U$pre}"; @@ -147,27 +200,29 @@ if ($pre) { # now deal with any frequencies specified if (@freq) { - $expr .= ($expr) ? " && (" : "("; - $hint .= ($hint) ? " && (" : "("; + $expr .= ($expr) ? ' && (' : "("; +# $hint .= ($hint) ? ' && ' : "("; +# $hint .= ' && ' if $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 .= "m{\d+\.} ||"; +# $hint .= "1 ||"; } chop $expr; chop $expr; - chop $hint; chop $hint; +# chop $hint; chop $hint; $expr .= ")"; - $hint .= ")"; +# $hint .= ")"; } # any info if ($info) { - $expr .= " && " if $expr; + $expr .= ' && ' if $expr; $info =~ s{(.)}{"\Q$1"}ge; $expr .= "\$f3 =~ m{$info}i"; - $hint .= " && " if $hint; + $hint .= ' && ' if $hint; $hint .= "m{$info}i"; } @@ -204,52 +259,170 @@ if ($spotter) { } } unless (@ans) { - $expr .= " && " if $expr; + $expr .= ' && ' if $expr; $spotter .= '*' unless $spotter =~ /[\*\?\[]/o; $spotter = shellregex($spotter); + if ($usesql) { + $spotter =~ s/\.\*/%/g; + } else { + $spotter =~ s/\.\*\$$//; + } $expr .= "\$f4 =~ m{\U$spotter}"; - $hint .= " && " if $hint; + $hint .= ' && ' if $hint; $spotter =~ s/[\^\$]//g; $hint .= "m{\U$spotter}"; } } +# zone requests +if ($zone) { + my @expr; + my @hint; + $expr .= ' && ' if $expr; + $hint .= ' && ' if $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; + $expr .= ' && ' if $expr; + $hint .= ' && ' if $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; + $expr .= ' && ' if $expr; + $hint .= ' && ' if $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; + $expr .= ' && ' if $expr; + $hint .= ' && ' if $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; + $expr .= ' && ' if $expr; + $hint .= ' && ' if $hint; + for (split /[:,]/, $state) { + push @expr, "\$f12 eq '$_'"; + push @hint, "m{$_}"; + } + if ($usesql) { + $expr .= @expr > 1 ? '(' . join(' || ', @expr) . ')' : "$expr[0]"; + } else { + $expr .= @expr > 1 ? '(\$f12 && (' . join(' || ', @expr) . '))' : "(\$f12 && $expr[0])"; + } + $hint .= @hint > 1 ? '(' . join(' || ', @hint) . ')' : $hint[0]; +} +if ($bystate) { + my @expr; + my @hint; + $expr .= ' && ' if $expr; + $hint .= ' && ' if $hint; + for (split /[:,]/, $bystate) { + push @expr, "\$f13 eq '$_'"; + push @hint, "m{$_}"; + } + if ($usesql) { + $expr .= @expr > 1 ? '(' . join(' || ', @expr) . ')' : "$expr[0]"; + } else { + $expr .= @expr > 1 ? '(\$f13 && (' . join(' || ', @expr) . '))' : "(\$f13 && $expr[0])"; + } + $hint .= @hint > 1 ? '(' . join(' || ', @hint) . ')' : $hint[0]; +} + # qsl requests if ($doqsl) { - $expr .= " && " if $expr; + $expr .= ' && ' if $expr; $expr .= "\$f3 =~ m{QSL|VIA}i"; - $hint .= " && " if $hint; + $hint .= ' && ' if $hint; $hint .= "m{QSL|VIA}i"; } # iota requests if ($doiota) { - $expr .= " && " if $expr; + $expr .= ' && ' if $expr; $expr .= "\$f3 =~ m{$doiota}i"; - $hint .= " && " if $hint; + $hint .= ' && ' if $hint; $hint .= "m{$doiota}i"; } # iota requests if ($doqra) { - $expr .= " && " if $expr; + $expr .= ' && ' if $expr; $expr .= "\$f3 =~ m{$doqra}i"; - $hint .= " && " if $hint; + $hint .= ' && ' if $hint; $hint .= "m{$doqra}io"; } -#print "expr: $expr from: $from to: $to fromday: $fromday today: $today\n"; +dbg "expr: $expr from: $from to: $to fromday: $fromday today: $today" if isdbg('shdx'); # now do the search -my @res = Spot::search($expr, $fromday, $today, $from, $to, $hint); -my $ref; -my @dx; -foreach $ref (@res) { - if ($real) { - push @out, $self->format_dx_spot(@$ref); - } else { - push @out, Spot::formatl(@$ref); - } -} + +push @out, $self->spawn_cmd("sh/dx $line", \&Spot::search, + args => [$expr, $fromday, $today, $from, $to, $hint, $dofilter ? $self : undef], + cb => sub { + my ($dxchan, @res) = @_; + my $ref; + my @out; + + foreach $ref (@res) { + if ($self->ve7cc) { + push @out, VE7CC::dx_spot($self, @$ref); + } else { + if ($real) { + push @out, DXCommandmode::format_dx_spot($self, @$ref); + } else { + push @out, Spot::formatl(@$ref); + } + } + } + push @out, $self->msg('e3', "sh/dx", "'$line'") unless @out; + $dxchan->send(@out); + }); + +#my @res = Spot::search($expr, $fromday, $today, $from, $to, $hint, $dofilter ? $self : undef); +#my $ref; +#my @dx; +#foreach $ref (@res) { +# if ($self && $self->ve7cc) { +# push @out, VE7CC::dx_spot($self, @$ref); +# } else { +# if ($self && $real) { +# push @out, DXCommandmode::format_dx_spot($self, @$ref); +# } else { +# push @out, Spot::formatl(@$ref); +# } +# } +#} return (1, @out);