add some extra debugging to AsyncMsg

[spider.git] / perl / AsyncMsg.pm

diff --git a/perl/AsyncMsg.pm b/perl/AsyncMsg.pm
index f7b2bc0ddf1102520da25559887bd38456cda20a..9d2f0284b3004d87b5a654226e462859624b0cca 100644 (file)
--- 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("AsyncMsg: $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,
@@ -116,7 +123,7 @@ sub handle_raw
        $dxchan->send("$prefix$msg");
 }
 
-sub new 
+sub new
 {
        my $pkg = shift;
        my $call = shift;
@@ -164,30 +171,29 @@ 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) {
-               dbg("Sending '$sort $path HTTP/1.0'") if isdbg('async');
-               $conn->send_later("$sort $path HTTP/1.0\n");
+               _send_later($conn, "$sort $path HTTP/1.1\r\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");
+           _send_later($conn, "Host: $h\r\n");
+               _send_later($conn, "User-Agent: $u\r\n");
                while (my ($k,$v) = each %args) {
-                       $conn->send_later("$k: $v\n");
+                       _send_later($conn, "$k: $v\r\n");
                }
-               $conn->send_later("\n$d") if defined $d;
-               $conn->send_later("\n");
+               _send_later($conn, "\r\n$d") if defined $d;
+               _send_later($conn, "\r\n");
        }
        
        return $r ? $conn : undef;
@@ -263,6 +269,19 @@ sub disconnect
        $conn->SUPER::disconnect;
 }
 
+sub _send_later
+{
+       my $conn = shift;
+       my $m = shift;
+       
+       if (isdbg('async')) {
+               my $s = $m;
+               $s =~ s/([\%\x00-\x1f\x7f-\xff])/sprintf("%%%02X", ord($1))/eg;
+               dbg("AsyncMsg: send $s");
+       }
+       $conn->send_later($m);
+}
+
 sub DESTROY
 {
        my $conn = shift;