SOAP-Lite
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
lib/SOAP/Transport/TCP.pm view on Meta::CPAN
# ======================================================================
#
# Copyright (C) 2000-2001 Paul Kulchenko (paulclinger@yahoo.com)
# SOAP::Lite is free software; you can redistribute it
# and/or modify it under the same terms as Perl itself.
#
# $Id: TCP.pm 384 2011-08-16 17:08:08Z kutterma $
#
# ======================================================================
package SOAP::Transport::TCP;
use strict;
our $VERSION = '1.27'; # VERSION
use URI;
use IO::Socket;
use IO::Select;
use IO::SessionData;
# ======================================================================
package # hide from PAUSE
URI::tcp; # ok, let's do 'tcp://' scheme
our $VERSION = 0.715;
require URI::_server;
@URI::tcp::ISA=qw(URI::_server);
# ======================================================================
package SOAP::Transport::TCP::Client;
our $VERSION = 0.715;
use vars qw(@ISA);
require SOAP::Lite;
@ISA = qw(SOAP::Client);
sub DESTROY { SOAP::Trace::objects('()') }
sub new {
my $self = shift;
unless (ref $self) {
my $class = ref($self) || $self;
my(@params, @methods);
while (@_) { $class->can($_[0]) ? push(@methods, shift() => shift) : push(@params, shift) }
$self = bless {@params} => $class;
while (@methods) { my($method, $params) = splice(@methods,0,2);
$self->$method(ref $params eq 'ARRAY' ? @$params : $params)
}
# use SSL if there is any parameter with SSL_* in the name
$self->SSL(1) if !$self->SSL && grep /^SSL_/, keys %$self;
SOAP::Trace::objects('()');
}
return $self;
}
sub SSL {
my $self = shift->new;
@_ ? ($self->{_SSL} = shift, return $self) : return $self->{_SSL};
}
sub io_socket_class { shift->SSL ? 'IO::Socket::SSL' : 'IO::Socket::INET' }
sub syswrite {
my($self, $sock, $data) = @_;
my $timeout = $sock->timeout;
my $select = IO::Select->new($sock);
my $len = length $data;
while (length $data > 0) {
return unless $select->can_write($timeout);
local $SIG{PIPE} = 'IGNORE';
# added length() to make it work on Mac. Thanks to Robin Fuller <rfuller@broadjump.com>
my $wc = syswrite($sock, $data, length($data));
if (defined $wc) {
substr($data, 0, $wc) = '';
} elsif (!IO::SessionData::WOULDBLOCK($!)) {
return;
}
}
return $len;
}
sub sysread {
my($self, $sock) = @_;
my $timeout = $sock->timeout;
my $select = IO::Select->new($sock);
my $result = '';
my $data;
while (1) {
return unless $select->can_read($timeout);
my $rc = sysread($sock, $data, 4096);
if ($rc) {
$result .= $data;
} elsif (defined $rc) {
return $result;
} elsif (!IO::SessionData::WOULDBLOCK($!)) {
return;
}
}
}
view all matches for this distributionview release on metacpan - search on metacpan
( run in 0.630 second using v1.00-cache-2.02-grep-82fe00e-cpan-2c419f77a38b )