removed sh/call.pl

chanaged sh/qrz to new format
added Internet.pm

diff --git a/Changes b/Changes
index dc64bf92ba140ee0be4b9472f8bc3b48d3aa70c0..e6936fd573b76e6ec5d9d2082b02eb9d9b4aaf71 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,9 @@
+07Nov00=======================================================================
+1. removed sh/call because the owner isn't happy about us using it. 
+2. change sh/qrz to the new interface. MUCH QUICKER! you will need a user id
+and password from qrz.com to use it and you will have to copy the 
+/spider/perl/Interface.pm to /spider/local and alter it accordingly. Do 
+remember to set $allow=1 as well!
 06Nov00=======================================================================
 1. Added sh/qrz to the list of callbook services
 05Nov00=======================================================================

diff --git a/cmd/show/call.pl b/cmd/show/call.pl
deleted file mode 100644 (file)
index f2e96e1..0000000
--- a/cmd/show/call.pl
+++ /dev/null
@@ -1,37 +0,0 @@
-#
-# 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 $call = $self->call;
-my @out;
-
-return (1, "SHOW/CALL <callsign>, e.g. SH/CALL g1tlh") unless @list;
-
-use Net::Telnet;
-
-my $t = new Net::Telnet;
-
-push @out, $self->msg('call1', 'AA6HF');
-foreach $l (@list) {
-       $t->open(Host     =>  "jeifer.pineknot.com",
-                        Port     =>  1235,
-                        Timeout  =>  5);
-       if ($t) {
-               $t->print(uc $l);
-               Log('call', "$call: show/call \U$l");
-               while (my $result = $t->getline) {
-                       push @out,$result;
-               }
-               $t->close;
-       } else {
-               push @out, $self->msg('e18', 'AA6HF');
-       }
-}
-
-return (1, @out);

diff --git a/cmd/show/qrz.pl b/cmd/show/qrz.pl
index 5301c2cd6f72d35c39b562eec5eb3db15664dc4a..9dd99818d4d4bc231b7caf62c5559911e0df832b 100644 (file)
--- a/cmd/show/qrz.pl
+++ b/cmd/show/qrz.pl
@@ -11,36 +11,31 @@ my $l;
 my $call = $self->call;
 my @out;
 
+return (1, $self->msg('e24')) unless $Internet::allow;
 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);
+                        Timeout  =>  15);
        if ($t) {
-               $t->print("GET /database?callsign=$l HTTP/1.0\n\n");
+               my $s = "GET /dxcluster.cgi?callsign=$l\&uid=$Internet::qrz_uid\&pw=$Internet::qrz_pw HTTP/1.0\n\n";
+#              print $s;
+               $t->print($s);
                Log('call', "$call: show/qrz \U$l");
-               my $state = "call";
+               my $state = "blank";
                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';
-                               }
+#                      print $result;
+                       if ($state eq 'blank' && $result =~ /^\s*Callsign\s*:/i) {
+                               $state = 'go';
+                       } elsif ($state eq 'go') {
+                               next if $result =~ /^\s*Usage\s*:/i;
+                               chomp $result;
+                               push @out, $result;
                        }
                }
                $t->close;

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 4477ea75241f62b97a57167f30bf23dc470459c7..47e25c0b80c8fc56e96649934c635442f7a02507 100644 (file)
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -29,6 +29,7 @@ use DXDb;
 use AnnTalk;
 use WCY;
 use Sun;
+use Internet;
 
 use strict;
 use vars qw(%Cache %cmd_cache $errstr %aliases $scriptbase);

diff --git a/perl/Internet.pm b/perl/Internet.pm
new file mode 100644 (file)
index 0000000..44aacbe
--- /dev/null
+++ b/perl/Internet.pm
@@ -0,0 +1,45 @@
+# 
+# in order for you to use the internet accessing routines you
+# need to set various flags and things in this file
+#
+# BUT DO NOT ALTER THIS FILE! It will be overwritten on every update
+#
+# COPY this file to ../local, alter it there and restart the software
+#
+# Copyright (c) 2000 Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+package Internet;
+
+#
+# set this flag to 1 if you want to allow internet commands
+#
+
+$allow = 0;
+
+#
+# QRZ.com user id 
+#
+# set this to your QRZ user name (you need this for the sh/qrz 
+# command)
+#
+# eg 
+# $qrz_uid = 'gb7xxx';
+#
+
+$qrz_uid = undef;
+
+#
+# QRZ.com password - this goes with your user id above
+#
+# eg 
+# $qrz_pw = 'fishhooks';
+#
+
+$qrz_pw = undef;
+
+#
+# end
+#

diff --git a/perl/Messages b/perl/Messages
index 2cdae3387184b0e966e426091757bbeb8a6b476d..8494c7daebb42e30fa6fd017c8f64319c85c6c41 100644 (file)
--- a/perl/Messages
+++ b/perl/Messages
@@ -69,6 +69,7 @@ package DXM;
                                e21 => '$_[0] not numeric',
                                e22 => '$_[0] not a callsign',
                                e23 => '$_[0] not a range (eg 0/30000)', 
+                               e24 => 'Sorry, Internet access is not enabled',
 
                                echoon => 'Echoing enabled',
                                echooff => 'Echoing disabled',

diff --git a/perl/call.pl b/perl/call.pl
index 89cdb2f05c37d986c9689b46b364e0aca620c8c8..f2e96e15829d04a563b184b62fab07559080705a 100755 (executable)
--- a/perl/call.pl
+++ b/perl/call.pl
@@ -1,20 +1,37 @@
-#!/usr/bin/perl
 #
-# a little program to see if I can use ax25_call in a perl script
+# 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 $call = $self->call;
+my @out;
 
-use FileHandle;
-use IPC::Open2;
-
-$pid = Open2( \*IN, \*OUT, "ax25_call ether GB7DJK-1 G1TLH");
+return (1, "SHOW/CALL <callsign>, e.g. SH/CALL g1tlh") unless @list;
 
-IN->input_record_separator("\r");
-OUT->output_record_separator("\r");
-OUT->autoflush(1);
+use Net::Telnet;
 
-vec($rin, fileno(STDIN), 1) = 1;
-vec($rin, fileno(IN), 1) = 1;
+my $t = new Net::Telnet;
 
-while (($nfound = select($rout=$rin, undef, undef, 0.001)) >= 0) {
-  
+push @out, $self->msg('call1', 'AA6HF');
+foreach $l (@list) {
+       $t->open(Host     =>  "jeifer.pineknot.com",
+                        Port     =>  1235,
+                        Timeout  =>  5);
+       if ($t) {
+               $t->print(uc $l);
+               Log('call', "$call: show/call \U$l");
+               while (my $result = $t->getline) {
+                       push @out,$result;
+               }
+               $t->close;
+       } else {
+               push @out, $self->msg('e18', 'AA6HF');
+       }
 }
+
+return (1, @out);