]> dxcluster.net Git - spider.git/blob - cmd/show/wm7d.pl
force all channels to default width 80 columns
[spider.git] / cmd / show / wm7d.pl
1 #
2 # Query the WM7D Database server for a callsign
3 #
4 # Was Largely based on "sh/qrz"
5 #
6 # Original Copyright (c) 2002 Charlie Carroll K1XX
7 #
8 # Async version (c) Dirk Koopman G1TLH
9 #
10
11 sub waitfor
12 {
13         my $conn = shift;
14         my $msg = shift;
15         $msg =~ s/\cM//g;
16
17         my $buf = $conn->{msg};
18         $buf =~ s/\r/\\r/g;
19         $buf =~ s/\n/\\n/g;
20
21         dbg "state $conn->{state} '$msg' '$buf'" if isdbg('wm7d');
22
23         $conn->{_wm7d} ||= [];
24         
25         if ($conn->{state} eq 'waitfor') {
26                 if ($msg =~ /utc$/ ) { 
27                         $conn->send_later("$conn->{target_call}\n");
28                         $conn->{state} = 'working';
29                 }
30         } elsif ($conn->{state} eq 'working') {
31                 if ($conn->{msg} =~ /^\rquery->\s*$/) {
32                         $conn->send_later("QUIT\n");
33                         $conn->{state} = 'ending';
34                 }
35                 return if $msg =~ /^query->/;
36                 push @{$conn->{_wm7d}}, $msg;
37         } else {
38                 return if $msg =~ /^query->/ || $msg =~ /bye/;
39 #               $conn->handle_raw($msg);
40                 push @{$conn->{_wm7d}}, $msg;
41         }
42 }
43
44 sub on_disc
45 {
46         my $conn = shift;
47         my $dxchan = shift;
48 #       $DB::single = 1;
49         
50         $dxchan->send(map {"$conn->{prefix}$_"} @{$conn->{_wm7d}});
51 }
52
53 # wm7d accepts only single callsign
54 sub handle
55 {
56
57         my ($self, $line) = @_;
58         my $call = $self->call;
59         my @out;
60
61 #       $DB::single = 1;
62         
63
64         # send 'e24' if allow in Internet.pm is not set to 1
65         return (1, $self->msg('e24')) unless $Internet::allow;
66         return (1, "SHOW/WM7D <callsign>, e.g. SH/WM7D k1xx") unless $line;
67         my $target = $Internet::wm7d_url || 'www.wm7d.net';
68         my $port = 5000;
69         my $cmdprompt = '/query->.*$/';
70
71         Log('call', "$call: show/wm7d \U$line");
72
73         my $conn = AsyncMsg->raw($self, $target, $port,
74                                                          handler => \&waitfor, prefix=>'wm7d> ', on_disc =>\&on_disc);
75         if ($conn) {
76                 $conn->{state} = 'waitfor';
77                 $conn->{target_call} = $line;
78                 
79                 push @out, $self->msg('m21', "show/wm7d");
80         } else {
81                 push @out, $self->msg('e18', 'WM7D.net');
82         }
83
84         return (1, @out);
85 }
86