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