;#
;# Copyright (c) 1995-1997
;#	Ikuo Nakagawa. All rights reserved.
;#
;# Redistribution and use in source and binary forms, with or without
;# modification, are permitted provided that the following conditions
;# are met:
;#
;# 1. Redistributions of source code must retain the above copyright
;#    notice unmodified, this list of conditions, and the following
;#    disclaimer.
;# 2. Redistributions in binary form must reproduce the above copyright
;#    notice, this list of conditions and the following disclaimer in the
;#    documentation and/or other materials provided with the distribution.
;#
;# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
;# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
;# PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS
;# BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
;# OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
;# OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
;# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
;# OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
;# EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;#
;# $Id: HTTP.pm,v 1.16 1997/11/06 12:15:16 ikuo Exp $
;#
;# Description:
;#	HTTP.pm - HTTP Class definitions
;#	 - Socket based operations.
;#	 - Multiple addresses for a single server are supported.
;#	 - Multiple sessions are supported.
;#
;# Usage:
;#
package Fan::HTTP;

use strict;
use vars qw($VERSION @ISA $LOG $http_port);

use Carp;
use Fan::Cool;
use Fan::TCP;
use AutoLoader 'AUTOLOAD';

@ISA = qw(Fan::TCP);
$VERSION = '0.02';
$LOG = 5 unless defined($LOG);

;# A special marker for AutoSplit.
1;
__END__

;# destroy an object.
sub DESTROY ($) {
	my $self = shift;

	# log...
	carp("HTTP DESTROYING $self") if $LOG >= 6;

	# destroy this object in SUPER class.
	Fan::TCP::DESTROY($self);
}

;# creat a new object.
sub new ($%) {
	my $this = shift;
	my $class = ref($this) || $this;
	my %param = @_;

	# if we required verbose log, set tcp_debug
	$param{tcp_debug} = 1 if $LOG > 5;

	# bless myself.
	my $self = bless Fan::TCP->new(%param), $class;
	ref($self) or return undef;

	# log...
	carp("HTTP CREATING $self") if $LOG >= 6;

	# result is myself.
	$self;
}

;# connecting the server, and get contents.
sub get ($$;$) {
	my $self = shift;
	my ($proto, $server, $port, $document) = &parse_url(shift);
	my $out = shift;
	my $tmp;
	my $need_rename = 0;
	my $fh;
	local *OUTPUT;

	if ($document !~ /^\//) {
		carp("$self: document must begin with a slash"),
		return undef;
	}

	if ($out eq '') {
		$fh = \*STDOUT;
	} elsif (ref($out) eq 'GLOB') {
		$fh = $out;
	} else {
		($tmp = $out) =~ s%[^/]+$%.in.$&%;
		$need_rename++;

		CORE::open(OUTPUT, ">$tmp") or
			carp("$self: open($tmp) - $!"), return undef;
		$fh = \*OUTPUT;
	}

	$proto = $self->{http_proto} if $proto eq '';
	$proto = 'http' if $proto eq '';

	$server = $self->{http_server} if $server eq '';
	if ($server eq '') {
		carp("$self: host not specified"), return undef;
	}

	if ($self->{http_proxy} eq '') {
		if ($proto ne 'http') {
			carp("$self: protocol $proto is not supported");
			return undef;
		}
		$port = 80 if $port eq '';
	} else {
		if (defined($port)) { # normal port
			$document = sprintf("%s://%s:%d%s",
				$proto, $server, $port, $document);
		} else {
			$document = sprintf("%s://%s%s",
				$proto, $server, $document);
		}
		$server = $self->{http_proxy};
		$port = $server =~ s/:(\d+)$// ? $1 : 80;
	}

# carp("$self: ($proto, $server, $port, $document)") if $LOG > 6;

warn("HTTP: try to connect $server:$port\n") if $LOG > 6;
warn("HTTP: try to get $document\n") if $LOG > 6;

	unless ($self->do_client(tcp_host => $server, tcp_port => $port)) {
		# error string was stored by do_client.
		$self->close;
		return undef;
	}

	$self->putln("GET $document HTTP/1.0")		&&
	$self->putln("Accept: */*")			&&
	$self->putln("User-Agent: HTTP.pm/$VERSION")	&&
	$self->putln("")				or
	$self->close, return undef;

	defined($_ = $self->getln)			&&
	/^HTTP\/\d+\.\d+ (\d\d\d) (.+)$/		or
	$self->error("wrong response"), $self->close, return undef;

	my $result = $1;
	my $reason = $2;
	my @headers = ();

warn("HTTP: result=$result reason=$2\n") if $LOG > 6;

	my $null = 0;
	while (defined($_ = $self->getln)) {
		$null++, last if /^$/;
		$_ = pop(@headers).$_ if /^\s/;
		push(@headers, $_);
	}

	unless ($null) {
		$self->error("unexpected end of file");
		$self->close;
		return undef;
	}

	# parsing headers
	while (@headers) {
		$_ = shift(@headers);

		unless (s/^([a-zA-Z\-]+):\s+//) {
			$self->error("wrong header");
			$self->clsoe;
			return undef;
		}
		my $tag = "\L$1";
                if ($tag eq 'content-type') {
			if (/\s*([-\w]+)\/([-\w]+)\s*(;\s*([^\s;]+)\s*)*$/) {
				$self->{content_type} = $1;
				$self->{content_subtype} = $2;
			}
                } elsif ($tag eq 'content-length') {
			$self->{content_length} = $_;
                } elsif ($tag eq 'content-encoding') {
			$self->{content_encoding} = $_;
		} elsif ($tag eq 'content-transfer-encoding') {
			$self->{content_transfer_encoding} = $_;
		} elsif ($tag eq 'last-modified') {
			$self->{last_modified} = $_;
                } else {
			# simply ignored
		}
	}

	# get total length of this contents
	my $length = defined($self->{content_length}) ?
		$self->{content_length} + 0 : undef;

	# try to read real data.
	my $len = 0;
	my $ll = defined($length) && $length < 10240 ? $length : 10240;
	while ($ll > 0 && defined(my $data = $self->getdata($ll))) {
		unless (print $fh $data) {
			$self->error($!.'');
			$self->close;
			return undef;
		}
		$len += length($data);
		$ll = defined($length) && $length - $len < 10240
			? $length - $len : 10240;
	}

	# o.k., now close this session.
	$self->close;
	if ($self->error) {
		return undef;
	}

	# checking result...
	unless ($result == 200) {
		$self->error("\"$reason\"");
		return undef;
	}

	# check length...
	if (defined($length) && $length != $len) {
		$self->error('length mismatch');
		return undef;
	}

	# rename if we wrote to a plain file
	if ($need_rename) {
		unless (rename($tmp, $out)) {
			my $e = $!."";
			$self->error("rename($out): $e");
			return undef;
		}
	}

	# success
	1;
}

;#
sub parse_url ($) {
	local $_ = shift;
        my $proto = s|^(\w+)://|| ? $1 : undef;
        my $server = s|^([^/]+)|| ? $1 : undef;
	my $port = $server =~ s|:(\d+)$|| ? $1 : undef;
	my $document = m|^/| ? $_ : '/';
carp("HTTP parse_url: ($proto, $server, $port, $document)") if $LOG > 6;
	($proto, $server, $port, $document);
}

;# end of Fan::HTTP module