view release on metacpan or  search on metacpan

Client/httunnel  view on Meta::CPAN

sub sdebug ($;$$){
	my $msg = shift ;
	my $indent = shift ;
	my $maybe_binary = shift ;

	if ($DEBUG){
		slog('debug', $msg, $indent, $maybe_binary) ;
	}
}


sub slog ($$;$$){
    my $level = shift ;
    my $msg = shift ;
	my $indent = shift || '' ;
	my $maybe_binary = shift ;

	if (($DEBUG)||($SYSLOG)){
		my @lines = split(/\n/, $msg) ;
		foreach my $l (@lines){
			if ($SYSLOG){
				# We do not send possible binary debug info to syslog since it may screw up syslog.
				Sys::Syslog::syslog($level, "$indent$l") unless $maybe_binary ;
			}
			elsif ($DEBUG){
				if ((! $maybe_binary)||($DEBUG > 1)){
					print STDERR "[$$][$level] $indent$l\n" ;
				}
			}
		}
	}
}


sub sdie ($){
	my $msg = shift ;

	$DEBUG = 1 ;
	slog('err', $msg) ;
	exit(1) ;
}



###############################################################################



package My::HTTunnel::Client ;
BEGIN { @My::HTTunnel::Client::ISA = qw(HTTunnel::Client) ; }


use strict ;


sub new {
	my $class = shift ;
	my $cfg = shift ;

	my $this = $class->SUPER::new($cfg->{url}, @_) ;
	$this->{__PACKAGE__}->{cfg} = $cfg ;
	bless($this, $class) ;

	return $this ;
}


sub get_basic_credentials {
	my $this = shift ;
	my $realm = shift ;
	my $uri = shift ;
	my $proxy = shift ;

	my $cfg = $this->{__PACKAGE__}->{cfg} ;
	if ($proxy){
		return ($cfg->{http_proxy_username}, $cfg->{http_proxy_password}) ;
	}

	return ($cfg->{http_username}, $cfg->{http_password}) ;
}


sub request_callback {
	my $this = shift ;
	my $req = shift ;

	$req->protocol($this->{__PACKAGE__}->{cfg}->{http_protocol}) ;
	main::sdebug("HTTP Request:") ;
	main::sdebug(join(' ', $req->method(), $req->uri(), $req->protocol()), '  ') ;
	main::sdebug($req->headers()->as_string(), '  ') ;
	main::sdebug($req->content(), '  ', 1) ;
}


sub response_callback {
	my $this = shift ;
	my $resp = shift ;

	main::sdebug("HTTP Response:") ;
	main::sdebug(join(' ', $resp->protocol(), $resp->code(), $resp->message()), '  ') ;
	main::sdebug($resp->headers()->as_string(), '  ') ;
	main::sdebug($resp->content(), '  ', 1) ;
}