cmd/show/dx.pl

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