blob: a5ea4aacb841c17cbf1dfbfc71f8167239a117b0 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
package SOAP::Transport::HTTP::Event;
use Carp ();
use vars qw($AUTOLOAD @ISA);
@ISA = qw(SOAP::Transport::HTTP::Server);
sub DESTROY { SOAP::Trace::objects('()') }
#sub new { require HTTP::Daemon;
sub new {
my $obj = shift;
unless (ref $obj) {
my $class = ref($obj) || $obj;
my(@params, @methods);
while (@_) { $class->can($_[0]) ? push(@methods, shift() => shift) : push(@params, shift) }
$obj = $class->SUPER::new;
# Added in 0.65 - Thanks to Nils Sowen
# use SSL if there is any parameter with SSL_* in the name
$obj->SSL(1) if !$obj->SSL && grep /^SSL_/, @params;
my $http_daemon = $obj->http_daemon_class;
eval "require $http_daemon" or Carp::croak $@ unless
UNIVERSAL::can($http_daemon => 'new');
$obj->{_daemon} = $http_daemon->new(@params) or Carp::croak "Can't create daemon: $!";
# End SSL patch
# $obj->{_daemon} = HTTP::Daemon->new(@params) or Carp::croak "Can't create daemon: $!";
$obj->myuri(URI->new($obj->url)->canonical->as_string);
while (@methods) { my($method, $params) = splice(@methods,0,2);
$obj->$method(ref $params eq 'ARRAY' ? @$params : $params)
}
SOAP::Trace::objects('()');
}
return $obj;
}
sub SSL {
my $obj = shift->new;
@_ ? ($obj->{_SSL} = shift, return $obj) : return
$obj->{_SSL};
}
sub http_daemon_class { shift->SSL ? 'HTTP::Daemon::SSL' : 'HTTP::Daemon' }
sub AUTOLOAD {
my $method = substr($AUTOLOAD, rindex($AUTOLOAD, '::') + 2);
return if $method eq 'DESTROY';
no strict 'refs';
*$AUTOLOAD = sub { shift->{_daemon}->$method(@_) };
goto &$AUTOLOAD;
}
sub getDaemon {
my $obj = shift;
my $daemon = $obj->new;
return $daemon->{_daemon};
}
sub handle {
my $obj = shift;
my $sock = shift;
my $httpd = shift;
my $c = $sock->accept;
my $r = $c->get_request;
$obj->request($r);
$obj->SUPER::handle;
$c->send_response($obj->response);
# replaced ->close, thanks to Sean Meisner <Sean.Meisner@VerizonWireless.com>
# shutdown() doesn't work on AIX. close() is used in this case. Thanks to Jos Clijmans <jos.clijmans@recyfin.be>
UNIVERSAL::isa($c, 'shutdown') ? $c->shutdown(2) : $c->close();
$c->close;
}
1;
|
