From 575a26ea68a641f895f68ed28391962d92bf1912 Mon Sep 17 00:00:00 2001 From: minima Date: Mon, 6 Nov 2000 14:20:01 +0000 Subject: [PATCH] added sh/qrz --- Changes | 2 ++ cmd/show/call.pl | 4 ++-- cmd/show/qrz.pl | 51 ++++++++++++++++++++++++++++++++++++++++++++++++ perl/Messages | 2 +- 4 files changed, 56 insertions(+), 3 deletions(-) create mode 100644 cmd/show/qrz.pl diff --git a/Changes b/Changes index a4e04db7..dc64bf92 100644 --- a/Changes +++ b/Changes @@ -1,3 +1,5 @@ +06Nov00======================================================================= +1. Added sh/qrz to the list of callbook services 05Nov00======================================================================= 1. 75% speed up on sh/dx !, lower memory usage as well! 2. Fixed problem with clear/spot 0 (how did this one last so long!!!) diff --git a/cmd/show/call.pl b/cmd/show/call.pl index 4674b918..28c409f0 100644 --- a/cmd/show/call.pl +++ b/cmd/show/call.pl @@ -16,7 +16,7 @@ use Net::Telnet; my $t = new Net::Telnet; -push @out, $self->msg('call1'); +push @out, $self->msg('call1', 'AA6HF'); foreach $l (@list) { $t->open(Host => "jeifer.pineknot.com", Port => 1235, @@ -29,7 +29,7 @@ foreach $l (@list) { } $t->close; } else { - push @out, $self->msg('e18', 'PineKnot'); + push @out, $self->msg('e18', 'AA6HF'); } } diff --git a/cmd/show/qrz.pl b/cmd/show/qrz.pl new file mode 100644 index 00000000..51a63c41 --- /dev/null +++ b/cmd/show/qrz.pl @@ -0,0 +1,51 @@ +# +# Query the PineKnot Database server for a callsign +# +# from an idea by Steve Franke K9AN and information from Angel EA7WA +# +# $Id$ +# +my ($self, $line) = @_; +my @list = split /\s+/, $line; # generate a list of callsigns +my $l; +my @out; + +return (1, "SHOW/QRZ , e.g. SH/QRZ g1tlh") unless @list; + +use Net::Telnet; + +my $t = new Net::Telnet; + +push @out, $self->msg('call1', "QRZ.com"); +foreach $l (@list) { + $t->open(Host => "qrz.com", + Port => 80, + Timeout => 5); + if ($t) { + $t->print("GET /database?callsign=$l HTTP/1.0\n\n"); + Log('call', "show/qrz $l"); + my $state = "call"; + while (my $result = $t->getline) { +# print "$state: $result"; + if ($state eq 'call' && $result =~ /$l/i) { + $state = 'getaddr'; + push @out, uc $l; + } elsif ($state eq 'getaddr' || $state eq 'inaddr') { + if ($result =~ /^\s+([\w\s.,;:-]+)(?:
)?$/) { + my $line = $1; + unless ($line =~ /^\s+$/) { + push @out, $line; + $state = 'inaddr' unless $state eq 'inaddr'; + } + } else { + $state = 'runout' if $state eq 'inaddr'; + } + } + } + $t->close; + } else { + push @out, $self->msg('e18', 'QRZ.com'); + } +} + +return (1, @out); diff --git a/perl/Messages b/perl/Messages index 1c3ebe4e..2cdae338 100644 --- a/perl/Messages +++ b/perl/Messages @@ -21,7 +21,7 @@ package DXM; bbs => 'Your BBS Address is now \"$_[0]\"', beepoff => 'Beeps are now off', beepon => 'Beeps are now on', - call1 => 'Callsign lookup via Pineknot:', + call1 => 'Callsign lookup via $_[0]:', conother => 'Sorry $_[0] you are connected on another port', concluster => 'Sorry $_[0] you are already connected elsewhere on the cluster', conscript => 'no connect script called \"$_[0]\" found in $main::root/connect', -- 2.34.1