2 # This class is the internal subclass that does various Async connects and
3 # retreivals of info. Typical uses (and specific support) include http get and
6 # This merely starts up a Msg handler (and no DXChannel) ($conn in other words)
7 # does the GET, parses out the result and the data and then (assuming a positive
8 # result and that the originating callsign is still online) punts out the data
11 # It isn't designed to be very clever.
13 # Copyright (c) 2013 - Dirk Koopman G1TLH
23 use vars qw(@ISA $deftimeout);
31 # standard http get handler
38 my $state = $conn->{_asstate};
40 dbg("asyncmsg: $state $msg") if isdbg('async');
42 # no point in going on if there is no-one wanting the output anymore
43 my $dxchan = DXChannel::get($conn->{caller});
49 if ($state eq 'waitreply') {
50 # look at the reply code and decide whether it is a success
51 my ($http, $code, $ascii) = $msg =~ m|(HTTP/\d\.\d)\s+(\d+)\s+(.*)|;
54 $conn->{_asstate} = 'waitblank';
55 } elsif ($code == 302) {
57 $conn->{_asstate} = 'waitlocation';
59 $dxchan->send("$code $ascii");
62 } elsif ($state eq 'waitlocation') {
63 my ($path) = $msg =~ m|Location:\s*(.*)|;
66 my @uri = split m|/+|, $path;
67 if ($uri[0] eq 'http:') {
69 my $host = shift @uri;
70 my $newpath = '/' . join('/', @uri);
71 $newpath .= '/' if $path =~ m|/$|;
72 $newconn = _getpost(ref $conn, $conn->{_assort}, $conn->{caller}, $host, 80, $newpath, @{$conn->{_asargs}});
73 } elsif ($path =~ m|^/|) {
74 $newconn = _getpost(ref $conn, $conn->{_assort}, $conn->{caller}, $conn->{peerhost}, $conn->{peerport}, $path, @{$conn->{_asargs}});
77 # copy over any elements in $conn that are not in $newconn
78 while (my ($k,$v) = each %$conn) {
79 dbg("async: $state copying over $k -> \$newconn") if isdbg('async');
80 $newconn{$k} = $v unless exists $newconn{$k};
83 delete $conn->{on_disconnect};
86 } elsif ($state eq 'waitblank') {
88 $conn->{_asstate} = 'indata';
90 } elsif ($conn->{_asstate} eq 'indata') {
91 if (my $filter = $conn->{_asfilter}) {
93 # this will crash if the command has been redefined and the filter is a
94 # function defined there whilst the request is in flight,
95 # but this isn't exactly likely in a production environment.
96 $filter->($conn, $msg, $dxchan);
98 my $prefix = $conn->{prefix} || '';
99 $dxchan->send("$prefix$msg");
107 # Just outputs everything
114 # no point in going on if there is no-one wanting the output anymore
115 my $dxchan = DXChannel::get($conn->{caller});
122 my $prefix = $conn->{prefix} || '';
123 $dxchan->send("$prefix$msg");
132 my $conn = $pkg->SUPER::new($handler);
133 $conn->{caller} = ref $call ? $call->call : $call;
136 $outstanding{$conn} = $conn;
141 # This does a http get on a path on a host and
142 # returns the result (through an optional filter)
144 # expects to be called something like from a cmd.pl file:
146 # AsyncMsg->get($self, <host>, <port>, <path>, [<key=>value>...]
148 # Standard key => value pairs are:
150 # filter => CODE ref (e.g. sub { ... })
151 # prefix => <string> prefix output with this string
153 # Anything else is taken and sent as (extra) http header stuff e.g:
155 # 'User-Agent' => qq{DXSpider;$main::version;$main::build;$^O}
156 # 'Content-Type' => q{text/xml; charset=utf-8}
157 # 'Content-Length' => $lth
159 # Host: is always set to the name of the host (unless overridden)
160 # User-Agent: is set to default above (unless overridden)
173 my $conn = $pkg->new($call, \&handle_get);
174 $conn->{_asargs} = [@_];
175 $conn->{_asstate} = 'waitreply';
176 $conn->{_asfilter} = delete $args{filter} if exists $args{filter};
177 $conn->{prefix} = delete $args{prefix} if exists $args{prefix};
178 $conn->{on_disconnect} = delete $args{on_disc} || delete $args{on_disconnect};
179 $conn->{path} = $path;
180 $conn->{_assort} = $sort;
182 $r = $conn->connect($host, $port);
184 return $r ? $conn : undef;
187 sub _getpost_onconnect
190 dbg("Sending '$sort $path HTTP/1.0'") if isdbg('async');
191 $conn->send_later("$sort $path HTTP/1.0\n");
193 my $h = delete $args{Host} || $host;
194 my $u = delete $args{'User-Agent'} || "DxSpider;$main::version;$main::build;$^O;$main::mycall";
195 my $d = delete $args{data};
197 $conn->send_later("Host: $h\n");
198 $conn->send_later("User-Agent: $u\n");
199 while (my ($k,$v) = each %args) {
200 $conn->send_later("$k: $v\n");
202 $conn->send_later("\n$d") if defined $d;
203 $conn->send_later("\n");
209 _getpost($pkg, "GET", @_);
215 _getpost($pkg, "POST", @_);
218 # do a raw connection
220 # Async->raw($self, <host>, <port>, [handler => CODE ref], [prefix => <string>]);
223 # With no handler defined, everything sent by the connection will be sent to
226 # One can send stuff out on the connection by doing a standard "$conn->send_later(...)"
227 # inside the (custom) handler.
238 my $handler = delete $args{handler} || \&handle_raw;
239 my $conn = $pkg->new($call, $handler);
240 $conn->{prefix} = delete $args{prefix} if exists $args{prefix};
241 $r = $conn->connect($host, $port);
242 return $r ? $conn : undef;
249 dbg("AsyncMsg: Connected $conn->{cnum} to $host $port") if isdbg('async');
256 dbg("AsyncMsg: ***Connect $conn->{cnum} Failed to $host $port $!") if isdbg('async');
266 my $r = $conn->SUPER::connect($host, $port, on_connect => &\_on_connect);
275 if (my $ondisc = $conn->{on_disconnect}) {
276 my $dxchan = DXChannel::get($conn->{caller});
279 $ondisc->($conn, $dxchan)
282 delete $outstanding{$conn};
283 $conn->SUPER::disconnect;
289 delete $outstanding{$conn};
290 $conn->SUPER::DESTROY;