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});
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->{_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->{state} = 'indata';
+ $conn->{_asstate} = 'indata';
}
- } else {
- 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,
# 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->{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->{_assort} = $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>]);
# 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;
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;
}