cmd/show/dx.pl

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