X-Git-Url: http://gb7djk.dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FAsyncMsg.pm;h=f7b2bc0ddf1102520da25559887bd38456cda20a;hb=856cb98bb0f72ea86ea13c3e91d93aee7796fe9f;hp=618fee159d2fe281227e9c2ecaebfbaa357755d4;hpb=9fc2ec17088fbff22e825133a4b9b3efe5384df3;p=spider.git

diff --git a/perl/AsyncMsg.pm b/perl/AsyncMsg.pm
index 618fee15..f7b2bc0d 100644
--- a/perl/AsyncMsg.pm
+++ b/perl/AsyncMsg.pm
@@ -52,15 +52,35 @@ sub handle_get
 		if ($code == 200) {
 			# success
 			$conn->{state} = 'waitblank';
+		} elsif ($code == 302) {
+			# redirect
+			$conn->{state} = 'waitlocation';
 		} else {
 			$dxchan->send("$code $ascii");
 			$conn->disconnect;
 		} 
+	} elsif ($state  eq 'waitlocation') {
+		my ($path) = $msg =~ m|Location:\s*(.*)|;
+		if ($path) {
+			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}});
+			} elsif ($path =~ m|^/|) {
+				_getpost(ref $conn, $conn->{asyncsort}, $conn->{caller}, $conn->{peerhost}, $conn->{peerport}, $path,
+						 @{$conn->{asyncargs}});
+			}
+			delete $conn->{on_disconnect};
+			$conn->disconnect;
+		}
 	} elsif ($state eq 'waitblank') {
 		unless ($msg) {
 			$conn->{state} = 'indata';
 		}
-	} else {
+	} elsif ($conn->{state} eq 'indata') {
 		if (my $filter = $conn->{filter}) {
 			no strict 'refs';
 			# this will crash if the command has been redefined and the filter is a
@@ -132,40 +152,59 @@ sub new
 # Host: is always set to the name of the host (unless overridden)
 # User-Agent: is set to default above (unless overridden)
 #
-sub get
+sub _getpost
 {
 	my $pkg = shift;
+	my $sort = shift;
 	my $call = shift;
 	my $host = shift;
 	my $port = shift;
 	my $path = shift;
 	my %args = @_;
 	
-	my $filter = shift;
-	
+
 	my $conn = $pkg->new($call, \&handle_get);
+	$conn->{asyncargs} = [@_];
 	$conn->{state} = 'waitreply';
 	$conn->{filter} = 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;
 	
 	$r = $conn->connect($host, $port);
 	if ($r) {
-		dbg("Sending 'GET $path HTTP/1.0'") if isdbg('async');
-		$conn->send_later("GET $path HTTP/1.0\n");
+		dbg("Sending '$sort $path HTTP/1.0'") if isdbg('async');
+		$conn->send_later("$sort $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;
 		$conn->send_later("\n");
 	}
 	
 	return $r ? $conn : undef;
 }
 
+sub get
+{
+	my $pkg = shift;
+	_getpost($pkg, "GET", @_);
+}
+
+sub post
+{
+	my $pkg = shift;
+	_getpost($pkg, "POST", @_);
+}
+
 # do a raw connection
 #
 # Async->raw($self, <host>, <port>, [handler => CODE ref], [prefix => <string>]);
@@ -201,9 +240,9 @@ sub connect
 	# start a connection
 	my $r = $conn->SUPER::connect($host, $port);
 	if ($r) {
-		dbg("HTTPMsg: Connected $conn->{cnum} to $host $port") if isdbg('async');
+		dbg("AsyncMsg: Connected $conn->{cnum} to $host $port") if isdbg('async');
 	} else {
-		dbg("HTTPMsg: ***Connect $conn->{cnum} Failed to $host $port $!") if isdbg('async');
+		dbg("AsyncMsg: ***Connect $conn->{cnum} Failed to $host $port $!") if isdbg('async');
 	}
 	
 	return $r;
@@ -212,6 +251,14 @@ sub connect
 sub disconnect
 {
 	my $conn = shift;
+
+	if (my $ondisc = $conn->{on_disconnect}) {
+		my $dxchan = DXChannel::get($conn->{caller});
+		if ($dxchan) {
+			no strict 'refs';
+			$ondisc->($conn, $dxchan)
+		}
+	}
 	delete $outstanding{$conn};
 	$conn->SUPER::disconnect;
 }