cmd/show/dx.pl

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