view release on metacpan or  search on metacpan

t/integration/lwp.t  view on Meta::CPAN

		# force chunked-response
		$resp->content(sub {
			if (!$sent) {
				$sent = 1;
				return 'x' x $size;
			} else {
				return '';
			}
		});
		$c->send_response($resp);
	}

	# success with size defined
	{
		open F, ">$tmpfile";
		close F;
		my $writer = App::MtAws::HttpFileWriter->new(tempfile => $tmpfile);
		my (undef, $resp, undef) = make_glacier_request('GET', "content_length/$test_size/$test_size", {%common_options},
			{writer => $writer, expected_size => $test_size});
		is -s $tmpfile, $test_size;
		ok($resp->is_success);
	}

	sub httpd_chunked_throttling_exception
	{
		my($c, $req) = @_;
		my $resp = HTTP::Response->new(400);
		$resp->content_type('application/json');
		my $s = $throttling_exception;
		my $sent = 0;
		# force chunked-response
		$resp->content(sub {
			if (!$sent) {
				$sent = 1;
				return $s;
			} else {
				return '';
			}
		});
		$c->send_response($resp);
	}

	sub httpd_throttling_exception
	{
		my($c, $req, $size, $header_size) = @_;
		$c->send_basic_header(400);
		my $s = $throttling_exception;
		print $c "Content-Length: ".length($s)."\015\012";
		print $c "Content-Type: application/json\015\012";
		$c->send_crlf;
		print $c $s;
	}
	# correct request, but HTTP 400 with exception in JSON
	{
		# TODO: seems some versions of LWP raise this warnign, actually move to GlacierRequest
		open F, ">$tmpfile";
		close F;
		no warnings 'redefine';
		local *App::MtAws::GlacierRequest::_max_retries = sub { 1 };
		local *App::MtAws::GlacierRequest::_sleep = sub { };
		for my $method (qw/GET PUT POST DELETE/) {
			for my $action (qw/chunked_throttling_exception/) {
				my $writer = App::MtAws::HttpFileWriter->new(tempfile => $tmpfile);
				my ($g, $resp, $err) = make_glacier_request($method, $action, {%common_options},
					{writer => $writer, expected_size => $test_size, dataref => \''});
				is -s $tmpfile, 0;
				is $err->{code}, 'too_many_tries'; # TODO: test with cmp_deep and exception()
				is $g->{last_retry_reason}, 'ThrottlingException', "ThrottlingException for $method,$action";
			}
		}
	}

	# success with no size defined
	{
		open F, ">$tmpfile";
		close F;
		my $writer = App::MtAws::HttpFileWriter->new(tempfile => $tmpfile);
		my (undef, $resp, undef) = make_glacier_request('GET', "content_length/$test_size/$test_size", {%common_options},
			{writer => $writer});
		is -s $tmpfile, $test_size;
		ok($resp->is_success);
	}

	# truncated response, no size is defined
	{
		no warnings 'redefine';
		local *App::MtAws::GlacierRequest::_max_retries = sub { 1 };
		local *App::MtAws::GlacierRequest::_sleep = sub { };
		my $writer = App::MtAws::HttpFileWriter->new(tempfile => $tmpfile);
		my ($g, $resp, $err) = make_glacier_request('GET', "content_length/".($test_size-1)."/$test_size", {%common_options},
			{writer => $writer});
		is $err->{code}, 'too_many_tries'; # TODO: test with cmp_deep and exception()
		is $g->{last_retry_reason}, 'Unexpected end of data';
		is -s $tmpfile, $test_size;
	}

	# user_agent
	{
		no warnings 'redefine';
		my ($g, $resp, $err) = make_glacier_request('GET', "check_user_agent", {%common_options});
		is  $resp->content, "mt-aws-glacier/$App::MtAws::VERSION$App::MtAws::VERSION_MATURITY (http://mt-aws.com/) libwww-perl/".LWP->VERSION();
	}

	# truncated response for HTTP 400
	{
		no warnings 'redefine';
		local *App::MtAws::GlacierRequest::_max_retries = sub { 1 };
		local *App::MtAws::GlacierRequest::_sleep = sub { };
		my $writer = App::MtAws::HttpFileWriter->new(tempfile => $tmpfile);
		my ($g, $resp, $err) = make_glacier_request('GET', "content_length_400", {%common_options},
			{writer => $writer});
		is $err->{code}, 'too_many_tries'; # TODO: test with cmp_deep and exception()
		is $g->{last_retry_reason}, 'ThrottlingException'; # TODO: BUG actually need to detect truncated response as well, and this is actually bug
		is -s $tmpfile, $test_size;
	}

	# truncated response, size is defined
	{
		no warnings 'redefine';
		local *App::MtAws::GlacierRequest::_max_retries = sub { 1 };
		local *App::MtAws::GlacierRequest::_sleep = sub { };
		my $writer = App::MtAws::HttpFileWriter->new(tempfile => $tmpfile);
		my ($g, $resp, $err) = make_glacier_request('GET', "content_length/".($test_size-1)."/$test_size", {%common_options},
			{writer => $writer, expected_size => $test_size});
		is $err->{code}, 'too_many_tries'; # TODO: test with cmp_deep and exception()
		is $g->{last_retry_reason}, 'Unexpected end of data';
		is -s $tmpfile, $test_size;
	}

	# correct response, expected size is wrong
	{
		open F, ">$tmpfile";
		close F;
		no warnings 'redefine';
		local *App::MtAws::GlacierRequest::_max_retries = sub { 1 };
		local *App::MtAws::GlacierRequest::_sleep = sub { };
		my $writer = App::MtAws::HttpFileWriter->new(tempfile => $tmpfile);
		my ($g, $resp, $err) = make_glacier_request('GET', "content_length/$test_size/$test_size", {%common_options},
			{writer => $writer, expected_size => $test_size+1});
		is $err->{code}, 'wrong_file_size_in_journal'; # TODO: test with cmp_deep and exception()
		is -s $tmpfile, 0;
	}

	# correct response, size is zero
	{
		no warnings 'redefine';
		local *App::MtAws::GlacierRequest::_sleep = sub { die };
		for (qw/GET PUT POST DELETE/) {
			my ($g, $resp, $err) = make_glacier_request($_, "empty_response", {%common_options}, {dataref=>\''});
			ok $resp && !$err, "empty response should work for $_ method";
		}
	}

	# data truncated, writer not used
	{
		no warnings 'redefine';
		local *App::MtAws::GlacierRequest::_max_retries = sub { 1 };
		local *App::MtAws::GlacierRequest::_sleep = sub { };
		for (qw/GET PUT POST DELETE/) {
			my ($g, $resp, $err) = make_glacier_request($_, "content_length/499/501", {%common_options}, {dataref=>\''});
			is $err->{code}, 'too_many_tries', "Code for $_";
			is $g->{last_retry_reason}, 'Unexpected end of data', "Reason for $_";
		}
	}

	# correct response, no size header sent (chunked response? or maybe http/1.0)
	{
		open F, ">$tmpfile";
		close F;
		no warnings 'redefine';
		local *App::MtAws::GlacierRequest::_max_retries = sub { 1 };
		local *App::MtAws::GlacierRequest::_sleep = sub { };
		my $writer = App::MtAws::HttpFileWriter->new(tempfile => $tmpfile);
		my ($g, $resp, $err) = make_glacier_request('GET', "without_content_length/$test_size", {%common_options},
			{writer => $writer, expected_size => $test_size});
		is $err->{code}, 'wrong_file_size_in_journal';
		is -s $tmpfile, 0;
	}

	sub httpd_quit
	{
		my($c) = @_;
		$c->send_error(503, "Bye, bye");
		exit;  # terminate HTTP server
	}

	my $ua = new LWP::UserAgent;
	my $req = new HTTP::Request GET => "$proto://$base/quit";
	my $resp = $ua->request($req);

sub initialize_processes
{
	if (@ARGV && $ARGV[0] eq 'daemon') {
		my $d = $proto eq 'http' ?
			HTTP::Daemon->new(Timeout => 20, LocalAddr => '127.0.0.1') :
			HTTP::Daemon::SSL->new(Timeout => 20, LocalAddr => '127.0.0.1'); # need certs/ dir
		$SIG{PIPE}='IGNORE';
		$| = 1;
		print "Please to meet you at: <URL:", $d->url, ">\n";

		$!=0;
		while (my $c = $d->accept) {
			my $r = $c->get_request;
			if ($r) {
				my @p = $r->uri->path_segments;
				shift @p;
				my $p = shift @p;
				my $func = lc("httpd_$p");
				if (defined &$func) {
					no strict 'refs';
					&$func($c, $r, @p);
				} else {
					$c->send_error(404);
				}
			}
			$c = undef;  # close connection
		}
		my $errno_i = $!+0;
		my $errno_s = "$!";