view release on metacpan or  search on metacpan

t/unit/glacier_request.t  view on Meta::CPAN

		});
		my $resp = $g->perform_lwp();
	};
	describe "throttle" => sub {
		it 'should work' => sub {
			my @sleep_args;
			my $retries = App::MtAws::GlacierRequest::_max_retries();
			is $retries, 100;
			App::MtAws::GlacierRequest->expects('_sleep')->returns(sub { push @sleep_args, shift } )->exactly($retries);
			App::MtAws::GlacierRequest::throttle($_) for (1..App::MtAws::GlacierRequest::_max_retries);
			cmp_deeply [ @sleep_args ],
				[ (1) x 5, (5) x 5, (15) x 10, (60) x 30, (180) x 50 ]
		};
	};
	describe "throttling" => sub {
		my $retries = 3;
		it "should throttle 408/500" => sub {
			for my $code (qw/408 500/) {
				my $g = App::MtAws::GlacierRequest->new({%common_options});
				($g->{method}, $g->{url}) = ('GET', 'test');
				my @throttle_args;
				App::MtAws::GlacierRequest->expects('_max_retries')->any_number->returns($retries);
				App::MtAws::GlacierRequest->expects('throttle')->returns(sub { push @throttle_args, shift } )->exactly($retries);
				LWP::UserAgent->expects('request')->returns(HTTP::Response->new($code))->exactly($retries);
				my $resp = capture_stdout(my $out, sub {
					assert_raises_exception sub {
						$g->perform_lwp();
					}, exception 'too_many_tries' => "Request was not successful after $retries retries";
				});
				ok ! defined $resp;
				is $g->{last_retry_reason}, $code;
				cmp_deeply [@throttle_args], [(1..$retries)];
				my @matches = $out =~ /PID $$ HTTP $code This might be normal. Will retry \(\d+ seconds spent for request\)/g;
				is scalar @matches, $retries;
			}
		};
		it "should throttle Internal Response" => sub {
			my $g = App::MtAws::GlacierRequest->new({%common_options});
			($g->{method}, $g->{url}) = ('GET', 'test');
			my @throttle_args;
			App::MtAws::GlacierRequest->expects('_max_retries')->any_number->returns($retries);
			App::MtAws::GlacierRequest->expects('throttle')->returns(sub { push @throttle_args, shift } )->exactly($retries);
			LWP::UserAgent->expects('request')->returns(HTTP::Response->new(500, "err", ["Client-Warning" => "Internal response"]))->exactly($retries);
			my $resp = capture_stdout(my $out, sub {
				assert_raises_exception sub {
					$g->perform_lwp();
				}, exception 'too_many_tries' => "Request was not successful after $retries retries";
			});
			ok ! defined $resp;
			is $g->{last_retry_reason}, 'Internal response';
			cmp_deeply [@throttle_args], [(1..$retries)];
			my @matches = $out =~ /PID $$ HTTP connection problem \(timeout\?\). Will retry \(\d+ seconds spent for request\)/g;
			is scalar @matches, $retries;
		};
		it "should throttle X-Died and read timeout" => sub {
			my $g = App::MtAws::GlacierRequest->new({%common_options});
			($g->{method}, $g->{url}) = ('GET', 'test');
			my @throttle_args;
			App::MtAws::GlacierRequest->expects('_max_retries')->any_number->returns($retries);
			App::MtAws::GlacierRequest->expects('throttle')->returns(sub { push @throttle_args, shift } )->exactly($retries);
			LWP::UserAgent->expects('request')->returns(HTTP::Response->new(200, 'OK', [ 'X-Died' => 'Read Timeout at']))->exactly($retries);
			my $resp = capture_stdout my $out, sub {
				assert_raises_exception sub {
					$g->perform_lwp();
				}, exception 'too_many_tries' => "Request was not successful after $retries retries";
			};
			ok ! defined $resp;
			cmp_deeply [@throttle_args], [(1..$retries)];
			my @matches = $out =~ /PID $$ HTTP connection problem. Will retry \(\d+ seconds spent for request\)/g;
			is scalar @matches, $retries;
		};
		it "should catch other codes as unknown errors" => sub {
			for my $code (300..309, 400..407, 409) {
				my $g = App::MtAws::GlacierRequest->new({%common_options});
				($g->{method}, $g->{url}) = ('GET', 'test');
				App::MtAws::GlacierRequest->expects('_max_retries')->any_number->returns($retries);
				LWP::UserAgent->expects('request')->returns(HTTP::Response->new($code))->once;
				assert_raises_exception sub {
					capture_stderr my $out, sub {
						$g->perform_lwp();
					}
				}, exception 'http_unexpected_reply' => "Unexpected reply from remote server";
			}
		};
	};
	describe "should detect CA error" => sub {
		it "should raise exception if CA error found" => sub {
			my $g = App::MtAws::GlacierRequest->new({%common_options});
			($g->{method}, $g->{url}) = ('GET', 'test');
## no Test::Tabs
			LWP::UserAgent->expects('request')->returns(HTTP::Response->new(500, "Can't verify SSL peers without knowing which Certificate Authorities to trust", ["Client-Warning" => "Internal response"], <<"END"))->once;
Can't verify SSL peers without knowing which Certificate Authorities to trust

This problem can be fixed by either setting the PERL_LWP_SSL_CA_FILE
envirionment variable or by installing the Mozilla::CA module.

To disable verification of SSL peers set the PERL_LWP_SSL_VERIFY_HOSTNAME
envirionment variable to 0.  If you do this you can't be sure that you
communicate with the expected peer.
END
## use Test::Tabs
			assert_raises_exception sub {
				$g->perform_lwp();
			}, exception 'lwp_ssl_ca_exception' =>
				'Can\'t verify SSL peers without knowing which Certificate Authorities to trust. Probably "Mozilla::CA" module is missing';
		};
	};
};

sub header
{
	{ name => $_[0], value => $_[1] }
}

sub headers {
	my @headers;
	while (@_) {
		push @headers, header(splice(@_, 0, 2))
	}
	\@headers;
}