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