cmd/show/dx.pl

   1 #
   2 # show dx (normal)
   3 #
   4 #
   5 #
   6
   7 require 5.10.1;
   8
   9 my ($self, $line) = @_;
  10 my @list = split /\s+/, $line;  # split the line up
  11
  12 my @out;
  13 my $f;
  14 my $call = $self->call;
  15 my ($from, $to);
  16 my ($fromday, $today);
  17 my @freq;
  18 my @ans;
  19 my $pre;
  20 my $spotter;
  21 my $info;
  22 my $expr;
  23 my $hint;
  24 my $dxcc;
  25 my $real;
  26 my $zone;
  27 my $byzone;
  28 my $state;
  29 my $bystate;
  30 my $itu;
  31 my $byitu;
  32 my $fromdxcc = 0;
  33 my $exact;
  34 my $origin;
  35 my $ip;
  36 my ($doqsl, $doiota, $doqra, $dofilter);
  37
  38 my $usesql = $main::dbh && $Spot::use_db_for_search;
  39
  40 while ($f = shift @list) {              # next field
  41         dbg "arg: $f list: " . join(',', @list) if isdbg('sh/dx');
  42         if (!$from && !$to) {
  43                 ($from, $to) = $f =~ m|^(\d+)[-/](\d+)$|; # is it a from -> to count?
  44                 next if $from && $to > $from;
  45         }
  46         if (!$to) {
  47                 ($to) = $f =~ /^(\d+)$/o if !$to; # is it a to count?
  48                 next if $to;
  49         }
  50         if (lc $f eq 'exact') {
  51                 $exact = 1;
  52                 next;
  53         }
  54         if (lc $f eq 'dxcc') {
  55                 $dxcc = 1;
  56                 next;
  57         }
  58         if (lc $f eq 'rt' || $f =~ /^real/i) {
  59                 $real = 1;
  60                 next;
  61         }
  62         if (lc $f eq 'on' && $list[0]) { # is it freq range?
  63                 dbg "freq $list[0]" if isdbg('sh/dx');
  64                 if (my ($from, $to) = $list[0] =~ m|^(\d+)(?:\.\d+)?(?:[-/](\d+)(?:\.\d+)?)?$|) {
  65                         $to = $from unless defined $to;
  66                         dbg "freq '$from' '$to'" if isdbg('sh/dx');
  67                         push @freq, $from, $to;
  68                         shift @list;
  69                         next;
  70                 } else {
  71                         my @r = split '/', lc $list[0];
  72                         dbg "r0: $r[0] r1: $r[1]" if isdbg('sh/dx');
  73                         my @fr = Bands::get_freq($r[0], $r[1]);
  74                         if (@fr) {                      # yup, get rid of extranous param
  75                                 dbg "freq: " . join(',', @fr) if isdbg('sh/dx');
  76                                 push @freq, @fr;    # add these to the list
  77                                 shift @list;
  78                                 next;
  79                         }
  80                 }
  81         }
  82         if (lc $f eq 'day' && $list[0]) {
  83                 ($fromday, $today) = split m|[-/]|, shift(@list);
  84                 dbg "got day $fromday/$today" if isdbg('sh/dx');
  85                 next;
  86         }
  87         if (lc $f eq 'info' && $list[0]) {
  88                 $info = shift @list;
  89                 dbg "got info $info" if isdbg('sh/dx');
  90                 next;
  91         }
  92         if (lc $f eq 'origin' && $list[0]) {
  93                 $origin = uc shift @list;
  94                 dbg "got origin $origin" if isdbg('sh/dx');
  95                 next;
  96         }
  97         if (lc $f eq 'ip' && $list[0]) {
  98                 $ip = shift @list;
  99                 dbg "got ip $ip" if isdbg('sh/dx');
 100                 next;
 101         }
 102
 103         if ((lc $f eq 'spotter' || lc $f eq 'by') && $list[0]) {
 104                 $spotter = uc shift @list;
 105                 if ($list[0] && lc $list[0] eq 'dxcc') {
 106                         $fromdxcc = 1;
 107                         shift @list;
 108                 }
 109                 dbg "got spotter $spotter fromdxcc $fromdxcc" if isdbg('sh/dx');
 110                 next;
 111         }
 112         if (lc $f =~ /^filt/) {
 113                 $dofilter = 1 if $self && $self->spotsfilter;
 114                 next;
 115         }
 116         if (lc $f eq 'qsl') {
 117                 $doqsl = 1;
 118                 next;
 119         }
 120         if (lc $f eq 'iota') {
 121                 my ($a, $b);
 122 #               $DB::single =1;
 123
 124                 if (@list && $list[0] && (($a, $b) = $list[0] =~ /(AF|AN|NA|SA|EU|AS|OC)-?(\d?\d\d)/oi)) {
 125                         $a = uc $a;
 126                         $doiota = "\\b$a\[\-\ \]\?$b\\b";
 127                         shift @list;
 128                 }
 129                 $doiota = '\b(IOTA|(AF|AN|NA|SA|EU|AS|OC)[- ]?\d?\d\d)\b' unless $doiota;
 130                 next;
 131         }
 132         if (lc $f eq 'qra') {
 133                 $doqra = uc shift @list if @list && $list[0] =~ /[A-Z][A-Z]\d\d/oi;
 134                 $doqra = '\b([A-Z][A-Z]\d\d|[A-Z][A-Z]\d\d[A-Z][A-Z])\b' unless $doqra;
 135                 next;
 136         }
 137         if (lc $f eq 'zone') {
 138                 $zone = shift @list if @list;
 139                 next;
 140         }
 141         if (lc $f =~ /^by_?zone/) {
 142                 $byzone = shift @list if @list;
 143                 next;
 144         }
 145         if (lc $f eq 'itu') {
 146                 $itu = shift @list if @list;
 147                 next;
 148         }
 149         if (lc $f =~ /^by_?itu/) {
 150                 $byitu = shift @list if @list;
 151                 next;
 152         }
 153         if (lc $f eq 'state') {
 154                 $state = uc shift @list if @list;
 155                 next;
 156         }
 157         if (lc $f =~ /^by_?state/) {
 158                 $bystate = uc shift @list if @list;
 159                 next;
 160         }
 161         if (!$pre) {
 162                 $pre = uc $f;
 163         }
 164 }
 165
 166 #$DB::single = 1;
 167
 168 # check origin
 169 if ($origin) {
 170         $expr .= ' && ' if $expr;
 171         $expr .= "\$f7 eq '$origin'";
 172         $hint .= ' && ' if $hint;
 173         $hint .= "m{$origin}";
 174 }
 175
 176 # check (any) ip address
 177 if ($ip) {
 178         $expr .= ' && ' if $expr;
 179         $expr .= "\$f14 && \$f14 =~ m{^$ip}";
 180         $hint .= ' && ' if $hint;
 181         $ip =~ s/\./\\./g;                      # IPV4
 182         $hint .= "m{$ip}";
 183 }
 184
 185 #  deal with the prefix
 186 if ($pre) {
 187         my @ans;
 188
 189         if ($dxcc) {
 190                 @ans = Prefix::extract($pre);   # is it a callsign/prefix?
 191
 192                 if (@ans) {
 193
 194                         # first deal with the prefix
 195                         my $pre = shift @ans;
 196                         my $a;
 197                         my $str = "Prefix: $pre";
 198                         my $l = length $str;
 199                         my @expr;
 200                         my @hint;
 201
 202                         # build up a search string for this dxcc country/countries
 203                         foreach $a (@ans) {
 204                                 my $n = $a->dxcc();
 205                             push @expr, "\$f5 == $n";
 206                                 push @hint, "m{$n}";
 207                                 my $name = $a->name();
 208                                 $str .= " Dxcc: $n ($name)";
 209                                 push @out, $str;
 210                                 $str = ' ' x $l;
 211                         }
 212                         $expr = @expr > 1 ? '(' . join(' || ', @expr) . ')' : $expr[0];
 213                         $hint = @hint > 1 ? '(' . join(' || ', @hint) . ')' : $hint[0];
 214                 }
 215         }
 216         unless (@ans) {
 217                 $pre .= '*' unless $pre =~ /[\*\?\[]$/o;
 218                 $pre = shellregex($pre);
 219                 if ($usesql) {
 220                         $pre =~ s/\.\*/%/g;
 221                 } else {
 222                         $pre =~ s/\.\*\$$//;
 223                 }
 224                 $pre .= '$' if $exact;
 225                 $expr = "\$f1 =~ m{$pre}";
 226                 $pre =~ s/[\^\$]//g;
 227                 $hint = "m{\U$pre}";
 228         }
 229 }
 230
 231 # now deal with any frequencies specified
 232 if (@freq) {
 233         $expr .= ($expr) ? ' && (' : "(";
 234 #       $hint .= ($hint) ? ' && ' : "(";
 235 #       $hint .= ' && ' if $hint;
 236         my $i;
 237         for ($i = 0; $i < @freq; $i += 2) {
 238                 $expr .= "(\$f0 >= $freq[$i] && \$f0 <= $freq[$i+1]) ||";
 239                 my $r = Spot::ftor($freq[$i], $freq[$i+1]);
 240 #               $hint .= "m{$r\\.} ||" if $r;
 241 #               $hint .= "m{\d+\.} ||";
 242 #               $hint .= "1 ||";
 243         }
 244         chop $expr;     chop $expr;
 245 #       chop $hint;     chop $hint;
 246         $expr .= ")";
 247 #       $hint .= ")";
 248 }
 249
 250 # any info
 251 if ($info) {
 252         $expr .= ' && ' if $expr;
 253 #       $info =~ s{(.)}{"\Q$1"}ge;
 254         $expr .= "\$f3 =~ m{$info}i";
 255         $hint .= ' && ' if $hint;
 256         $hint .= "m{$info}i";
 257 }
 258
 259 # any spotter
 260 if ($spotter) {
 261
 262         if ($fromdxcc) {
 263                 @ans = Prefix::extract($spotter);       # is it a callsign/prefix?
 264
 265                 if (@ans) {
 266
 267                         # first deal with the prefix
 268                         my $pre = shift @ans;
 269                         my $a;
 270                         $expr .= ' && ' if $expr;
 271                         $hint .= ' && ' if $hint;
 272                         my $str = "Spotter: $pre";
 273                         my $l = length $str;
 274                         my @expr;
 275                         my @hint;
 276
 277                         # build up a search string for this dxcc country/countries
 278                         foreach $a (@ans) {
 279                                 my $n = $a->dxcc();
 280                             push @expr, "\$f6 == $n";
 281                                 push @hint, "m{$n}";
 282                                 my $name = $a->name();
 283                                 $str .= " Dxcc: $n ($name)";
 284                                 push @out, $str;
 285                                 $str = ' ' x $l;
 286                         }
 287                         $expr .= @expr > 1 ? '(' . join(' || ', @expr) . ')' : $expr[0];
 288                         $hint .= @hint > 1 ? '(' . join(' || ', @hint) . ')' : $hint[0];
 289                 }
 290         }
 291         unless (@ans) {
 292                 $expr .= ' && ' if $expr;
 293                 $spotter .= '*' unless $spotter =~ /[\*\?\[]/o;
 294                 $spotter = shellregex($spotter);
 295                 if ($usesql) {
 296                         $spotter =~ s/\.\*/%/g;
 297                 } else {
 298                         $spotter =~ s/\.\*\$$//;
 299                 }
 300                 $expr .= "\$f4 =~ m{\U$spotter}";
 301                 $hint .= ' && ' if $hint;
 302                 $spotter =~ s/[\^\$]//g;
 303                 $hint .= "m{\U$spotter}";
 304         }
 305 }
 306
 307 # zone requests
 308 if ($zone) {
 309         my @expr;
 310         my @hint;
 311         $expr .= ' && ' if $expr;
 312         $hint .= ' && ' if $hint;
 313         for (split /[:,]/, $zone) {
 314                 push @expr, "\$f9==$_";
 315                 push @hint, "m{$_}";
 316         }
 317         $expr .= @expr > 1 ? '(' . join(' || ', @expr) . ')' : $expr[0];
 318         $hint .= @hint > 1 ? '(' . join(' || ', @hint) . ')' : $hint[0];
 319 }
 320 if ($byzone) {
 321         my @expr;
 322         my @hint;
 323         $expr .= ' && ' if $expr;
 324         $hint .= ' && ' if $hint;
 325         for (split /[:,]/, $byzone) {
 326                 push @expr, "\$f11==$_";
 327                 push @hint, "m{$_}";
 328         }
 329         $expr .= @expr > 1 ? '(' . join(' || ', @expr) . ')' : $expr[0];
 330         $hint .= @hint > 1 ? '(' . join(' || ', @hint) . ')' : $hint[0];
 331 }
 332
 333 # itu requests
 334 if ($itu) {
 335         my @expr;
 336         my @hint;
 337         $expr .= ' && ' if $expr;
 338         $hint .= ' && ' if $hint;
 339         for (split /[:,]/, $itu) {
 340                 push @expr, "\$f8==$_";
 341                 push @hint, "m{$_}";
 342         }
 343         $expr .= @expr > 1 ? '(' . join(' || ', @expr) . ')' : $expr[0];
 344         $hint .= @hint > 1 ? '(' . join(' || ', @hint) . ')' : $hint[0];
 345 }
 346 if ($byitu) {
 347         my @expr;
 348         my @hint;
 349         $expr .= ' && ' if $expr;
 350         $hint .= ' && ' if $hint;
 351         for (split /[:,]/, $byitu) {
 352                 push @expr, "\$f10==$_";
 353                 push @hint, "m{$_}";
 354         }
 355         $expr .= @expr > 1 ? '(' . join(' || ', @expr) . ')' : $expr[0];
 356         $hint .= @hint > 1 ? '(' . join(' || ', @hint) . ')' : $hint[0];
 357 }
 358
 359 # state requests
 360 if ($state) {
 361         my @expr;
 362         my @hint;
 363         $expr .= ' && ' if $expr;
 364         $hint .= ' && ' if $hint;
 365         for (split /[:,]/, $state) {
 366                 push @expr, "\$f12 eq '$_'";
 367                 push @hint, "m{$_}";
 368         }
 369         if ($usesql) {
 370                 $expr .= @expr > 1 ? '(' . join(' || ', @expr) . ')' : "$expr[0]";
 371         } else {
 372                 $expr .= @expr > 1 ? '(\$f12 && (' . join(' || ', @expr) . '))' : "(\$f12 && $expr[0])";
 373         }
 374         $hint .= @hint > 1 ? '(' . join(' || ', @hint) . ')' : $hint[0];
 375 }
 376 if ($bystate) {
 377         my @expr;
 378         my @hint;
 379         $expr .= ' && ' if $expr;
 380         $hint .= ' && ' if $hint;
 381         for (split /[:,]/, $bystate) {
 382                 push @expr, "\$f13 eq '$_'";
 383                 push @hint, "m{$_}";
 384         }
 385         if ($usesql) {
 386                 $expr .= @expr > 1 ? '(' . join(' || ', @expr) . ')' : "$expr[0]";
 387         } else {
 388                 $expr .= @expr > 1 ? '(\$f13 && (' . join(' || ', @expr) . '))' : "(\$f13 && $expr[0])";
 389         }
 390         $hint .= @hint > 1 ? '(' . join(' || ', @hint) . ')' : $hint[0];
 391 }
 392
 393 # qsl requests
 394 if ($doqsl) {
 395         $expr .= ' && ' if $expr;
 396         $expr .= "\$f3 =~ m{QSL|VIA}i";
 397         $hint .= ' && ' if $hint;
 398         $hint .= "m{QSL|VIA}i";
 399 }
 400
 401 # iota requests
 402 if ($doiota) {
 403         $expr .= ' && ' if $expr;
 404         $expr .= "\$f3 =~ m{$doiota}i";
 405         $hint .= ' && ' if $hint;
 406         $hint .= "m{$doiota}i";
 407 }
 408
 409 # iota requests
 410 if ($doqra) {
 411         $expr .= ' && ' if $expr;
 412         $expr .= "\$f3 =~ m{$doqra}i";
 413         $hint .= ' && ' if $hint;
 414         $hint .= "m{$doqra}io";
 415 }
 416
 417
 418 $from ||= '';
 419 $to ||= '';
 420 $fromday ||= '';
 421 $today ||= '';
 422
 423 dbg "expr: $expr from: $from to: $to fromday: $fromday today: $today" if isdbg('sh/dx');
 424
 425 # now do the search
 426
 427 if ($self->{_nospawn}) {
 428         my @res = Spot::search($expr, $fromday, $today, $from, $to, $hint, $dofilter ? $self : undef);
 429         my $ref;
 430         my @dx;
 431         foreach $ref (@res) {
 432                 if ($self && $self->ve7cc) {
 433                         push @out, VE7CC::dx_spot($self, @$ref);
 434                 } else {
 435                         if ($self && $real) {
 436                                 push @out, DXCommandmode::format_dx_spot($self, @$ref);
 437                         } else {
 438                                 push @out, Spot::formatl(@$ref);
 439                         }
 440                 }
 441         }
 442 } else {
 443         push @out, $self->spawn_cmd("sh/dx $line", \&Spot::search,
 444                                                         args => [$expr, $fromday, $today, $from, $to, $hint, $dofilter ? $self : undef],
 445                                                         cb => sub {
 446                                                                 my ($dxchan, @res) = @_;
 447                                                                 my $ref;
 448                                                                 my @out;
 449
 450                                                                 foreach $ref (@res) {
 451                                                                         if ($self->ve7cc) {
 452                                                                                 push @out, VE7CC::dx_spot($self, @$ref);
 453                                                                         } else {
 454                                                                                 if ($real) {
 455                                                                                         push @out, DXCommandmode::format_dx_spot($self, @$ref);
 456                                                                                 } else {
 457                                                                                         push @out, Spot::formatl(@$ref);
 458                                                                                 }
 459                                                                         }
 460                                                                 }
 461                                                                 push @out, $self->msg('e3', "sh/dx", "'$line'") unless @out;
 462                                                                 return @out;
 463                                                         });
 464 }
 465
 466
 467 return (1, @out);