Commit e08378ff684543e76fd35f72920a1dc40f401397 - libhttp-async-perl

+26

-1

CHANGES less more

0	0	CHANGES to HTTP::Async
	1
	2	0.16 - 2013/04/04
	3
	4	* Fixed CPAN Testers bug in bad-hosts.t
	5
	6	0.15 - 2013/04/04
	7
	8	* Two bug fixes provided by Josef Toman:
	9	* Fixed header handling to use header_field_names()
	10	* Replaced _make_url_absolute with URI::new_abs()
	11
	12	0.14 - 2013/04/01
	13
	14	* More diagnostics in bad-hosts.t on failure
	15
	16	0.13 - 2013/03/29
	17
	18	* Fixed t/real-servers.t to work whether or not Net::HTTPS::NB is available
	19
	20	0.12 - 2013/03/29
	21
	22	* New logic for making https requests through a proxy
	23	* Made tests run ok in parallel by using different ports per test
	24	* Set explicit SSL_verify_mode in real-servers.t
	25	* Minor update to code comment about is_proxy mode
1	26
2	27	0.11 - 2012/11/13
3	28

72	97
73	98	0.01 - XXXXXXXXXX - svn r24
74	99
75		* Initial release onto CPAN.⏎
	100	* Initial release onto CPAN.

+2

-1

MANIFEST less more

22	22	t/TestServer.pm
23	23	t/timeout.t
24	24	TODO
25		META.yml Module meta-data (added by MakeMaker)
	25	META.yml Module YAML meta-data (added by MakeMaker)
	26	META.json Module JSON meta-data (added by MakeMaker)

+55

-0

META.json less more

	0	{
	1	"abstract" : "unknown",
	2	"author" : [
	3	"unknown"
	4	],
	5	"dynamic_config" : 1,
	6	"generated_by" : "ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120921",
	7	"license" : [
	8	"perl_5"
	9	],
	10	"meta-spec" : {
	11	"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
	12	"version" : "2"
	13	},
	14	"name" : "HTTP-Async",
	15	"no_index" : {
	16	"directory" : [
	17	"t",
	18	"inc"
	19	]
	20	},
	21	"prereqs" : {
	22	"build" : {
	23	"requires" : {
	24	"ExtUtils::MakeMaker" : "0"
	25	}
	26	},
	27	"configure" : {
	28	"requires" : {
	29	"ExtUtils::MakeMaker" : "0"
	30	}
	31	},
	32	"runtime" : {
	33	"requires" : {
	34	"Carp" : "0",
	35	"Data::Dumper" : "0",
	36	"HTTP::Request" : "0",
	37	"HTTP::Response" : "0",
	38	"HTTP::Server::Simple::CGI" : "0",
	39	"HTTP::Status" : "0",
	40	"IO::Select" : "0",
	41	"LWP::UserAgent" : "0",
	42	"Net::HTTP" : "0",
	43	"Net::HTTP::NB" : "0",
	44	"Test::HTTP::Server::Simple" : "0",
	45	"Test::More" : "0",
	46	"Time::HiRes" : "0",
	47	"URI" : "0",
	48	"URI::Escape" : "0"
	49	}
	50	}
	51	},
	52	"release_status" : "stable",
	53	"version" : "0.16"
	54	}

+34

-33

META.yml less more

0		--- #YAML:1.0
1		name: HTTP-Async
2		version: 0.11
3		abstract: ~
4		author: []
5		license: perl
6		distribution_type: module
	0	---
	1	abstract: unknown
	2	author:
	3	- unknown
	4	build_requires:
	5	ExtUtils::MakeMaker: 0
7	6	configure_requires:
8		ExtUtils::MakeMaker: 0
9		build_requires:
10		ExtUtils::MakeMaker: 0
	7	ExtUtils::MakeMaker: 0
	8	dynamic_config: 1
	9	generated_by: 'ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120921'
	10	license: perl
	11	meta-spec:
	12	url: http://module-build.sourceforge.net/META-spec-v1.4.html
	13	version: 1.4
	14	name: HTTP-Async
	15	no_index:
	16	directory:
	17	- t
	18	- inc
