]> dxcluster.net Git - spider.git/commitdiff
sh/qrz now working correctly with mojo
authorDirk Koopman <djk@tobit.co.uk>
Mon, 16 Jun 2014 17:15:21 +0000 (18:15 +0100)
committerDirk Koopman <djk@tobit.co.uk>
Mon, 16 Jun 2014 17:15:21 +0000 (18:15 +0100)
Changes
cmd/show/db0sdx.pl
cmd/show/qrz.pl
perl/AsyncMsg.pm

diff --git a/Changes b/Changes
index c62c1567c95364145acbae85ff4d92b485743f53..b4741006a53ec19d05841315b057b380d9e37e3d 100644 (file)
--- a/Changes
+++ b/Changes
@@ -1,3 +1,5 @@
+16Jun14=======================================================================
+1. Get AsyncMsg working for HTTP type ephemeral connections
 21Apr14=======================================================================
 1. Add CTY-2405 prefix list
 08Mar14=======================================================================
index 370b0b7fc3bad1965538df2b1bfd7ebd16132348..b7574761512fd430a9cad9ded5ed6f9558bafb3a 100644 (file)
@@ -72,7 +72,7 @@ sub handle
        my $lth = length($s)+1;
        
        Log('call', "$call: show/db0sdx $line");
-       my $conn = AsyncMsg->post($self, $target, $port, "$path$suffix", prefix => 'sdx> ', filter => \&process,
+       my $conn = AsyncMsg->post($self, $target, "$path$suffix", prefix => 'sdx> ', filter => \&process,
                                                         'Content-Type' => 'text/xml; charset=utf-8',
                                                         'Content-Length' => $lth,
                                                          Connection => 'Close',
index 6782b1a16377d8c5cf0941c2aedf314e8a5b756c..9a7d921fd6403268c6999e4932710c1ef99ff791 100644 (file)
@@ -67,13 +67,13 @@ sub handle
 
        return (1, $self->msg('e24')) unless $Internet::allow;
        return (1, "SHOW/QRZ <callsign>, e.g. SH/QRZ g1tlh") unless $line;
-       my $target = $Internet::qrz_url || 'xmldata.qrz.com';
+       my $target = $Internet::qrz_url || 'xml.qrz.com';
        my $port = 80;
        my $path = qq{/xml/current/?callsign=$line;username=$Internet::qrz_uid;password=$Internet::qrz_pw;agent=dxspider};
        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);
+       my $conn = AsyncMsg->get($self, $target, $path, filter=>\&filter, prefix=>'qrz> ', on_disc=>\&_on_disc);
        if ($conn) {
                $conn->{state} = 'blank';
                push @out, $self->msg('m21', "show/qrz");
index fe04f822fb2cbcf00b1f37b9c2e634d76f2652d9..cb0878762f1ba7f3d60dd5c4b8cd43bf2366100d 100644 (file)
@@ -27,17 +27,24 @@ $deftimeout = 15;
 
 my %outstanding;
 
-#
-# standard http get handler
-#
-sub handle_get
+sub new 
 {
-       my $conn = shift;
-       my $msg = shift;
+       my $pkg = shift;
+       my $call = shift;
+       my $handler = shift;
+       
+       my $conn = $pkg->SUPER::new($handler);
+       $conn->{caller} = ref $call ? $call->call : $call;
 
-       my $state = $conn->{_asstate};
+       # make it persistent
+       $outstanding{$conn} = $conn;
        
-       dbg("asyncmsg: $state $msg") if isdbg('async');
+       return $conn;
+}
+
+sub handle_getpost
+{
+       my ($conn, $ua, $tx) = @_;
 
        # no point in going on if there is no-one wanting the output anymore
        my $dxchan = DXChannel::get($conn->{caller});
@@ -46,48 +53,11 @@ sub handle_get
                return;
        }
        
-       if ($state eq 'waitreply') {
-               # look at the reply code and decide whether it is a success
-               my ($http, $code, $ascii) = $msg =~ m|(HTTP/\d\.\d)\s+(\d+)\s+(.*)|;
-               if ($code == 200) {
-                       # success
-                       $conn->{_asstate} = 'waitblank';
-               } elsif ($code == 302) {
-                       # redirect
-                       $conn->{_asstate} = 'waitlocation';
-               } else {
-                       $dxchan->send("$code $ascii");
-                       $conn->disconnect;
-               } 
-       } 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|/$|;
-                               $newconn = _getpost(ref $conn, $conn->{_assort}, $conn->{caller}, $host, 80, $newpath, @{$conn->{_asargs}});
-                       } elsif ($path =~ m|^/|) {
-                               $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->{_asstate} = 'indata';
-               }
-       } elsif ($conn->{_asstate} eq 'indata') {
+       my @lines = split qr{\r?\n}, $tx->res->body;
+       
+       foreach my $msg(@lines) {
+               dbg("AsyncMsg: $conn->{_asstate} $msg") if isdbg('async');
+               
                if (my $filter = $conn->{_asfilter}) {
                        no strict 'refs';
                        # this will crash if the command has been redefined and the filter is a
@@ -99,43 +69,8 @@ sub handle_get
                        $dxchan->send("$prefix$msg");
                }
        }
-}
-
-# 
-# simple raw handler
-#
-# Just outputs everything
-#
-sub handle_raw
-{
-       my $conn = shift;
-       my $msg = shift;
-
-       # no point in going on if there is no-one wanting the output anymore
-       my $dxchan = DXChannel::get($conn->{caller});
-       unless ($dxchan) {
-               $conn->disconnect;
-               return;
-       }
-
-       # send out the data
-       my $prefix = $conn->{prefix} || '';
-       $dxchan->send("$prefix$msg");
-}
-
-sub new 
-{
-       my $pkg = shift;
-       my $call = shift;
-       my $handler = shift;
-       
-       my $conn = $pkg->SUPER::new($handler);
-       $conn->{caller} = ref $call ? $call->call : $call;
-
-       # make it persistent
-       $outstanding{$conn} = $conn;
        
-       return $conn;
+       $conn->disconnect;
 }
 
 # This does a http get on a path on a host and
