view release on metacpan or  search on metacpan

HTTP/Any/Curl.pm  view on Meta::CPAN

BEGIN {
	Net::Curl::Easy->can('CURLOPT_ACCEPT_ENCODING') or die "Rebuild Net::Curl with libcurl 7.21.6 or newer\n";
	Net::Curl::Easy->can('CURLOPT_COOKIEFILE')      or die "Rebuild curl with Cookies support\n";
}

sub _prepare {
	my ($easy, $url, $opt) = @_;

	$easy->setopt(CURLOPT_URL, $url);

	my @headers = ();
	@headers = map { $_ . ": " . $$opt{headers}{$_} } keys %{$$opt{headers}} if $$opt{headers};

	if ($$opt{method} and $$opt{method} eq "POST" ) {
		$easy->setopt(CURLOPT_POST, 1);
		unless ($$opt{headers}{"Content-Type"}) {
			push @headers, "Content-Type: application/x-www-form-urlencoded";
		}
		if (ref $$opt{body} eq "CODE") {
			$easy->setopt(CURLOPT_POST, 1);
			$easy->setopt(CURLOPT_UPLOAD, 1);
			$easy->setopt(CURLOPT_CUSTOMREQUEST, "POST");

			my $buf = "";
			my $body_sub = $$opt{body};
			$easy->setopt(CURLOPT_READFUNCTION, sub {
				my ( $easy, $maxlen, $uservar ) = @_;
				$buf ||= $body_sub->();
				if ($buf) {
					return \ substr $buf, 0, $maxlen, "";
				} else {
					return CURLE_OK;
				}
			} );
		} else {
			$easy->setopt(CURLOPT_POSTFIELDS, $$opt{body});
		}
	}

	$easy->setopt(CURLOPT_HTTPHEADER, \@headers) if @headers;

	my $max_redirect = defined $$opt{max_redirect} ? $$opt{max_redirect} : 7;
	if ($max_redirect) {
		$easy->setopt(CURLOPT_FOLLOWLOCATION, 1);
		$easy->setopt(CURLOPT_MAXREDIRS, $max_redirect);
	}


	if ($$opt{cookie}) {
		$easy->setopt(CURLOPT_COOKIEFILE, $$opt{cookie});
		$easy->setopt(CURLOPT_COOKIEJAR,  $$opt{cookie});
	} elsif (defined $$opt{cookie}) {
		$easy->setopt(CURLOPT_COOKIEFILE, "");
	}

	my $on_header = $$opt{on_header};
	my $on_body   = $$opt{on_body};

	$easy->setopt(CURLOPT_WRITEHEADER, \ my $_headers);

	my $body = "";
	$easy->setopt(CURLOPT_FILE, \$body) unless $on_body;

	$easy->setopt(CURLOPT_USERAGENT, $$opt{agent}) if $$opt{agent};
	$easy->setopt(CURLOPT_REFERER, $$opt{referer}) if $$opt{referer};
	$easy->setopt(CURLOPT_TIMEOUT, $$opt{timeout}) if $$opt{timeout};

	if (my $proxy = $$opt{proxy}) {
		$proxy =~ s!^socks://!socks5://!;
		$easy->setopt(CURLOPT_PROXY, $proxy);
	}

	$easy->setopt(CURLOPT_ACCEPT_ENCODING, "") if $$opt{compressed} or $$opt{gzip};

	$easy->setopt(CURLOPT_FORBID_REUSE, $$opt{persistent} ? 0 : 1) if exists $$opt{persistent};

	my ($is_success, $headers, $redirects);

	my $max_size = $$opt{max_size};
	my $aborted_by_max_size = 0;

	my $body_size = 0;

	if ($max_size or $on_header or $on_body) {
		my $cb_write = sub {
			my ($easy, $data, $uservar) = @_;
			my $size = length $data;
			$body_size += $size;
			if ($on_header) {
				($is_success, $headers, $redirects) = _headers($easy, $url, $_headers);
				my $r = $on_header->($is_success, $headers, $redirects);
				$on_header = undef;
				$r or return 0;
			}
			if ($on_body) {
				$on_body->($data) or return 0;
			} else {
				$body .= $data;
			}
			if ($max_size and $body_size > $max_size) {
				$aborted_by_max_size = 1;
				return 0;
			}
			return $size;
		};
		$easy->setopt(CURLOPT_WRITEFUNCTION, $cb_write);
	} else {
		$easy->setopt(CURLOPT_WRITEFUNCTION, undef);
	}

	my $finish = sub {
		my ($easy, $result) = @_;

		if ($_headers) {
			($is_success, $headers, $redirects) = _headers($easy, $url, $_headers) unless $headers;
			if ($result == CURLE_WRITE_ERROR and $aborted_by_max_size) {
				$is_success = 0;
				$$headers{"Status"} = 599;
				$$headers{"Reason"} = "MaxSize";