From: Dirk Koopman <djk@tobit.co.uk>
Date: Thu, 12 Sep 2013 12:40:05 +0000 (+0100)
Subject: fix AsyncMsg state handling and sh/qrz
X-Git-Tag: 1.57~2
X-Git-Url: http://dxspider.org/gitweb/gitweb.cgi?a=commitdiff_plain;h=725d28d2ebfb1fd2ae83ba10d68c7337678a5c1b;p=spider.git
fix AsyncMsg state handling and sh/qrz
---
diff --git a/cmd/show/db0sdx.pl b/cmd/show/db0sdx.pl
index 5132b2f9..370b0b7f 100644
--- a/cmd/show/db0sdx.pl
+++ b/cmd/show/db0sdx.pl
@@ -19,15 +19,16 @@ sub on_disc
my ($info) = $conn->{sdxin} =~ m|<qslinfoResult>([^<]*)</qslinfoResult>|;
dbg("info: $info");
+ my $prefix = $conn->{prefix} || '';
my @in = split /[\r\n]/, $info if $info;
if (@in && $in[0]) {
dbg("in qsl");
- push @out, @in;
+ push @out, map {"$prefix$_"} @in;
} else {
dbg("in fault");
($info) = $conn->{sdxin} =~ m|<faultstring>([^<]*)</faultstring>|;
- push @out, $info if $info;
+ push @out, "$prefix$info" if $info;
push @out, $dxchan->msg('e3', 'DB0SDX', $conn->{sdxline}) unless @out;
}
$dxchan->send(@out);
diff --git a/cmd/show/qrz.pl b/cmd/show/qrz.pl
index 3e928f58..6782b1a1 100644
--- a/cmd/show/qrz.pl
+++ b/cmd/show/qrz.pl
@@ -11,7 +11,7 @@
use vars qw (%allowed);
-%allowed = qw(call 1 fname 1 name 1 addr2 1 state 1 country 1 lat 1 lon 1 county 1 moddate 1 qslmgr 1 grid 1 );
+%allowed = qw(call 1 fname 1 name 1 addr2 1 state 1 country 1 lat 1 lon 1 county 1 moddate 1 qslmgr 1 grid 1 Error 1 );
sub _send
{
@@ -44,9 +44,9 @@ sub filter
dbg("qrz: $state $msg") if isdbg('qrz');
if ($state eq 'blank') {
- if ($msg =~ /^<Callsign>/) {
+ if ($msg =~ /^\s*<Callsign>/) {
$conn->{state} = 'go';
- } elsif ($msg =~ /^<Error>/) {
+ } elsif ($msg =~ /^\s*<Error>/) {
_send($conn, $msg, $dxchan);
}
} elsif ($state eq 'go') {
@@ -70,7 +70,7 @@ sub handle
my $target = $Internet::qrz_url || 'xmldata.qrz.com';
my $port = 80;
my $path = qq{/xml/current/?callsign=$line;username=$Internet::qrz_uid;password=$Internet::qrz_pw;agent=dxspider};
- dbg("qrz: $path") if isdbg('qrz');
+ dbg("qrz: $target:$port$path") if isdbg('qrz');
Log('call', "$call: show/qrz \U$line");
my $conn = AsyncMsg->get($self, $target, $port, $path, filter=>\&filter, prefix=>'qrz> ', on_disc=>\&_on_disc);
diff --git a/perl/AsyncMsg.pm b/perl/AsyncMsg.pm
index f7b2bc0d..c2eeaadc 100644
--- a/perl/AsyncMsg.pm
+++ b/perl/AsyncMsg.pm
@@ -35,9 +35,9 @@ sub handle_get
my $conn = shift;
my $msg = shift;
- my $state = $conn->{state};
+ my $state = $conn->{_asstate};
- dbg("asyncmsg: $msg") if isdbg('async');
+ dbg("asyncmsg: $state $msg") if isdbg('async');
# no point in going on if there is no-one wanting the output anymore
my $dxchan = DXChannel::get($conn->{caller});
@@ -51,10 +51,10 @@ sub handle_get
my ($http, $code, $ascii) = $msg =~ m|(HTTP/\d\.\d)\s+(\d+)\s+(.*)|;
if ($code == 200) {
# success
- $conn->{state} = 'waitblank';
+ $conn->{_asstate} = 'waitblank';
} elsif ($code == 302) {
# redirect
- $conn->{state} = 'waitlocation';
+ $conn->{_asstate} = 'waitlocation';
} else {
$dxchan->send("$code $ascii");
$conn->disconnect;
@@ -62,26 +62,33 @@ sub handle_get
} elsif ($state eq 'waitlocation') {
my ($path) = $msg =~ m|Location:\s*(.*)|;
if ($path) {
+ my $newconn;
my @uri = split m|/+|, $path;
if ($uri[0] eq 'http:') {
shift @uri;
my $host = shift @uri;
my $newpath = '/' . join('/', @uri);
$newpath .= '/' if $path =~ m|/$|;
- _getpost(ref $conn, $conn->{asyncsort}, $conn->{caller}, $host, 80, $newpath, @{$conn->{asyncargs}});
+ $newconn = _getpost(ref $conn, $conn->{_assort}, $conn->{caller}, $host, 80, $newpath, @{$conn->{_asargs}});
} elsif ($path =~ m|^/|) {
- _getpost(ref $conn, $conn->{asyncsort}, $conn->{caller}, $conn->{peerhost}, $conn->{peerport}, $path,
- @{$conn->{asyncargs}});
+ $newconn = _getpost(ref $conn, $conn->{_assort}, $conn->{caller}, $conn->{peerhost}, $conn->{peerport}, $path, @{$conn->{_asargs}});
+ }
+ if ($newconn) {
+ # copy over any elements in $conn that are not in $newconn
+ while (my ($k,$v) = each %$conn) {
+ dbg("async: $state copying over $k -> \$newconn") if isdbg('async');
+ $newconn{$k} = $v unless exists $newconn{$k};
+ }
}
delete $conn->{on_disconnect};
$conn->disconnect;
}
} elsif ($state eq 'waitblank') {
unless ($msg) {
- $conn->{state} = 'indata';
+ $conn->{_asstate} = 'indata';
}
- } elsif ($conn->{state} eq 'indata') {
- if (my $filter = $conn->{filter}) {
+ } elsif ($conn->{_asstate} eq 'indata') {
+ if (my $filter = $conn->{_asfilter}) {
no strict 'refs';
# this will crash if the command has been redefined and the filter is a
# function defined there whilst the request is in flight,
@@ -164,13 +171,13 @@ sub _getpost
my $conn = $pkg->new($call, \&handle_get);
- $conn->{asyncargs} = [@_];
- $conn->{state} = 'waitreply';
- $conn->{filter} = delete $args{filter} if exists $args{filter};
+ $conn->{_asargs} = [@_];
+ $conn->{_asstate} = 'waitreply';
+ $conn->{_asfilter} = delete $args{filter} if exists $args{filter};
$conn->{prefix} = delete $args{prefix} if exists $args{prefix};
$conn->{on_disconnect} = delete $args{on_disc} || delete $args{on_disconnect};
$conn->{path} = $path;
- $conn->{asyncsort} = $sort;
+ $conn->{_assort} = $sort;
$r = $conn->connect($host, $port);
if ($r) {
diff --git a/perl/Version.pm b/perl/Version.pm
index 6efa7834..51cbbfcd 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 = '134';
-$gitversion = 'b099b4a';
+$build = '135';
+$gitversion = '564b5b3';
1;