11	19	requires:
12		Carp: 0
13		Data::Dumper: 0
14		HTTP::Request: 0
15		HTTP::Response: 0
16		HTTP::Server::Simple::CGI: 0
17		HTTP::Status: 0
18		IO::Select: 0
19		LWP::UserAgent: 0
20		Net::HTTP: 0
21		Net::HTTP::NB: 0
22		Test::HTTP::Server::Simple: 0
23		Test::More: 0
24		Time::HiRes: 0
25		URI: 0
26		URI::Escape: 0
27		no_index:
28		directory:
29		- t
30		- inc
31		generated_by: ExtUtils::MakeMaker version 6.56
32		meta-spec:
33		url: http://module-build.sourceforge.net/META-spec-v1.4.html
34		version: 1.4
	20	Carp: 0
	21	Data::Dumper: 0
	22	HTTP::Request: 0
	23	HTTP::Response: 0
	24	HTTP::Server::Simple::CGI: 0
	25	HTTP::Status: 0
	26	IO::Select: 0
	27	LWP::UserAgent: 0
	28	Net::HTTP: 0
	29	Net::HTTP::NB: 0
	30	Test::HTTP::Server::Simple: 0
	31	Test::More: 0
	32	Time::HiRes: 0
	33	URI: 0
	34	URI::Escape: 0
	35	version: 0.16

+4

-0

TODO less more

29	29	* Add 'info' sub that can be linked to SIGINFO to provide a summary of what is
30	30	going on eg "print $async->info( 'terse' )".
31	31
	32	* Add logic to TestServer::new() to choose a different port when it finds the
	33	one it wants is already in use. Related: make tests which refer to port
	34	numbers outside of their call to TestServer::new() get them from the
	35	TestServer object instead of hard-coding them.

+22

-13

lib/HTTP/Async.pm less more

2	2
3	3	package HTTP::Async;
4	4
5		our $VERSION = '0.11';
	5	our $VERSION = '0.16';
6	6
7	7	use Carp;
8	8	use Data::Dumper;

649	649	$args{PeerPort} \|\|= $uri->port;
650	650
651	651	my $net_http_class = 'Net::HTTP::NB';
652		if ($uri->scheme and $uri->scheme eq 'https') {
	652	if ($uri->scheme and $uri->scheme eq 'https' and not $request_is_to_proxy) {
653	653	$net_http_class = 'Net::HTTPS::NB';
654	654	eval {
655	655	require Net::HTTPS::NB;
656	656	Net::HTTPS::NB->import();
657	657	};
658	658	die "$net_http_class must be installed for https support" if $@;
	659	}
	660	elsif($uri->scheme and $uri->scheme eq 'https' and $request_is_to_proxy) {
	661	# We are making an HTTPS request through an HTTP proxy such as squid.
	662	# The proxy will handle the HTTPS, we need to connect to it via HTTP
	663	# and then make a request where the https is clear from the scheme...
	664	$args{Host} = sprintf(
	665	'%s:%s',
	666	delete @args{'PeerAddr', 'PeerPort'}
	667	);
659	668	}
660	669	my $s = eval { $net_http_class->new(%args) };
661	670

674	683	return 1;
675	684	}
676	685
677		my %headers = %{ $request->{_headers} };
	686	my %headers;
	687	for my $key ($request->{_headers}->header_field_names) {
	688	$headers{$key} = $request->header($key);
	689	}
678	690
679	691	# Decide what to use as the request_uri
680	692	my $request_uri = $request_is_to_proxy # is this a proxy request....

