From: Dirk Koopman 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://dxcluster.net/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|([^<]*)|; 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|([^<]*)|; - 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 =~ /^/) { + if ($msg =~ /^\s*/) { $conn->{state} = 'go'; - } elsif ($msg =~ /^/) { + } elsif ($msg =~ /^\s*/) { _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;