view release on metacpan or  search on metacpan

lib/File/HTTP.pm  view on Meta::CPAN

	return 1;
}

# read() reimplementation to overcome IO::Socket::SSL behavior of read() acting as sysread()
# <> is ok though
sub _read {
	my ($self, undef, $len, $off) = @_;
	
	if (not defined $off)  {
		$off = 0;
	}
	elsif ($off < 0) {
		$off += bytes::length($_[1])
	}
	
	my $n = read($self->[FH], $_[1], $len, $off);
	return $n unless $n;
	
	if ($self->[SSL] && $len && $n < $len) {
		# strange IO::Socket::SSL behavior: read() acts as sysread()
		while ($n < $len) {
			my $n_part = read($self->[FH], $_[1], $len-$n, $off+$n);
			return $n unless $n_part;
			$n += $n_part;
		}
	}
	
	return $n;
}

sub TIEHANDLE {
	my ($class, $url, $offset, $err_ref, $no_close_on_destroy) = @_;
	my $self = bless [], $class;
	my $redirections = 0;

	$self->[NO_CLOSE_ON_DESTROY] = $no_close_on_destroy;

	SET_URL: {
		$self->[URL] = $url;
		$self->[OFFSET] = $offset;
		$self->[CURRENT_OFFSET] = $offset;
		($self->[PROTO], $self->[AUTH], $self->[HOST], $self->[PORT], $self->[PATH]) = $url =~ m!^(https?)://(?:([^/:]+:[^/@]+)@)?([^/:]+)(?:\:(\d+))?(/[^#]+)?!i;
		$self->[REMOTE_HOST] = $self->[HOST];

		if ($self->[AUTH]) {
			require MIME::Base64;
			#$VERBOSE && carp "authentication in URI is not supported";
			#$$err_ref = &Errno::EFAULT; # Bad address
			#return undef;
		}
		$self->[PROTO] = uc($self->[PROTO]);
		$self->[PORT] ||= $Proto2Port{$self->[PROTO]};
		$self->[PATH] ||= '/';
		$self->[NETLOC] = ($self->[PORT]==$Proto2Port{$self->[PROTO]}) ? $self->[HOST] : "$self->[HOST]:$self->[PORT]";
		$self->[CONNECT_NETLOC] = '';
		
		# PATH will change in case of proxy
		$self->[REAL_PATH] = $self->[PATH]; 
		
		# handle proxy
		my $proxy = $self->[PROTO] eq 'HTTPS' ? $ENV{HTTPS_PROXY}||$ENV{HTTP_PROXY} : $ENV{HTTP_PROXY};
		if ($proxy) {
			my $no_proxy = join('|', map {s/^\*?\.//;$_} split(/[, ]+/, $ENV{NO_PROXY}||''));
			
			unless (
				($self->[HOST] eq '127.0.0.1')
				||
				($self->[HOST] eq 'localhost')
				||
				($no_proxy && $self->[HOST] =~ /$no_proxy$/i)
			) {
				# apply proxy
				if ($proxy =~ m!^https://!) {
					$VERBOSE && carp "proxies with HTTPS address are not supported";
					$$err_ref = &Errno::EFAULT; # Bad address
					return undef;
				}
				$self->[CONNECT_NETLOC] = "$self->[HOST]:$self->[PORT]";
				($self->[HOST], $self->[PORT]) = $proxy =~ m!^(?:http://)?([^/:]+)(?:\:(\d+))?!i;
				$self->[PORT] ||= $Proto2Port{$self->[PROTO]};
				$self->[PATH] = $self->[URL];
				DEBUG && warn "Proxy: $self->[HOST]:$self->[PORT]\n";
			}
		}

		$self->[IP] = Socket::inet_aton($self->[HOST]);
		eval { $self->_initiate };

		if ($@) {
			if ($@ =~ /^redirection: ([^\n]+)/) {
				my $location = $1;
				if (++$redirections > $MAX_REDIRECTIONS) {
					$VERBOSE && carp "too many redirections";
					$$err_ref = &Errno::EFAULT; # Bad address
					return undef;
				}
				if ($location =~ m!^https?://!i) {
					$url = $location;
				}
				elsif ($location =~ m!^//!) {
					$url =~ m!^(https?:)//!;
					$url = $1.$location;
				}
				elsif ($location =~ m!^/!) {
					$url =~ m!^(https?://[^/]+)!;
					$url = $1.$location;
				}
				else {
					$url =~ s!#.*!!;
					$url =~ s![^/]+$!!;
					$url .= $location;
				}
				redo SET_URL;
			}
			elsif ($@ =~ /^error: (\d+)/) {
				$VERBOSE && carp $@;
				$$err_ref = $1;
				return undef;
			}
			elsif ($@ =~ /^HTTPS support/) {
				die $@;