From: minima Date: Tue, 7 Nov 2000 17:27:02 +0000 (+0000) Subject: removed sh/call.pl X-Git-Tag: R_1_45~32 X-Git-Url: http://dxcluster.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=3acdc2b85c646b97ecb7504fb5e982a8b5839455;p=spider.git removed sh/call.pl chanaged sh/qrz to new format added Internet.pm --- diff --git a/Changes b/Changes index dc64bf92..e6936fd5 100644 --- 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 index f2e96e15..00000000 --- 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 , 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 5301c2cd..9dd99818 100644 --- 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 , 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.,;:-]+)(?:
)?$/) { - 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 4477ea75..47e25c0b 100644 --- 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 index 00000000..44aacbed --- /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 2cdae338..8494c7da 100644 --- 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 89cdb2f0..f2e96e15 100755 --- 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 , 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);