view release on metacpan or  search on metacpan

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

		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 = "$!";
		print STDERR "HTTP Server terminated (errno=$errno_i [$errno_s])\n";
		exit;
	} else {
		use Config;
		my $perl = $Config{'perlpath'};
		open(DAEMON, "'$perl' $0 daemon |") or die "Can't exec daemon: $!";
		my $greeting = <DAEMON>;
		$greeting =~ m!<URL:https?://([^/]+)/>! or die;
		my $base = $1;
		require LWP::UserAgent;
		require HTTP::Request;
		require App::MtAws::GlacierRequest;
		require App::MtAws;
		return $base;
	}
}

1;