X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FAsyncMsg.pm;h=0456efc98906d2184ff2063d2bcee276075e6d06;hb=8bb293d5a1ca7a53f2ce50bd8e9e728865069b7f;hp=618fee159d2fe281227e9c2ecaebfbaa357755d4;hpb=89eaa6762e986e15ba3167ba3400a38cda1faf80;p=spider.git diff --git a/perl/AsyncMsg.pm b/perl/AsyncMsg.pm index 618fee15..0456efc9 100644 --- a/perl/AsyncMsg.pm +++ b/perl/AsyncMsg.pm @@ -132,9 +132,10 @@ 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; @@ -147,25 +148,42 @@ sub get $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; $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, , , [handler => CODE ref], [prefix => ]); @@ -212,6 +230,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; }