From: minima Date: Sun, 23 Feb 2003 02:35:00 +0000 (+0000) Subject: added sh/wm7d and sh/db0sdx X-Git-Tag: PRE-1-52~57 X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=430f06b0c53fd69b7190519de5fb78942ebcc94c;p=spider.git added sh/wm7d and sh/db0sdx --- diff --git a/Changes b/Changes index f83c3711..c44c9cc2 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,6 @@ +23Feb03======================================================================= +1. Added show/wm7d command (a US only callbook server) [by K1XX]. +2. Added a prototype show/db0sdx command (w.i.p). 22Feb03======================================================================= 1. changed qrz.com address 2. added Charlie's [K1XX] new wpxloc.raw data stuff to get WA1, KC3 type diff --git a/cmd/show/db0sdx.pl b/cmd/show/db0sdx.pl new file mode 100644 index 00000000..130951e1 --- /dev/null +++ b/cmd/show/db0sdx.pl @@ -0,0 +1,82 @@ +# +# Query the DB0SDX QSL server for a callsign +# +# Copyright (c) 2003 Dirk Koopman G1TLH +# +# $Id$ +# + +my ($self, $line) = @_; +my $call = $self->call; +my @out; + +$line = uc $line; +return (1, $self->msg('e24')) unless $Internet::allow; +return (1, "SHOW/DB0SDX , e.g. SH/DB0SDX ea7wa") unless $line && is_callsign($line); +my $target = 'dotnet.grossmann.com'; +my $port = 80; +my $cmdprompt = '/query->.*$/'; + +my($info, $t); + +$t = new Net::Telnet; +$info = $t->open(Host => $target, + Port => $port, + Timeout => 15); + +if (!$info) { + push @out, $self->msg('e18', 'DB0SDX Database server'); +} else { + + my $s = qq( + + + + $line + + + +); + + + my $lth = length($s)+7; + + dbg("db0sdx out: $s") if isdbg('db0sdx'); + + $t->print("POST /qslinfo/qslinfo.asmx HTTP/1.1"); + $t->print("Host: dotnet.grossmann.com"); + $t->print("Content-Type: text/xml; charset=utf-8"); + $t->print("Content-Length: $lth"); + $t->print("Connection: Close"); + $t->print("SOAPAction: \"http://dotnet.grossmann.com/qslinfo/qslinfo\""); + $t->print(""); + $t->put($s); + + my $in; + + while (my $result = eval { $t->getline(Timeout => 30) } || $@) { + if ($@) { + push @out, $self->msg('e18', 'DB0SDX Server'); + last; + } else { + $in .= $result; + } + } + + dbg("db0sdx in: $in") if isdbg('db0sdx'); + + # Log the lookup + Log('call', "$call: show/db0sdx $line"); + $t->close; + + my ($info) = $in =~ m|([^<]*)|; + my @in = split /[\r\n]/, $info if $info; + if (@in && $in[0]) { + push @out, @in; + } else { + ($info) = $in =~ m|([^<]*)|; + push @out, $info if $info; + push @out, $self->msg('e3', 'DB0SDX', $line) unless @out; + } +} +return (1, @out); diff --git a/cmd/show/wm7d.pl b/cmd/show/wm7d.pl new file mode 100644 index 00000000..72e2d806 --- /dev/null +++ b/cmd/show/wm7d.pl @@ -0,0 +1,43 @@ +# +# Query the WM7D Database server for a callsign +# +# Largely based on "sh/qrz" and info in the Net::Telnet documentation +# +# Copyright (c) 2002 Charlie Carroll K1XX +# +# $Id$ +# + +# wm7d accepts only single callsign +my ($self, $line) = @_; +my $call = $self->call; +my @out; + +# send 'e24' if allow in Internet.pm is not set to 1 +return (1, $self->msg('e24')) unless $Internet::allow; +return (1, "SHOW/WM7D , e.g. SH/WM7D k1xx") unless $line; +my $target = 'www.wm7d.net'; +my $port = 5000; +my $cmdprompt = '/query->.*$/'; + +my($info, $t); + +$t = new Net::Telnet; +$info = $t->open(Host => $target, + Port => $port, + Timeout => 20); + +if (!$info) { + push @out, $self->msg('e18', 'WM7D.net'); +} else { + ## Wait for prompt and respond with callsign. + $t->waitfor($cmdprompt); + $t->print($line); + ($info) = $t->waitfor($cmdprompt); + + # Log the lookup + Log('call', "$call: show/wm7d \U$line"); + $t->close; + push @out, $info; +} +return (1, @out);