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