File Coverage

blib/lib/AnyEvent/Connector.pm

Criterion	Covered	Total	%
statement	77	80	96.2
branch	25	28	89.2
condition	1	3	33.3
subroutine	15	15	100.0
pod	3	3	100.0
total	121	129	93.8

package AnyEvent::Connector;
use strict;
use warnings;
use Carp qw(croak);
use AnyEvent::Socket ();
use URI;

use AnyEvent::Connector::Proxy::http;


our $VERSION = "0.04";

sub new {
    my ($class, %args) = @_;
    my $self = bless {
        proxy_obj => undef,
        no_proxy => []
    }, $class;
    $self->_env_proxy_for($args{env_proxy});
    my $proxy = $args{proxy};
    if(defined($proxy)) {
        $self->_set_proxy($proxy);
    }
    my $no_proxy = $args{no_proxy};
    if(defined($no_proxy)) {
        $self->_set_no_proxy($no_proxy);
    }
    return $self;
}

sub _set_proxy {
    my ($self, $proxy) = @_;
    if($proxy eq "") {
        $self->{proxy_obj} = undef;
        return;
    }
    my $proxy_uri = URI->new($proxy);
    my $scheme = $proxy_uri->scheme;
    if(!defined($scheme) || $scheme ne "http") {
        croak "Only http proxy is supported: $proxy";
    }
    $self->{proxy_obj} = AnyEvent::Connector::Proxy::http->new($proxy_uri);
}

sub _set_no_proxy {
    my ($self, $no_proxy) = @_;
    my $ref = ref($no_proxy);
    if($ref eq "ARRAY") {
        ;
    }elsif(!$ref) {
        $no_proxy = [$no_proxy];
    }else {
        croak "no_proxy expects STRING or ARRAYREF, but it was $ref";
    }
    $self->{no_proxy} = [grep {$_ ne ""} @$no_proxy];
}

sub _env_proxy_for {
    my ($self, $protocol) = @_;
    return if !defined($protocol);
    $self->_env_no_proxy();
    my @keys = (lc($protocol) . "_proxy", uc($protocol) . "_PROXY");
    foreach my $key (@keys) {
        my $p = $ENV{$key};
        if(defined($p)) {
            $self->_set_proxy($p);
            return;
        }
    }
}

sub _env_no_proxy {
    my ($self) = @_;
    foreach my $key (qw(no_proxy NO_PROXY)) {
        my $no_proxy = $ENV{$key};
        if(defined($no_proxy)) {
            $self->_set_no_proxy([split /\s*,\s*/, $no_proxy]);
            return;
        }
    }
}

sub _proxy_uri_for {
    my ($self, $host, $port) = @_;
    foreach my $no_domain (@{$self->{no_proxy}}) {
        if($host =~ /\Q$no_domain\E$/) {
            return undef;
        }
    }
    return $self->{proxy_obj};
}

sub proxy_for {
    my ($self, $host, $port) = @_;
    my $p = $self->_proxy_uri_for($host, $port);
    return defined($p) ? $p->uri_string : undef;
}

sub tcp_connect {
    my ($self, $host, $port, $connect_cb, $prepare_cb) = @_;
    my $proxy = $self->_proxy_uri_for($host, $port);
    if(!defined($proxy)) {
        return AnyEvent::Socket::tcp_connect $host, $port, $connect_cb, $prepare_cb;
    }
    return AnyEvent::Socket::tcp_connect $proxy->host, $proxy->port, sub {
        my ($fh, $conn_host, $conn_port, $retry) = @_;
        if(!defined($fh)) {
            $connect_cb->();
            return;
        }
        $proxy->establish_proxy($fh, $host, $port, sub {
            my ($success) = @_;
            $connect_cb->($success ? ($fh, $conn_host, $conn_port, $retry) : ());
        });
    }, $prepare_cb;
}

1;
__END__