From cc83de0d5705ea91c54f5a3472045594f615d7d7 Mon Sep 17 00:00:00 2001 From: Dirk Koopman Date: Sat, 7 Sep 2013 23:08:15 +0100 Subject: [PATCH] AsyncMsgise sh/qrz Which was quite easy compared to some... --- cmd/show/qrz.pl | 111 ++++++++++++++++++++++++++---------------------- perl/Version.pm | 4 +- 2 files changed, 63 insertions(+), 52 deletions(-) diff --git a/cmd/show/qrz.pl b/cmd/show/qrz.pl index 9a3f9c3f..b9d70441 100644 --- a/cmd/show/qrz.pl +++ b/cmd/show/qrz.pl @@ -4,63 +4,74 @@ # from an idea by Steve Franke K9AN and information from Angel EA7WA # and finally (!) modified to use the XML interface # -# Copyright (c) 2001-2009 Dirk Koopman G1TLH +# Then made asyncronous... +# +# Copyright (c) 2001-2013 Dirk Koopman G1TLH # -my ($self, $line) = @_; -my @list = split /\s+/, $line; # generate a list of callsigns -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; -my $target = $Internet::http_proxy || $Internet::qrz_url || 'xml.qrz.com'; -my $port = $Internet::http_proxy_port || 80; -my $url = ''; -$url = 'http://' . ($Internet::qrz_url | 'xml.qrz.com') if $Internet::http_proxy; +sub _send +{ + my $conn = shift; + my $msg = shift; + my $dxchan = shift; -use Net::Telnet; + my ($tag, $data) = $msg =~ m|^\s*<(\w+)>(.*){prefix} || ' '; + $dxchan->send($prefix . sprintf("%-10s: $data", $tag)); +} -my $t = new Net::Telnet; +sub filter +{ + my $conn = shift; + my $msg = shift; + my $dxchan = shift; -foreach $l (@list) { - eval { - $t->open(Host => $target, - Port => $port, - Timeout => 15); - }; + my $state = $conn->{state}; + + dbg("qrz: $state $msg") if isdbg('qrz'); - if (!$t || $@) { - push @out, $self->msg('e18', 'QRZ.com'); - } else { - my $s = "GET /xml?callsign=$l;username=$Internet::qrz_uid;password=$Internet::qrz_pw;agent=dxspider HTTP/1.0\n\n"; - dbg($s) if isdbg('qrz'); - $t->print($s); - Log('call', "$call: show/qrz \U$l"); - my $state = "blank"; - while (my $result = eval { $t->getline(Timeout => 30) } || $@) { - dbg($result) if isdbg('qrz') && $result; - if ($@) { - push @out, $self->msg('e18', 'QRZ.com'); - last; - } - if ($state eq 'blank' && $result =~ /^/i) { - $state = 'go'; - } elsif ($state eq 'go') { - next if $result =~ m||; - next if $result =~ m||; - next if $result =~ m||; - next if $result =~ m||; - next if $result =~ m||; - last if $result =~ m||; - my ($tag, $data) = $result =~ m|^\s*<(\w+)>(.*)/) { + $conn->{state} = 'go'; + } elsif ($msg =~ /^/) { + _send($conn, $msg, $dxchan); + } + } elsif ($state eq 'go') { + return if $msg =~ m||; + return if $msg =~ m||; + return if $msg =~ m||; + return if $msg =~ m||; + return if $msg =~ m||; + if ($msg =~ m||) { + $conn->{state} = 'skip'; + return; } - $t->close; - push @out, $self->msg('e3', 'qrz.com', uc $l) unless @out; +# $DB::single = 1; + _send($conn, $msg, $dxchan); } } -return (1, @out); +sub handle +{ + my ($self, $line) = @_; + my $call = $self->call; + my @out; + + return (1, $self->msg('e24')) unless $Internet::allow; + return (1, "SHOW/QRZ , e.g. SH/QRZ g1tlh") unless $line; + my $target = $Internet::qrz_url || 'xml.qrz.com'; + my $port = 80; + my $path = qq{/xml?callsign=$line;username=$Internet::qrz_uid;password=$Internet::qrz_pw;agent=dxspider}; + dbg("qrz: $path") if isdbg('qrz'); + + Log('call', "$call: show/qrz \U$line"); + my $conn = AsyncMsg->get($self, $target, $port, $path, filter=>\&filter, prefix=>'qrz> '); + if ($conn) { + $conn->{state} = 'blank'; + push @out, $self->msg('m21', "show/qrz"); + } else { + push @out, $self->msg('e18', 'QRZ.com'); + } + + return (1, @out); +} diff --git a/perl/Version.pm b/perl/Version.pm index a5078436..4178804a 100644 --- a/perl/Version.pm +++ b/perl/Version.pm @@ -11,7 +11,7 @@ use vars qw($version $subversion $build $gitversion); $version = '1.55'; $subversion = '0'; -$build = '128'; -$gitversion = '1ec21f9'; +$build = '129'; +$gitversion = '9fc2ec1'; 1; -- 2.43.0