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