view release on metacpan or  search on metacpan

Client/lib/HTTunnel/Client.pm  view on Meta::CPAN

package HTTunnel::Client ;
@ISA = qw(LWP::UserAgent) ;

use strict ;
use LWP::UserAgent ;
use HTTP::Request::Common ;
use HTTP::Status ;
use IO::Select ;
use Carp ;


$HTTunnel::Client::VERSION = '0.08' ;


sub new {
	my $class = shift ;
	my $url = shift ;
	my %lwp_agent_args = @_ ;

	my $this = $class->SUPER::new(
		agent => 'HTTunnel::Client/$HTTunnel::Client::VERSION', 
		keep_alive => 1,
		%lwp_agent_args
	) ;

	$url =~ s/\/+$// ;
	$this->{__PACKAGE__}->{url} = $url ;
	$this->{__PACKAGE__}->{pid} = 0 ;
	$this->{__PACKAGE__}->{peer_info} = 0 ;

	bless($this, $class) ;

	return $this ;
}


sub connect {
	my $this = shift ;
	my $proto = shift || 'tcp' ;
	my $host = shift || 'localhost' ;
	my $port = shift || 0 ;
	my $timeout = shift || 15 ;

	$this->{__PACKAGE__}->{proto} = $proto ;
	my $fhid = $this->_execute(
		'connect', 
		[$proto, $host, $port, $timeout],
	) ;
	if ($proto eq 'tcp'){
		my ($addr, $port) = () ;
		($addr, $port, $fhid) = split(':', $fhid, 3) ;
		$this->{__PACKAGE__}->{fhid} = $fhid ;
		$this->{__PACKAGE__}->{peer_info} = "$addr:$port" ;
	}
	else {
		$this->{__PACKAGE__}->{fhid} = $fhid ;
	}

	return 1 ;
}


sub read {
	my $this = shift ;
	my $len = shift || 0 ;
	my $timeout = shift || 15 ;
	my $lifeline = shift ;
	my $lifeline_action = shift || sub {die("lifeline cut\n")} ;

	croak("HTTunnel::Client object is not connected") unless $this->{__PACKAGE__}->{fhid} ;

	while (1){
		if ($lifeline){
			my @ready = IO::Select->new($lifeline)->can_read(0) ;
			if (scalar(@ready)){
				$lifeline_action->() ;
				return undef ;
			}
		}
		my $addr = undef ;