cmd/get/keps.pl

   1 #
   2 # Query the DB0SDX QSL server for a callsign
   3 #
   4 # Copyright (c) 2003 Dirk Koopman G1TLH
   5 # Modified Dec 9, 2004 for new website and xml schema by David Spoelstra N9KT
   6 # and tidied up by me (Dirk)
   7 #
   8 #
   9 #
  10
  11 sub on_disc
  12 {
  13         my $conn = shift;
  14         my $dxchan = shift;
  15         my @out;
  16
  17         dbg("keps in: $conn->{kepsin}") if isdbg('keps');
  18
  19         $dxchan->send("get/keps: new keps loaded");
  20 }
  21
  22 sub process
  23 {
  24         my $conn = shift;
  25         my $msg = shift;
  26
  27         $conn->{kepsin} .= "$msg\n";
  28
  29         dbg("keps in: $conn->{kepsin}") if isdbg('keps');
  30 }
  31
  32 sub handle
  33 {
  34         my ($self, $line) = @_;
  35         my $call = $self->call;
  36         my @out;
  37
  38         $line = uc $line;
  39         return (1, $self->msg('e24')) unless $Internet::allow;
  40         my $target = $Internet::keps_url || 'www.amsat.org';
  41         my $path = $Internet::keps_path || '/amsat/ftp/keps/current/nasa.all';
  42         my $port = 80;
  43
  44         dbg("keps: contacting $target:$port") if isdbg('keps');
  45
  46         Log('call', "$call: show/keps $line");
  47         my $conn = AsyncMsg->post($self, $target, $port, $path,
  48                                                           filter => \&process,
  49                                                           on_disc => \&on_disc);
  50
  51         if ($conn) {
  52                 push @out, $self->msg('m21', "show/keps");
  53         } else {
  54                 push @out, $self->msg('e18', 'get/keps error');
  55         }
  56
  57         return (1, @out);
  58 }