]> dxcluster.org Git - spider.git/commitdiff
added sh/qrz
authorminima <minima>
Mon, 6 Nov 2000 14:20:01 +0000 (14:20 +0000)
committerminima <minima>
Mon, 6 Nov 2000 14:20:01 +0000 (14:20 +0000)
Changes
cmd/show/call.pl
cmd/show/qrz.pl [new file with mode: 0644]
perl/Messages

diff --git a/Changes b/Changes
index a4e04db723a07bb5b71d36e7a7ecf30cbe3d17b7..dc64bf92ba140ee0be4b9472f8bc3b48d3aa70c0 100644 (file)
--- 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!!!)
index 4674b9180477c7c846d3be2e7405b6136ab8482c..28c409f06273d8a6c53418e386bfe38771f4f523 100644 (file)
@@ -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 (file)
index 0000000..51a63c4
--- /dev/null
@@ -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 <callsign>, 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.,;:-]+)(?:<br>)?$/) {
+                                       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);
index 1c3ebe4e9eedf4412dcc836195c30f23d1a86048..2cdae3387184b0e966e426091757bbeb8a6b476d 100644 (file)
@@ -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',