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         dbg "state $conn->{state} '$msg' '$buf'";
  21
  22         if ($conn->{state} eq 'waitfor') {
  23                 if ($msg =~ /utc$/ ) {
  24                         $conn->send_later("$conn->{target_call}\n");
  25                         $conn->{state} = 'working';
  26                 }
  27         } elsif ($conn->{state} eq 'working') {
  28                 if ($conn->{msg} =~ /^\rquery->\s*$/) {
  29                         $conn->send_later("QUIT\n");
  30                         $conn->{state} = 'ending';
  31                 }
  32                 return if $msg =~ /^query->/;
  33                 $conn->handle_raw($msg);
  34         } else {
  35                 return if $msg =~ /^query->/ || $msg =~ /bye/;
  36                 $conn->handle_raw($msg);
  37         }
  38 }
  39
  40 # wm7d accepts only single callsign
  41 sub handle
  42 {
  43
  44         my ($self, $line) = @_;
  45         my $call = $self->call;
  46         my @out;
  47
  48 #       $DB::single = 1;
  49
  50
  51         # send 'e24' if allow in Internet.pm is not set to 1
  52         return (1, $self->msg('e24')) unless $Internet::allow;
  53         return (1, "SHOW/WM7D <callsign>, e.g. SH/WM7D k1xx") unless $line;
  54         my $target = $Internet::wm7d_url || 'www.wm7d.net';
  55         my $port = 5000;
  56         my $cmdprompt = '/query->.*$/';
  57
  58         Log('call', "$call: show/wm7d \U$line");
  59
  60         my $conn = AsyncMsg->raw($self, $target, $port,
  61                                                          handler => \&waitfor, prefix=>'wm7d> ');
  62         if ($conn) {
  63                 $conn->{state} = 'waitfor';
  64                 $conn->{target_call} = $line;
  65
  66                 push @out, $self->msg('m21', "show/wm7d");
  67         } else {
  68                 push @out, $self->msg('e18', 'WM7D.net');
  69         }
  70
  71         return (1, @out);
  72 }
  73