#!/usr/local/bin/perl
#
#
#
#
#
# $Id: wwwlib.pl,v 1.3 1998/09/15 12:53:34 yutaka Exp yutaka $
#

package wwwlib;

sub main::parse_cgi_arguments ( $ ) {
    local $_;
    my ($argument) = @_;
    $argument =~ s/\s//g;
    my @entries = split(/\&/, $argument);
    my @result = ();
    
    foreach $entry (@entries) {
	($key, $_) = split(/=/, $entry);
	next unless (defined $key and defined $_);
	s/\+/ /g;
	s/%(..)/pack('C', hex($1))/eg;
	push(@result, $key, $_);
    }
    return @result;
}

sub main::read_cgi_post_args {
    local (*F) = @_;
    my($arg);
    if (defined $ENV{CONTENT_LENGTH}) {
	read(F, $arg, $ENV{CONTENT_LENGTH});
    } else {
	$arg = scalar <F>;
    }
    return $arg;
}

sub main::read_http_header {
    local ($F) = @_;
    my $ret = "";
    while(<$F>) {
	$ret .= $_;
	last if /^\r?\n?$/;
    }
    return $ret;
}

sub main::parse_header ( $ ) {
    local $_;
    s/\n[ \t]+//g;
    my @lines = split(/\r?\n/, $_[0]);
    my $req = shift @lines;
    my %result = ();

    my ($method, $url, $ver) = $req =~ /^([a-zA-Z0-9]+) +([^ ]+) +(HTTP\/\d+.\d+)/;
    
    while(defined ($_ = shift @lines)) {
	# BUG: multiline header is not parsed.
	/^([a-zA-Z0-9---]+): +(.+)$/ or next;
	$result{lc "$1"} = $2;
    }
    $result{METHOD} = $method;
    $result{URL} = $url;
    $result{VERSION} = $ver;
    return %result;
}
    
sub set_server_name ( $ ) {
    $svr_nam = $_[0];
}

sub main::http_header ( % ) {
    my %entries = @_;
    my ($key, $key2);
    my $header = '';
    my $c = 0;
    my $addheader = '';

    foreach $key (keys %entries) {
	$key2 = lc $key;
	$key2 =~ s/_/-/g;
	if ($key2 eq 'status') {
	    $status = $entries{$key};
	    next;
	}
	if ($key eq 'content-type' || $key eq 'location') {
	    $c = 1;
	}
	next if (!defined $entries{$key});
	$key2 =~ s/([a-z]+)/\u$1/g;
	$header .= "$key2: $entries{$key}\r\n";
    }
    
    my $status = $entries{status} || "200 OK";
    if ($svr_nam ne '') {
	$addheader = "Server: $svr_nam\r\n";
	$addheader .= "Content-Type: text/html\r\n" if (!$c);
	return "HTTP/1.0 $status\r\n$addheader$header\r\n";
    } else {
	$addheader .= "Content-Type: text/html\r\n" if (!$c);
	return "Status: $status\r\n$addheader$header\r\n";
    }
}

$svr_nam = "";
1;

      
