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