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