731	743	my $in = $args{url};
732	744	my $ref = $args{ref};
733	745
734		return $in if $in =~ m{ \A http:// }xms;
735
736		my $ret = $ref->scheme . '://' . $ref->authority;
737		return $ret . $in if $in =~ m{ \A / }xms;
738
739		$ret .= $ref->path;
740		return $ret . $in if $in =~ m{ \A [\?\#\;] }xms;
741
742		$ret =~ s{ [^/]+ \z }{}xms;
743		return $ret . $in;
	746	return URI->new_abs($in, $ref)->as_string;
744	747	}
745	748
746	749	sub _add_error_response_to_return {

782	785	handle 304 responses.
783	786
784	787	Naveed Massjouni for adding the https handling code.
	788
	789	Alex Balhatchet for adding the https + proxy handling code, and for making the
	790	tests run ok in parallel.
	791
	792	Josef Toman for fixing two bugs, one related to header handling and another
	793	related to producing an absolute URL correctly.
785	794
786	795	=head1 BUGS AND REPO
787	796

+8

-4

t/TestServer.pm less more

11	11	sub new {
12	12	my ($class, $port) = @_;
13	13
14		$port \|\|= 10_249; # randomish port
	14	# Require a port parameter to be passed in.
	15	# Any default here would mean the tests don't run properly in parallel.
	16	if (!$port) {
	17	die "Missing positional parameter 'port' required";
	18	}
15	19
16	20	return $class->SUPER::new($port);
17	21	}

20	24	my ( $self, $cgi ) = @_;
21	25	my $params = $cgi->Vars;
22	26
23		# If we are on port 8081 then we are a proxy - we should forward the
24		# requests.
	27	# If we should act as a proxy then the handle_request() behaviour is
	28	# handled by act_as_proxy.
25	29	return act_as_proxy(@_) if $self->{is_proxy};
26	30
27	31	# We should act as a final destination server and so expect an absolute URL.

134	138	# that this is the case.
135	139	#
136	140	# http://www.w3.org/Protocols/rfc2616/rfc2616-sec5.html#sec5.1.2
137		if ( $request_uri !~ m!^http://! ) {
	141	if ( $request_uri !~ m!^https?://! ) {
138	142	warn "ERROR - not fully qualified request_uri '$request_uri'";
139	143	return;
140	144	}

+1

-1

t/bad-connections.t less more

5	5	use HTTP::Request;
6	6
7	7	require 't/TestServer.pm';
8		my $s = TestServer->new;
	8	my $s = TestServer->new(80900);
9	9	my $url_root = $s->started_ok("starting a test server");
10	10
11	11	use HTTP::Async;

+1

-1

t/bad-headers.t less more

5	5	use HTTP::Request;
6	6
7	7	require 't/TestServer.pm';
8		my $s = TestServer->new;
	8	my $s = TestServer->new(80300);
9	9	my $url_root = $s->started_ok("starting a test server");
10	10
11	11	use HTTP::Async;

+29

-5

t/bad-hosts.t less more

1	1	use strict;
2	2	use warnings;
3	3
4		use Test::More tests => 9;
	4	use Test::More;
5	5
6	6	use HTTP::Request;
	7	use LWP::UserAgent;
7	8
8	9	use HTTP::Async;
9	10	my $q = HTTP::Async->new;
10	11
	12	# Some weird ISPs or DNS providers take an address like http://i.dont.exist/
	13	# and resolve it to something "useful" such as
	14	# http://navigationshilfe1.t-online.de/dnserror?url=http://i.dont.exist/
	15	#
	16	# If that's happening then let's just give up on this test entirely.
	17	{
	18	my $ua = LWP::UserAgent->new;
	19	if ($ua->get('http://i.dont.exist/foo/bar')->is_success) {
	20	plan skip_all => 'http://i.dont.exist/foo/bar resolved to something!';
	21	exit;
	22	}
	23	}
	24
11	25	# Try to add some requests for bad hosts. HTTP::Async should not fail
12	26	# but should return HTTP::Responses with the correct status code etc.
	27
	28	plan tests => 9;
13	29
14	30	my @bad_requests =
15	31	map { HTTP::Request->new( GET => $_ ) }

20	36	while ( $q->not_empty ) {
21	37	my $res = $q->next_response \|\| next;
22	38
23		isa_ok $res, 'HTTP::Response', "Got a proper response";
24		ok !$res->is_success, "Response was not a success";
25		ok $res->is_error, "Response was an error";
26		ok $res->request, "response has a request attached.";
	39	my $request_uri = $res->request->uri;
	40
	41	isa_ok($res, 'HTTP::Response', "$request_uri - Got a proper response")
	42	\|\| diag sprintf("ref: %s", ref $res);
	43
	44	ok(!$res->is_success, "$request_uri - Response was not a success")
	45	\|\| diag sprintf("%s: %s", $res->code, $res->decoded_content);
	46
	47	ok($res->is_error, "$request_uri - Response was an error")
	48	\|\| diag sprintf("%s: %s", $res->code, $res->decoded_content);
	49
	50	ok $res->request, "$request_uri - Response has a request attached";
27	51	}

+1

-1

t/not_modified.t less more

6	6
7	7	require 't/TestServer.pm';
8	8
9		my $s = TestServer->new;
	9	my $s = TestServer->new(81000);
10	10	my $url_root = $s->started_ok("starting a test server");
11	11
12	12	my $q = HTTP::Async->new;

+1

-1

t/poll-interval.t less more

10	10	}
11	11
12	12	require 't/TestServer.pm';
13		my $s = TestServer->new;
	13	my $s = TestServer->new(80100);
14	14	my $url_root = $s->started_ok("starting a test server");
15	15
16	16	use HTTP::Async;

+3

-3

t/proxy.t less more

6	6	use HTTP::Request;
7	7
8	8	require 't/TestServer.pm';
9		my $s1 = TestServer->new(10249);
	9	my $s1 = TestServer->new(80500);
10	10	my $s1_url_root = $s1->started_ok("starting a test server");
11	11
12		my $s2 = TestServer->new(10250);
	12	my $s2 = TestServer->new(80501);
13	13	$s2->{is_proxy} = 1;
14	14	my $s2_url_root = $s2->started_ok("starting a test server");
15	15

29	29
30	30	my $req = HTTP::Request->new( 'GET', $url );
31	31
32		my %opts = ( proxy_host => '127.0.0.1', proxy_port => 10250, );
	32	my %opts = ( proxy_host => '127.0.0.1', proxy_port => 80501, );
33	33
34	34	my $id =
35	35	$via_proxy

+11

-0

t/real-servers.t less more

8	8	use HTTP::Request;
9	9	use Time::HiRes 'usleep';
10	10
	11	my $https_ok;
	12	eval "use Net::HTTPS::NB";
	13	if ($@) {
	14	note "Install Net::HTTPS::NB to test https";
	15	}
	16	else {
	17	$https_ok = 1;
	18	IO::Socket::SSL::set_defaults(SSL_verify_mode => 0); # SSL_VERIFY_NONE
	19	}
	20
11	21	# Create requests for a few well known sites.
12	22	my @requests =
13	23	map { HTTP::Request->new( GET => $_ ) }
	24	grep { $https_ok \|\| $_ !~ m{^https://} }
14	25	sort qw( http://www.google.com http://www.yahoo.com https://www.gandi.net/ );
15	26
16	27	my $tests_per_request = 4;

+1

-1

t/redirects.t less more

5	5	use HTTP::Request;
6	6
7	7	require 't/TestServer.pm';
8		my $s = TestServer->new;
	8	my $s = TestServer->new(80200);
9	9	my $url_root = $s->started_ok("starting a test server");
10	10
11	11	use HTTP::Async;

+1

-1

t/template.t less more

13	13	# my $s = TestServer->new;
14	14	# my $url_root = $s->started_ok("starting a test server");
15	15
16		my @servers = map { TestServer->new($_) } 80800 .. 80804;
	16	my @servers = map { TestServer->new($_) } 80600 .. 80604;
17	17	foreach my $s (@servers) {
18	18	my $url_root = $s->started_ok("starting a test server");
19	19	}

+1

-1

t/timeout.t less more

5	5	use HTTP::Request;
6	6
7	7	require 't/TestServer.pm';
8		my $s = TestServer->new;
	8	my $s = TestServer->new(80700);
9	9	my $url_root = $s->started_ok("starting a test server");
10	10
11	11	use HTTP::Async;