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