File Coverage

blib/lib/LWP/Protocol/connect.pm

Criterion	Covered	Total	%
statement	6	23	26.0
branch	0	6	0.0
condition			n/a
subroutine	2	3	66.6
pod	1	1	100.0
total	9	33	27.2

package LWP::Protocol::connect;

use warnings;
use strict;

our $VERSION = '6.09'; # VERSION

require LWP::Protocol;
our @ISA = qw(LWP::Protocol);

our @supported_schemes = ( 'https', 'http' );

sub request {
    my($self, $request, $proxy, $arg, $size, $timeout) = @_;
    my $url = $request->uri;
    my $scheme = $url->scheme;

    if(!defined $proxy) {
	    return HTTP::Response->new( &HTTP::Status::RC_BAD_REQUEST,
		    'HTTP/CONNECT method protocol schema can only be used with a proxy!');
    }

    if( ! grep { $scheme eq $_ } @supported_schemes ) {
	    return HTTP::Response->new( &HTTP::Status::RC_BAD_REQUEST,
		    $scheme.' protocol scheme is not supported by '. __PACKAGE__ );
    }

    my $connect_scheme = $scheme."::connect";
    my $socket_scheme = $connect_scheme."::Socket";

    for my $scheme ( $connect_scheme, $socket_scheme ) {
        eval 'require LWP::Protocol::'.$scheme; ## no critic
	if( $@ ) {
	    return HTTP::Response->new( &HTTP::Status::RC_BAD_REQUEST,
		    'could not load '.$connect_scheme.' protocol support: '.$@);
	}
    }

    my $protocol = LWP::Protocol::create($connect_scheme, $self->{ua});
    $protocol->{proxy_connect_opts} = [
    	ProxyAddr => $proxy->host,
	ProxyPort => $proxy->port,
	ProxyUserinfo => $proxy->userinfo,
	Agent => $self->{ua},
    ];

    $protocol->request($request, undef, $arg, $size, $timeout);
}

1;

__END__