]> dxcluster.net Git - spider.git/blob - cmd/show/dx.pl
fix sh/dx <call> with sql spot logging
[spider.git] / 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 my $usesql = $main::dbh && $Spot::use_db_for_search;
35
36 while ($f = shift @list) {              # next field
37         #  print "f: $f list: ", join(',', @list), "\n";
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                 #    print "yup freq\n";
60                 if ($list[0] =~ m|^(\d+)(?:\.\d+)?[-/](\d+)(?:\.\d+)?$|) {
61                         push @freq, $1, $2;
62                         shift @list;
63                         next;
64                 } else {
65                         my @r = split '/', lc $list[0];
66                         # print "r0: $r[0] r1: $r[1]\n";
67                         my @fr = Bands::get_freq($r[0], $r[1]);
68                         if (@fr) {                      # yup, get rid of extranous param
69                                 #         print "freq: ", join(',', @fr), "\n";
70                                 push @freq, @fr;    # add these to the list
71                                 shift @list;
72                                 next;
73                         }
74                 }
75         }
76         if (lc $f eq 'day' && $list[0]) {
77                 #   print "got day\n";
78                 ($fromday, $today) = split m|[-/]|, shift(@list);
79                 next;
80         }
81         if (lc $f eq 'info' && $list[0]) {
82                 #   print "got info\n";
83                 $info = shift @list;
84                 next;
85         }
86         if ((lc $f eq 'spotter' || lc $f eq 'by') && $list[0]) {
87                 #    print "got spotter\n";
88                 $spotter = uc shift @list;
89                 if ($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 ($usesql) {
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 ($usesql) {
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 ($usesql) {
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 ($usesql) {
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);