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