@@ -165,46 +100,62 @@ sub _getpost
        my $sort = shift;
        my $call = shift;
        my $host = shift;
-       my $port = shift;
        my $path = shift;
        my %args = @_;
        
 
-       my $conn = $pkg->new($call, \&handle_get);
+       my $conn = $pkg->new($call);
        $conn->{_asargs} = [@_];
        $conn->{_asstate} = 'waitreply';
        $conn->{_asfilter} = delete $args{filter} if exists $args{filter};
        $conn->{prefix} = delete $args{prefix} if exists $args{prefix};
+       $conn->{prefix} ||= '';
        $conn->{on_disconnect} = delete $args{on_disc} || delete $args{on_disconnect};
        $conn->{path} = $path;
-       $conn->{host} = $host;
-       $conn->{port} = $port;
+       $conn->{host} = $conn->{peerhost} = $host;
+       $conn->{port} = $conn->{peerport} = delete $args{port} || 80;
+       $conn->{sort} = 'outgoing';
        $conn->{_assort} = $sort;
+       $conn->{csort} = 'http';
+
+       my $ua =  Mojo::UserAgent->new;
+       my $s;
+       $s .= $host;
+       $s .= ":$port" unless $conn->{port} == 80;
+       $s .= $path;
+       dbg("AsyncMsg: $sort $s") if isdbg('async');
        
-       $r = $conn->connect($host, $port, on_connect=>sub {$conn->_on_getpost_connect(@_)});
+       my $tx = $ua->build_tx($sort => $s);
+       $ua->on(error => sub { $conn->_error(@_); });
+#      $tx->on(error => sub { $conn->_error(@_); });
+#      $tx->on(finish => sub { $conn->disconnect; });
+
+       $ua->start($tx => sub { $conn->handle_getpost(@_) }); 
+
        
-       return $r ? $conn : undef;
+       $conn->{mojo} = $ua;
+       return $conn if $tx;
+
+       $conn->disconnect;
+       return undef;
 }
 
-sub _on_getpost_connect
+sub _dxchan_send
 {
        my $conn = shift;
-       
-       dbg("Sending '$conn->{_assort} $conn->{path} HTTP/1.0'") if isdbg('async');
-       $conn->send_later("$conn->{_assort} $conn->{path} HTTP/1.0\n");
-       
-       my $h = delete $args{Host} || $host;
-       my $u = delete $args{'User-Agent'} || "DxSpider;$main::version;$main::build;$^O;$main::mycall"; 
-       my $d = delete $args{data};
-       
-       $conn->send_later("Host: $h\n");
-       $conn->send_later("User-Agent: $u\n");
-       while (my ($k,$v) = each %args) {
-               $conn->send_later("$k: $v\n");
-       }
-       $conn->send_later("\n$d") if defined $d;
+       my $msg = shift;
+       my $dxchan = DXChannel::get($conn->{caller});
+       $dxchan->send($msg) if $dxchan;
 }
 
+sub _error
+{
+       my ($conn, $e, $err);
+       dbg("Async: $conn->host:$conn->port path $conn->{path} error $err") if isdbg('chan');
+       $conn->_dxchan_send("$conn->{prefix}$msg");
+       $conn->disconnect;
+}
+       
 sub get
 {
        my $pkg = shift;
@@ -239,10 +190,33 @@ sub raw
        my $handler = delete $args{handler} || \&handle_raw;
        my $conn = $pkg->new($call, $handler);
        $conn->{prefix} = delete $args{prefix} if exists $args{prefix};
+       $conn->{prefix} ||= '';
        $r = $conn->connect($host, $port, on_connect => &_on_raw_connect);
        return $r ? $conn : undef;
 }
 
+# 
+# simple raw handler
+#
+# Just outputs everything
+#
+sub handle_raw
+{
+       my $conn = shift;
+       my $msg = shift;
+
+       # no point in going on if there is no-one wanting the output anymore
+       my $dxchan = DXChannel::get($conn->{caller});
+       unless ($dxchan) {
+               $conn->disconnect;
+               return;
+       }
+
+       # send out the data
+       $dxchan->send("$conn->{prefix}$msg");
+}
+
+
 sub _on_raw_connect
 {
        my $conn = shift;
@@ -280,6 +254,7 @@ sub disconnect
                        $ondisc->($conn, $dxchan)
                }
        }
+       delete $conn->{mojo};
        delete $outstanding{$conn};
        $conn->SUPER::disconnect;
 }