package CGI;
require 5.001;
$AUTOLOAD_DEBUG=0;
$NPH=0;
$CGI::revision = '$Id: CGI.pm,v 2.30 1997/1/01 12:12 lstein Exp $';
$CGI::VERSION='2.30';
unless ($OS) {
    unless ($OS = $^O) {
	require Config;
	$OS = $Config::Config{'osname'};
    }
}
if ($OS=~/Win/i) {
    $OS = 'WINDOWS';
} elsif ($OS=~/vms/i) {
    $OS = 'VMS';
} elsif ($OS=~/Mac/i) {
    $OS = 'MACINTOSH';
} else {
    $OS = 'UNIX';
}
$needs_binmode = $OS=~/^(WINDOWS|VMS)/;
$DefaultClass = 'CGI' unless defined $CGI::DefaultClass;
$SL = {
    UNIX=>'/',
    WINDOWS=>'\\',
    MACINTOSH=>':',
    VMS=>'\\'
    }->{$OS};
$NPH++ if $ENV{'SERVER_SOFTWARE'}=~/IIS/;
$CRLF = "\015\012";
if ($needs_binmode) {
    $CGI::DefaultClass->binmode(main::STDOUT);
    $CGI::DefaultClass->binmode(main::STDIN);
    $CGI::DefaultClass->binmode(main::STDERR);
}
%OVERLOAD = ('""'=>'as_string');
%EXPORT_TAGS = (
	      ':html2'=>[h1..h6,qw/p br hr ol ul li dl dt dd menu code var strong em
			 tt i b blockquote pre img a address cite samp dfn html head
			 base body link nextid title meta kbd start_html end_html
			 input Select option/],
	      ':html3'=>[qw/div table caption th td TR Tr super sub strike applet PARAM embed basefont/],
	      ':netscape'=>[qw/blink frameset frame script font fontsize center/],
	      ':form'=>[qw/textfield textarea filefield password_field hidden checkbox checkbox_group 
		       submit reset defaults radio_group popup_menu button autoEscape
		       scrolling_list image_button start_form end_form startform endform
		       start_multipart_form isindex tmpFileName URL_ENCODED MULTIPART/],
	      ':cgi'=>[qw/param path_info path_translated url self_url script_name cookie 
		       raw_cookie request_method query_string accept user_agent remote_host 
		       remote_addr referer server_name server_software server_port server_protocol
		       virtual_host remote_ident auth_type http
		       remote_user user_name header redirect import_names put/],
	      ':ssl' => [qw/https/],
	      ':cgi-lib' => [qw/ReadParse PrintHeader HtmlTop HtmlBot SplitParam/],
	      ':html' => [qw/:html2 :html3 :netscape/],
	      ':standard' => [qw/:html2 :form :cgi/],
	      ':all' => [qw/:html2 :html3 :netscape :form :cgi/]
	 );
sub import {
    my $self = shift;
    my ($callpack, $callfile, $callline) = caller;
    foreach (@_) {
	$NPH++, next if $_ eq ':nph';
	foreach (&expand_tags($_)) {
	    tr/a-zA-Z0-9_//cd;  
	    $EXPORT{$_}++;
	}
    }
    my @packages = ($self,@{"$self\:\:ISA"});
    foreach $sym (keys %EXPORT) {
	my $pck;
	my $def = $DefaultClass;
	foreach $pck (@packages) {
	    if (defined(&{"$pck\:\:$sym"})) {
		$def = $pck;
		last;
	    }
	}
	*{"${callpack}::$sym"} = \&{"$def\:\:$sym"};
    }
}
sub expand_tags {
    my($tag) = @_;
    my(@r);
    return ($tag) unless $EXPORT_TAGS{$tag};
    foreach (@{$EXPORT_TAGS{$tag}}) {
	push(@r,&expand_tags($_));
    }
    return @r;
}
sub new {
    my($class,$initializer) = @_;
    my $self = {};
    bless $self,ref $class || $class || $DefaultClass;
    $initializer = to_filehandle($initializer) if $initializer;
    $self->init($initializer);
    return $self;
}
sub DESTROY { }
sub param {
    my($self,@p) = self_or_default(@_);
    return $self->all_parameters unless @p;
    my($name,$value,@other);
    if (@p > 1) {
	($name,$value,@other) = $self->rearrange([NAME,[DEFAULT,VALUE,VALUES]],@p);
	my(@values);
	if (substr($p[0],0,1) eq '-' || $self->use_named_parameters) {
	    @values = defined($value) ? (ref($value) && ref($value) eq 'ARRAY' ? @{$value} : $value) : ();
	} else {
	    foreach ($value,@other) {
		push(@values,$_) if defined($_);
	    }
	}
	if (@values) {
	    $self->add_parameter($name);
	    $self->{$name}=[@values];
	}
    } else {
	$name = $p[0];
    }
    return () unless defined($name) && $self->{$name};
    return wantarray ? @{$self->{$name}} : $self->{$name}->[0];
}
sub delete {
    my($self,$name) = self_or_default(@_);
    delete $self->{$name};
    delete $self->{'.fieldnames'}->{$name};
    @{$self->{'.parameters'}}=grep($_ ne $name,$self->param());
    return wantarray ? () : undef;
}
sub self_or_default {
    return @_ if defined($_[0]) && !ref($_[0]) && ($_[0] eq 'CGI');
    unless (defined($_[0]) && 
	    ref($_[0]) &&
	    (ref($_[0]) eq 'CGI' ||
	     eval "\$_[0]->isaCGI()")) { 
	$Q = $CGI::DefaultClass->new unless defined($Q);
	unshift(@_,$Q);
    }
    return @_;
}
sub self_or_CGI {
    local $^W=0;                
    if (defined($_[0]) &&
	(substr(ref($_[0]),0,3) eq 'CGI' 
	 || eval "\$_[0]->isaCGI()")) {
	return @_;
    } else {
	return ($DefaultClass,@_);
    }
}
sub isaCGI {
    return 1;
}
sub import_names {
    my($self,$namespace) = self_or_default(@_);
    $namespace = 'Q' unless defined($namespace);
    die "Can't import names into 'main'\n"
	if $namespace eq 'main';
    my($param,@value,$var);
    foreach $param ($self->param) {
	($var = $param)=~tr/a-zA-Z0-9_/_/c;
	$var = "${namespace}::$var";
	@value = $self->param($param);
	@{$var} = @value;
	${$var} = $value[0];
    }
}
sub use_named_parameters {
    my($self,$use_named) = self_or_default(@_);
    return $self->{'.named'} unless defined ($use_named);
    return $self->{'.named'}=$use_named;
}
sub init {
    my($self,$initializer) = @_;
    my($query_string,@lines);
    my($meth) = '';
    if (defined(@QUERY_PARAM) && !defined($initializer)) {
	foreach (@QUERY_PARAM) {
	    $self->param('-name'=>$_,'-value'=>$QUERY_PARAM{$_});
	}
	return;
    }
    $meth=$ENV{'REQUEST_METHOD'} if defined($ENV{'REQUEST_METHOD'});
  METHOD: {
      if (defined($initializer)) {
	  if (ref($initializer) && ref($initializer) eq 'HASH') {
	      foreach (keys %$initializer) {
		  $self->param('-name'=>$_,'-value'=>$initializer->{$_});
	      }
	      last METHOD;
	  }
	  $initializer = $$initializer if ref($initializer);
	  if (defined(fileno($initializer))) {
	      while (<$initializer>) {
		  chomp;
		  last if /^=/;
		  push(@lines,$_);
	      }
	      if ("@lines" =~ /=/) {
		  $query_string=join("&",@lines);
	      } else {
		  $query_string=join("+",@lines);
	      }
	      last METHOD;
	  }
	  $query_string = $initializer;
	  last METHOD;
      }
      if ($meth=~/^(GET|HEAD)$/) {
	$query_string = $ENV{'QUERY_STRING'};
	last METHOD;
    }
      if ($meth eq 'POST') {
	  if ($ENV{'CONTENT_TYPE'}=~m|^multipart/form-data|) {
	      my($boundary) = $ENV{'CONTENT_TYPE'}=~/boundary=(\S+)/;
	      $self->read_multipart($boundary,$ENV{'CONTENT_LENGTH'});
	  } else {
	      $self->read_from_client(\*STDIN,\$query_string,$ENV{'CONTENT_LENGTH'},0)
		  if $ENV{'CONTENT_LENGTH'} > 0;
	  }
	  last METHOD;
      }
      $query_string = &read_from_cmdline;
  }
    if ($query_string) {
	if ($query_string =~ /=/) {
	    $self->parse_params($query_string);
	} else {
	    $self->add_parameter('keywords');
	    $self->{'keywords'} = [$self->parse_keywordlist($query_string)];
	}
    }
    if ($self->param('.defaults')) {
	undef %{$self};
    }
    $self->{'.fieldnames'} = {};
    foreach ($self->param('.cgifields')) {
	$self->{'.fieldnames'}->{$_}++;
    }
    $self->delete('.submit');
    $self->delete('.cgifields');
    $self->save_request unless $initializer;
}
sub to_filehandle {
    my $string = shift;
    if ($string && !ref($string)) {
	my($package) = caller(1);
	my($tmp) = $string=~/[':]/ ? $string : "$package\:\:$string"; 
	return $tmp if defined(fileno($tmp));
    }
    return $string;
}
sub new_MultipartBuffer {
    my($self,$boundary,$length,$filehandle) = @_;
    return MultipartBuffer->new($self,$boundary,$length,$filehandle);
}
sub read_from_client {
    my($self, $fh, $buff, $len, $offset) = @_;
    local $^W=0;                
    return read($fh, $$buff, $len, $offset);
}
sub binmode {
    binmode($_[1]);
}
sub put {
    my($self,@p) = self_or_default(@_);
    $self->print(@p);
}
sub print {
    shift;
    CORE::print(@_);
}
sub unescape {
    my($todecode) = @_;
    $todecode =~ tr/+/ /;       
    $todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
    return $todecode;
}
sub escape {
    my($toencode) = @_;
    $toencode=~s/([^a-zA-Z0-9_\-.])/uc sprintf("%%%02x",ord($1))/eg;
    return $toencode;
}
sub save_request {
    my($self) = @_;
    @QUERY_PARAM = $self->param; 
    foreach (@QUERY_PARAM) {
	$QUERY_PARAM{$_}=$self->{$_};
    }
}
sub parse_keywordlist {
    my($self,$tosplit) = @_;
    $tosplit = &unescape($tosplit); 
    $tosplit=~tr/+/ /;          
    my(@keywords) = split(/\s+/,$tosplit);
    return @keywords;
}
sub parse_params {
    my($self,$tosplit) = @_;
    my(@pairs) = split('&',$tosplit);
    my($param,$value);
    foreach (@pairs) {
	($param,$value) = split('=');
	$param = &unescape($param);
	$value = &unescape($value);
	$self->add_parameter($param);
	push (@{$self->{$param}},$value);
    }
}
sub add_parameter {
    my($self,$param)=@_;
    push (@{$self->{'.parameters'}},$param) 
	unless defined($self->{$param});
}
sub all_parameters {
    my $self = shift;
    return () unless defined($self) && $self->{'.parameters'};
    return () unless @{$self->{'.parameters'}};
    return @{$self->{'.parameters'}};
}
sub as_string {
    &dump(@_);
}
AUTOLOAD {
    print STDERR "CGI::AUTOLOAD for $AUTOLOAD\n" if $CGI::AUTOLOAD_DEBUG;
    my($func) = $AUTOLOAD;
    my($pack,$func_name) = $func=~/(.+)::([^:]+)$/;
    $pack = $CGI::DefaultClass
	unless defined(${"$pack\:\:AUTOLOADED_ROUTINES"});
    my($sub) = \%{"$pack\:\:SUBS"};
    unless (%$sub) {
	my($auto) = \${"$pack\:\:AUTOLOADED_ROUTINES"};
	eval "package $pack; $$auto";
	die $@ if $@;
    }
    my($code)= $sub->{$func_name};
    $code = "sub $AUTOLOAD { }" if (!$code and $func_name eq 'DESTROY');
    if (!$code) {
	if ($EXPORT{':any'} || 
	    $EXPORT{$func_name} || 
	    (%EXPORT_OK || grep(++$EXPORT_OK{$_},&expand_tags(':html')))
	    && $EXPORT_OK{$func_name}) {
	    $code = $sub->{'HTML_FUNC'};
	    $code=~s/func_name/$func_name/mg;
	}
    }
    die "Undefined subroutine $AUTOLOAD" unless $code;
    eval "package $pack; $code";
    if ($@) {
	$@ =~ s/ at .*\n//;
	die $@;
    }
    goto &{"$pack\:\:$func_name"};
}
$AUTOLOADED_ROUTINES = '';      
$AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
%SUBS = (
'URL_ENCODED'=> <<'END_OF_FUNC',
sub URL_ENCODED { 'application/x-www-form-urlencoded'; }
END_OF_FUNC
'MULTIPART' => <<'END_OF_FUNC',
sub MULTIPART {  'multipart/form-data'; }
END_OF_FUNC
'HTML_FUNC' => <<'END_OF_FUNC',
sub func_name { 
    shift if $_[0] && 
	(!ref($_[0]) && $_[0] eq $CGI::DefaultClass) ||
	    (ref($_[0]) &&
	     (substr(ref($_[0]),0,3) eq 'CGI' ||
	      eval "\$_[0]->isaCGI()"));
    my($attr) = '';
    if (ref($_[0]) && ref($_[0]) eq 'HASH') {
	my(@attr) = CGI::make_attributes('',shift);
	$attr = " @attr" if @attr;
    }
    my($tag,$untag) = ("\U<func_name\E$attr>","\U</func_name>\E");
    return $tag unless @_;
    if (ref($_[0]) eq 'ARRAY') {
	my(@r);
	foreach (@{$_[0]}) {
	    push(@r,"$tag$_$untag");
	}
	return "@r";
    } else {
	return "$tag@_$untag";
    }
}
END_OF_FUNC
'keywords' => <<'END_OF_FUNC',
sub keywords {
    my($self,@values) = self_or_default(@_);
    $self->{'keywords'}=[@values] if @values;
    my(@result) = @{$self->{'keywords'}};
    @result;
}
END_OF_FUNC
'ReadParse' => <<'END_OF_FUNC',
sub ReadParse {
    local(*in);
    if (@_) {
	*in = $_[0];
    } else {
	my $pkg = caller();
	*in=*{"${pkg}::in"};
    }
    tie(%in,CGI);
}
END_OF_FUNC
'PrintHeader' => <<'END_OF_FUNC',
sub PrintHeader {
    my($self) = self_or_default(@_);
    return $self->header();
}
END_OF_FUNC
'HtmlTop' => <<'END_OF_FUNC',
sub HtmlTop {
    my($self,@p) = self_or_default(@_);
    return $self->start_html(@p);
}
END_OF_FUNC
'HtmlBot' => <<'END_OF_FUNC',
sub HtmlBot {
    my($self,@p) = self_or_default(@_);
    return $self->end_html(@p);
}
END_OF_FUNC
'SplitParam' => <<'END_OF_FUNC',
sub SplitParam {
    my ($param) = @_;
    my (@params) = split ("\0", $param);
    return (wantarray ? @params : $params[0]);
}
END_OF_FUNC
'MethGet' => <<'END_OF_FUNC',
sub MethGet {
    return request_method() eq 'GET';
}
END_OF_FUNC
'MethPost' => <<'END_OF_FUNC',
sub MethPost {
    return request_method() eq 'POST';
}
END_OF_FUNC
'TIEHASH' => <<'END_OF_FUNC',
sub TIEHASH { 
    return new CGI;
}
END_OF_FUNC
'STORE' => <<'END_OF_FUNC',
sub STORE {
    $_[0]->param($_[1],split("\0",$_[2]));
}
END_OF_FUNC
'FETCH' => <<'END_OF_FUNC',
sub FETCH {
    return $_[0] if $_[1] eq 'CGI';
    return undef unless defined $_[0]->param($_[1]);
    return join("\0",$_[0]->param($_[1]));
}
END_OF_FUNC
'FIRSTKEY' => <<'END_OF_FUNC',
sub FIRSTKEY {
    $_[0]->{'.iterator'}=0;
    $_[0]->{'.parameters'}->[$_[0]->{'.iterator'}++];
}
END_OF_FUNC
'NEXTKEY' => <<'END_OF_FUNC',
sub NEXTKEY {
    $_[0]->{'.parameters'}->[$_[0]->{'.iterator'}++];
}
END_OF_FUNC
'EXISTS' => <<'END_OF_FUNC',
sub EXISTS {
    exists $_[0]->{$_[1]};
}
END_OF_FUNC
'DELETE' => <<'END_OF_FUNC',
sub DELETE {
    $_[0]->delete($_[1]);
}
END_OF_FUNC
'CLEAR' => <<'END_OF_FUNC',
sub CLEAR {
    %{$_[0]}=();
}
END_OF_FUNC
'append' => <<'EOF',
sub append {
    my($self,@p) = @_;
    my($name,$value) = $self->rearrange([NAME,[VALUE,VALUES]],@p);
    my(@values) = defined($value) ? (ref($value) ? @{$value} : $value) : ();
    if (@values) {
	$self->add_parameter($name);
	push(@{$self->{$name}},@values);
    }
    return $self->param($name);
}
EOF
'delete_all' => <<'EOF',
sub delete_all {
    my($self) = self_or_default(@_);
    undef %{$self};
}
EOF
'autoEscape' => <<'END_OF_FUNC',
sub autoEscape {
    my($self,$escape) = self_or_default(@_);
    $self->{'dontescape'}=!$escape;
}
END_OF_FUNC
'version' => <<'END_OF_FUNC',
sub version {
    return $VERSION;
}
END_OF_FUNC
'make_attributes' => <<'END_OF_FUNC',
sub make_attributes {
    my($self,$attr) = @_;
    return () unless $attr && ref($attr) && ref($attr) eq 'HASH';
    my(@att);
    foreach (keys %{$attr}) {
	my($key) = $_;
	$key=~s/^\-//;     
	$key=~tr/a-z/A-Z/; 
	push(@att,$attr->{$_} ne '' ? qq/$key="$attr->{$_}"/ : qq/$key/);
    }
    return @att;
}
END_OF_FUNC
'dump' => <<'END_OF_FUNC',
sub dump {
    my($self) = @_;
    my($param,$value,@result);
    return '<UL></UL>' unless $self->param;
    push(@result,"<UL>");
    foreach $param ($self->param) {
	my($name)=$self->escapeHTML($param);
	push(@result,"<LI><STRONG>$param</STRONG>");
	push(@result,"<UL>");
	foreach $value ($self->param($param)) {
	    $value = $self->escapeHTML($value);
	    push(@result,"<LI>$value");
	}
	push(@result,"</UL>");
    }
    push(@result,"</UL>\n");
    return join("\n",@result);
}
END_OF_FUNC
'save' => <<'END_OF_FUNC',
sub save {
    my($self,$filehandle) = self_or_default(@_);
    my($param);
    my($package) = caller;
    $filehandle = $filehandle=~/[':]/ ? $filehandle : "$package\:\:$filehandle";
    foreach $param ($self->param) {
	my($escaped_param) = &escape($param);
	my($value);
	foreach $value ($self->param($param)) {
	    print $filehandle "$escaped_param=",escape($value),"\n";
	}
    }
    print $filehandle "=\n";    
}
END_OF_FUNC
'header' => <<'END_OF_FUNC',
sub header {
    my($self,@p) = self_or_default(@_);
    my(@header);
    my($type,$status,$cookie,$target,$expires,$nph,@other) = 
	$self->rearrange([TYPE,STATUS,[COOKIE,COOKIES],TARGET,EXPIRES,NPH],@p);
    foreach (@other) {
	next unless my($header,$value) = /([^\s=]+)=(.+)/;
	substr($header,1,1000)=~tr/A-Z/a-z/;
	($value)=$value=~/^"(.*)"$/;
	$_ = "$header: $value";
    }
    $type = $type || 'text/html';
    push(@header,'HTTP/1.0 ' . ($status || '200 OK')) if $nph || $NPH;
    push(@header,"Status: $status") if $status;
    push(@header,"Window-target: $target") if $target;
    if ($cookie) {
	my(@cookie) = ref($cookie) ? @{$cookie} : $cookie;
	foreach (@cookie) {
	    push(@header,"Set-cookie: $_");
	}
    }
    push(@header,"Expires: " . &expires($expires)) if $expires;
    push(@header,"Pragma: no-cache") if $self->cache();
    push(@header,@other);
    push(@header,"Content-type: $type");
    my $header = join($CRLF,@header);
    return $header . "${CRLF}${CRLF}";
}
END_OF_FUNC
'cache' => <<'END_OF_FUNC',
sub cache {
    my($self,$new_value) = self_or_default(@_);
    $new_value = '' unless $new_value;
    if ($new_value ne '') {
	$self->{'cache'} = $new_value;
    }
    return $self->{'cache'};
}
END_OF_FUNC
'redirect' => <<'END_OF_FUNC',
sub redirect {
    my($self,@p) = self_or_default(@_);
    my($url,$target,$cookie,$nph,@other) = $self->rearrange([[URI,URL],TARGET,COOKIE,NPH],@p);
    $url = $url || $self->self_url;
    my(@o);
    foreach (@other) { push(@o,split("=")); }
    push(@o,
	 '-Status'=>'302 Found',
	 '-Location'=>$url,
	 '-URI'=>$url,
	 '-nph'=>($nph||$NPH));
    push(@o,'-Target'=>$target) if $target;
    push(@o,'-Cookie'=>$cookie) if $cookie;
    return $self->header(@o);
}
END_OF_FUNC
'start_html' => <<'END_OF_FUNC',
sub start_html {
    my($self,@p) = &self_or_default(@_);
    my($title,$author,$base,$xbase,$script,$meta,@other) = 
	$self->rearrange([TITLE,AUTHOR,BASE,XBASE,SCRIPT,META],@p);
    $title = $self->escapeHTML($title || 'Untitled Document');
    $author = $self->escapeHTML($author);
    my(@result);
    push(@result,'<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">');
    push(@result,"<HTML><HEAD><TITLE>$title</TITLE>");
    push(@result,"<LINK REV=MADE HREF=\"mailto:$author\">") if $author;
    push(@result,"<BASE HREF=\"http://".$self->server_name.":".$self->server_port.$self->script_name."\">")
	if $base && !$xbase;
    push(@result,"<BASE HREF=\"$xbase\">") if $xbase;
    if ($meta && ref($meta) && (ref($meta) eq 'HASH')) {
	foreach (keys %$meta) { push(@result,qq(<META NAME="$_" CONTENT="$meta->{$_}">)); }
    }
    push(@result,<<END) if $script;
<SCRIPT>
<!-- Hide script from HTML-compliant browsers
$script
// End script hiding. -->
</SCRIPT>
END
    ;
    my($other) = @other ? " @other" : '';
    push(@result,"</HEAD><BODY$other>");
    return join("\n",@result);
}
END_OF_FUNC
'end_html' => <<'END_OF_FUNC',
sub end_html {
    return "</BODY></HTML>";
}
END_OF_FUNC
'isindex' => <<'END_OF_FUNC',
sub isindex {
    my($self,@p) = self_or_default(@_);
    my($action,@other) = $self->rearrange([ACTION],@p);
    $action = qq/ACTION="$action"/ if $action;
    my($other) = @other ? " @other" : '';
    return "<ISINDEX $action$other>";
}
END_OF_FUNC
'startform' => <<'END_OF_FUNC',
sub startform {
    my($self,@p) = self_or_default(@_);
    my($method,$action,$enctype,@other) = 
	$self->rearrange([METHOD,ACTION,ENCTYPE],@p);
    $method = $method || 'POST';
    $enctype = $enctype || &URL_ENCODED;
    $action = $action ? qq/ACTION="$action"/ : $method eq 'GET' ?
	'ACTION="'.$self->script_name.'"' : '';
    my($other) = @other ? " @other" : '';
    $self->{'.parametersToAdd'}={};
    return qq/<FORM METHOD="$method" $action ENCTYPE="$enctype"$other>\n/;
}
END_OF_FUNC
'start_form' => <<'END_OF_FUNC',
sub start_form {
    &startform(@_);
}
END_OF_FUNC
'start_multipart_form' => <<'END_OF_FUNC',
sub start_multipart_form {
    my($self,@p) = self_or_default(@_);
    if ($self->use_named_parameters || 
	(defined($param[0]) && substr($param[0],0,1) eq '-')) {
	my(%p) = @p;
	$p{'-enctype'}=&MULTIPART;
	return $self->startform(%p);
    } else {
	my($method,$action,@other) = 
	    $self->rearrange([METHOD,ACTION],@p);
	return $self->startform($method,$action,&MULTIPART,@other);
    }
}
END_OF_FUNC
'endform' => <<'END_OF_FUNC',
sub endform {
    my($self,@p) = self_or_default(@_);    
    return ($self->get_fields,"</FORM>");
}
END_OF_FUNC
'end_form' => <<'END_OF_FUNC',
sub end_form {
    &endform(@_);
}
END_OF_FUNC
'textfield' => <<'END_OF_FUNC',
sub textfield {
    my($self,@p) = self_or_default(@_);
    my($name,$default,$size,$maxlength,$override,@other) = 
	$self->rearrange([NAME,[DEFAULT,VALUE],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p);
    my $current = $override ? $default : 
	(defined($self->param($name)) ? $self->param($name) : $default);
    $current = defined($current) ? $self->escapeHTML($current) : '';
    $name = defined($name) ? $self->escapeHTML($name) : '';
    my($s) = defined($size) ? qq/ SIZE=$size/ : '';
    my($m) = defined($maxlength) ? qq/ MAXLENGTH=$maxlength/ : '';
    my($other) = @other ? " @other" : '';    
    return qq/<INPUT TYPE="text" NAME="$name" VALUE="$current"$s$m$other>/;
}
END_OF_FUNC
'filefield' => <<'END_OF_FUNC',
sub filefield {
    my($self,@p) = self_or_default(@_);
    my($name,$default,$size,$maxlength,$override,@other) = 
	$self->rearrange([NAME,[DEFAULT,VALUE],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p);
    $current = $override ? $default :
	(defined($self->param($name)) ? $self->param($name) : $default);
    $name = defined($name) ? $self->escapeHTML($name) : '';
    my($s) = defined($size) ? qq/ SIZE=$size/ : '';
    my($m) = defined($maxlength) ? qq/ MAXLENGTH=$maxlength/ : '';
    $current = defined($current) ? $self->escapeHTML($current) : '';
    $other = ' ' . join(" ",@other);
    return qq/<INPUT TYPE="file" NAME="$name" VALUE="$current"$s$m$other>/;
}
END_OF_FUNC
'password_field' => <<'END_OF_FUNC',
sub password_field {
    my ($self,@p) = self_or_default(@_);
    my($name,$default,$size,$maxlength,$override,@other) = 
	$self->rearrange([NAME,[DEFAULT,VALUE],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p);
    my($current) =  $override ? $default :
	(defined($self->param($name)) ? $self->param($name) : $default);
    $name = defined($name) ? $self->escapeHTML($name) : '';
    $current = defined($current) ? $self->escapeHTML($current) : '';
    my($s) = defined($size) ? qq/ SIZE=$size/ : '';
    my($m) = defined($maxlength) ? qq/ MAXLENGTH=$maxlength/ : '';
    my($other) = @other ? " @other" : '';
    return qq/<INPUT TYPE="password" NAME="$name" VALUE="$current"$s$m$other>/;
}
END_OF_FUNC
'textarea' => <<'END_OF_FUNC',
sub textarea {
    my($self,@p) = self_or_default(@_);
    my($name,$default,$rows,$cols,$override,@other) =
	$self->rearrange([NAME,[DEFAULT,VALUE],ROWS,[COLS,COLUMNS],[OVERRIDE,FORCE]],@p);
    my($current)= $override ? $default :
	(defined($self->param($name)) ? $self->param($name) : $default);
    $name = defined($name) ? $self->escapeHTML($name) : '';
    $current = defined($current) ? $self->escapeHTML($current) : '';
    my($r) = $rows ? " ROWS=$rows" : '';
    my($c) = $cols ? " COLS=$cols" : '';
    my($other) = @other ? " @other" : '';
    return qq{<TEXTAREA NAME="$name"$r$c$other>$current</TEXTAREA>};
}
END_OF_FUNC
'button' => <<'END_OF_FUNC',
sub button {
    my($self,@p) = self_or_default(@_);
    my($label,$value,$script,@other) = $self->rearrange([NAME,[VALUE,LABEL],
							 [ONCLICK,SCRIPT]],@p);
    $label=$self->escapeHTML($label);
    $value=$self->escapeHTML($value);
    $script=$self->escapeHTML($script);
    my($name) = '';
    $name = qq/ NAME="$label"/ if $label;
    $value = $value || $label;
    my($val) = '';
    $val = qq/ VALUE="$value"/ if $value;
    $script = qq/ ONCLICK="$script"/ if $script;
    my($other) = @other ? " @other" : '';
    return qq/<INPUT TYPE="button"$name$val$script$other>/;
}
END_OF_FUNC
'submit' => <<'END_OF_FUNC',
sub submit {
    my($self,@p) = self_or_default(@_);
    my($label,$value,@other) = $self->rearrange([NAME,[VALUE,LABEL]],@p);
    $label=$self->escapeHTML($label);
    $value=$self->escapeHTML($value);
    my($name) = ' NAME=".submit"';
    $name = qq/ NAME="$label"/ if $label;
    $value = $value || $label;
    my($val) = '';
    $val = qq/ VALUE="$value"/ if defined($value);
    my($other) = @other ? " @other" : '';
    return qq/<INPUT TYPE="submit"$name$val$other>/;
}
END_OF_FUNC
'reset' => <<'END_OF_FUNC',
sub reset {
    my($self,@p) = self_or_default(@_);
    my($label,@other) = $self->rearrange([NAME],@p);
    $label=$self->escapeHTML($label);
    my($value) = defined($label) ? qq/ VALUE="$label"/ : '';
    my($other) = @other ? " @other" : '';
    return qq/<INPUT TYPE="reset"$value$other>/;
}
END_OF_FUNC
'defaults' => <<'END_OF_FUNC',
sub defaults {
    my($self,@p) = self_or_default(@_);
    my($label,@other) = $self->rearrange([[NAME,VALUE]],@p);
    $label=$self->escapeHTML($label);
    $label = $label || "Defaults";
    my($value) = qq/ VALUE="$label"/;
    my($other) = @other ? " @other" : '';
    return qq/<INPUT TYPE="submit" NAME=".defaults"$value$other>/;
}
END_OF_FUNC
'checkbox' => <<'END_OF_FUNC',
sub checkbox {
    my($self,@p) = self_or_default(@_);
    my($name,$checked,$value,$label,$override,@other) = 
	$self->rearrange([NAME,[CHECKED,SELECTED,ON],VALUE,LABEL,[OVERRIDE,FORCE]],@p);
    if (!$override && defined($self->param($name))) {
	$value = $self->param($name) unless defined $value;
	$checked = $self->param($name) eq $value ? ' CHECKED' : '';
    } else {
	$checked = $checked ? ' CHECKED' : '';
	$value = defined $value ? $value : 'on';
    }
    my($the_label) = defined $label ? $label : $name;
    $name = $self->escapeHTML($name);
    $value = $self->escapeHTML($value);
    $the_label = $self->escapeHTML($the_label);
    my($other) = @other ? " @other" : '';
    $self->register_parameter($name);
    return <<END;
<INPUT TYPE="checkbox" NAME="$name" VALUE="$value"$checked$other>$the_label
END
}
END_OF_FUNC
'checkbox_group' => <<'END_OF_FUNC',
sub checkbox_group {
    my($self,@p) = self_or_default(@_);
    my($name,$values,$defaults,$linebreak,$labels,$rows,$columns,
       $rowheaders,$colheaders,$override,$nolabels,@other) =
	$self->rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT],
			  LINEBREAK,LABELS,ROWS,[COLUMNS,COLS],
			  ROWHEADERS,COLHEADERS,
			  [OVERRIDE,FORCE],NOLABELS],@p);
    my($checked,$break,$result,$label);
    my(%checked) = $self->previous_or_default($name,$defaults,$override);
    $break = $linebreak ? "<BR>" : '';
    $name=$self->escapeHTML($name);
    my(@elements);
    my(@values) = $values ? @$values : $self->param($name);
    my($other) = @other ? " @other" : '';
    foreach (@values) {
	$checked = $checked{$_} ? ' CHECKED' : '';
	$label = '';
	unless (defined($nolabels) && $nolabels) {
	    $label = $_;
	    $label = $labels->{$_} if defined($labels) && $labels->{$_};
	    $label = $self->escapeHTML($label);
	}
	$_ = $self->escapeHTML($_);
	push(@elements,qq/<INPUT TYPE="checkbox" NAME="$name" VALUE="$_"$checked$other>${label} ${break}/);
    }
    $self->register_parameter($name);
    return wantarray ? @elements : join('',@elements) unless $columns;
    return _tableize($rows,$columns,$rowheaders,$colheaders,@elements);
}
END_OF_FUNC
'escapeHTML' => <<'END_OF_FUNC',
sub escapeHTML {
    my($self,$toencode) = @_;
    return undef unless defined($toencode);
    return $toencode if $self->{'dontescape'};
    $toencode=~s/&/&amp;/g;
    $toencode=~s/\"/&quot;/g;
    $toencode=~s/>/&gt;/g;
    $toencode=~s/</&lt;/g;
    return $toencode;
}
END_OF_FUNC
'_tableize' => <<'END_OF_FUNC',
sub _tableize {
    my($rows,$columns,$rowheaders,$colheaders,@elements) = @_;
    my($result);
    $rows = int(0.99 + @elements/$columns) unless $rows;
    $result = "<TABLE>";
    my($row,$column);
    unshift(@$colheaders,'') if @$colheaders && @$rowheaders;
    $result .= "<TR>" if @{$colheaders};
    foreach (@{$colheaders}) {
	$result .= "<TH>$_</TH>";
    }
    for ($row=0;$row<$rows;$row++) {
	$result .= "<TR>";
	$result .= "<TH>$rowheaders->[$row]</TH>" if @$rowheaders;
	for ($column=0;$column<$columns;$column++) {
	    $result .= "<TD>" . $elements[$column*$rows + $row] . "</TD>";
	}
	$result .= "</TR>";
    }
    $result .= "</TABLE>";
    return $result;
}
END_OF_FUNC
'radio_group' => <<'END_OF_FUNC',
sub radio_group {
    my($self,@p) = self_or_default(@_);
    my($name,$values,$default,$linebreak,$labels,
       $rows,$columns,$rowheaders,$colheaders,$override,$nolabels,@other) =
	$self->rearrange([NAME,[VALUES,VALUE],DEFAULT,LINEBREAK,LABELS,
			  ROWS,[COLUMNS,COLS],
			  ROWHEADERS,COLHEADERS,
			  [OVERRIDE,FORCE],NOLABELS],@p);
    my($result,$checked);
    if (!$override && defined($self->param($name))) {
	$checked = $self->param($name);
    } else {
	$checked = $default;
    }
    $checked = $values->[0] unless defined($checked) && $checked ne '';
    $name=$self->escapeHTML($name);
    my(@elements);
    my(@values) = $values ? @$values : $self->param($name);
    my($other) = @other ? " @other" : '';
    foreach (@values) {
	my($checkit) = $checked eq $_ ? ' CHECKED' : '';
	my($break) = $linebreak ? '<BR>' : '';
	my($label)='';
	unless (defined($nolabels) && $nolabels) {
	    $label = $_;
	    $label = $labels->{$_} if defined($labels) && $labels->{$_};
	    $label = $self->escapeHTML($label);
	}
	$_=$self->escapeHTML($_);
	push(@elements,qq/<INPUT TYPE="radio" NAME="$name" VALUE="$_"$checkit$other>${label} ${break}/);
    }
    $self->register_parameter($name);
    return wantarray ? @elements : join('',@elements) unless $columns;
    return _tableize($rows,$columns,$rowheaders,$colheaders,@elements);
}
END_OF_FUNC
'popup_menu' => <<'END_OF_FUNC',
sub popup_menu {
    my($self,@p) = self_or_default(@_);
    my($name,$values,$default,$labels,$override,@other) =
	$self->rearrange([NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LABELS,[OVERRIDE,FORCE]],@p);
    my($result,$selected);
    if (!$override && defined($self->param($name))) {
	$selected = $self->param($name);
    } else {
	$selected = $default;
    }
    $name=$self->escapeHTML($name);
    my($other) = @other ? " @other" : '';
    my(@values) = $values ? @$values : $self->param($name);
    $result = qq/<SELECT NAME="$name"$other>\n/;
    foreach (@values) {
	my($selectit) = defined($selected) ? ($selected eq $_ ? 'SELECTED' : '' ) : '';
	my($label) = $_;
	$label = $labels->{$_} if defined($labels) && $labels->{$_};
	my($value) = $self->escapeHTML($_);
	$label=$self->escapeHTML($label);
	$result .= "<OPTION $selectit VALUE=\"$value\">$label\n";
    }
    $result .= "</SELECT>\n";
    return $result;
}
END_OF_FUNC
'scrolling_list' => <<'END_OF_FUNC',
sub scrolling_list {
    my($self,@p) = self_or_default(@_);
    my($name,$values,$defaults,$size,$multiple,$labels,$override,@other)
	= $self->rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT],
			    SIZE,MULTIPLE,LABELS,[OVERRIDE,FORCE]],@p);
    my($result);
    my(@values) = $values ? @$values : $self->param($name);
    $size = $size || scalar(@values);
    my(%selected) = $self->previous_or_default($name,$defaults,$override);
    my($is_multiple) = $multiple ? ' MULTIPLE' : '';
    my($has_size) = $size ? " SIZE=$size" : '';
    my($other) = @other ? " @other" : '';
    $name=$self->escapeHTML($name);
    $result = qq/<SELECT NAME="$name"$has_size$is_multiple$other>\n/;
    foreach (@values) {
	my($selectit) = $selected{$_} ? 'SELECTED' : '';
	my($label) = $_;
	$label = $labels->{$_} if defined($labels) && $labels->{$_};
	$label=$self->escapeHTML($label);
	my($value)=$self->escapeHTML($_);
	$result .= "<OPTION $selectit VALUE=\"$value\">$label\n";
    }
    $result .= "</SELECT>\n";
    $self->register_parameter($name);
    return $result;
}
END_OF_FUNC
'hidden' => <<'END_OF_FUNC',
sub hidden {
    my($self,@p) = self_or_default(@_);
    my(@result,@value);
    my($name,$default,$override,@other) = 
	$self->rearrange([NAME,[DEFAULT,VALUE,VALUES],[OVERRIDE,FORCE]],@p);
    my $do_override = 0;
    if ( substr($p[0],0,1) eq '-' || $self->use_named_parameters ) {
	@value = ref($default) ? @{$default} : $default;
	$do_override = $override;
    } else {
	foreach ($default,$override,@other) {
	    push(@value,$_) if defined($_);
	}
    }
    my @prev = $self->param($name);
    @value = @prev if !$do_override && @prev;
    $name=$self->escapeHTML($name);
    foreach (@value) {
	$_=$self->escapeHTML($_);
	push(@result,qq/<INPUT TYPE="hidden" NAME="$name" VALUE="$_">/);
    }
    return wantarray ? @result : join('',@result);
}
END_OF_FUNC
'image_button' => <<'END_OF_FUNC',
sub image_button {
    my($self,@p) = self_or_default(@_);
    my($name,$src,$alignment,@other) =
	$self->rearrange([NAME,SRC,ALIGN],@p);
    my($align) = $alignment ? " ALIGN=\U$alignment" : '';
    my($other) = @other ? " @other" : '';
    $name=$self->escapeHTML($name);
    return qq/<INPUT TYPE="image" NAME="$name" SRC="$src"$align$other>/;
}
END_OF_FUNC
'self_url' => <<'END_OF_FUNC',
sub self_url {
    my($self) = self_or_default(@_);
    my($query_string) = $self->query_string;
    my $protocol = $self->protocol();
    my $name = "$protocol://" . $self->server_name;
    $name .= ":" . $self->server_port
	unless $self->server_port == 80;
    $name .= $self->script_name;
    $name .= $self->path_info if $self->path_info;
    return $name unless $query_string;
    return "$name?$query_string";
}
END_OF_FUNC
'state' => <<'END_OF_FUNC',
sub state {
    &self_url;
}
END_OF_FUNC
'url' => <<'END_OF_FUNC',
sub url {
    my($self) = self_or_default(@_);
    my $protocol = $self->protocol();
    my $name = "$protocol://" . $self->server_name;
    $name .= ":" . $self->server_port
	unless $self->server_port == 80;
    $name .= $self->script_name;
    return $name;
}
END_OF_FUNC
'cookie' => <<'END_OF_FUNC',
sub cookie {
    my($self,@p) = self_or_default(@_);
    my($name,$value,$path,$domain,$secure,$expires) =
	$self->rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@p);
    unless (defined($value)) {
	unless ($self->{'.cookies'}) {
	    my(@pairs) = split("; ",$self->raw_cookie);
	    foreach (@pairs) {
		my($key,$value) = split("=");
		my(@values) = map unescape($_),split('&',$value);
		$self->{'.cookies'}->{unescape($key)} = [@values];
	    }
	}
	return wantarray ? @{$self->{'.cookies'}->{$name}} : $self->{'.cookies'}->{$name}->[0];
    }
    my(@values);
    if (ref($value)) {
	if (ref($value) eq 'ARRAY') {
	    @values = @$value;
	} elsif (ref($value) eq 'HASH') {
	    @values = %$value;
	}
    } else {
	@values = ($value);
    }
    @values = map escape($_),@values;
    my(@constant_values);
    push(@constant_values,"domain=$domain") if $domain;
    push(@constant_values,"path=$path") if $path;
    push(@constant_values,"expires=".&expires($expires)) if $expires;
    push(@constant_values,'secure') if $secure;
    my($key) = &escape($name);
    my($cookie) = join("=",$key,join("&",@values));
    return join("; ",$cookie,@constant_values);
}
END_OF_FUNC
'expires' => <<'END_OF_FUNC',
sub expires {
    my($time) = @_;
    my(@MON)=qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
    my(@WDAY) = qw/Sunday Monday Tuesday Wednesday Thursday Friday Saturday/;
    my(%mult) = ('s'=>1,
		 'm'=>60,
		 'h'=>60*60,
		 'd'=>60*60*24,
		 'M'=>60*60*24*30,
		 'y'=>60*60*24*365);
    my($offset);
    if (!$time || ($time eq 'now')) {
	$offset = 0;
    } elsif ($time=~/^([+-]?\d+)([mhdMy]?)/) {
	$offset = ($mult{$2} || 1)*$1;
    } else {
	return $time;
    }
    my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime(time+$offset);
    $year += 1900 unless $year < 100;
    return sprintf("%s, %02d-%s-%02d %02d:%02d:%02d GMT",
		   $WDAY[$wday],$mday,$MON[$mon],$year,$hour,$min,$sec);
}
END_OF_FUNC
'path_info' => <<'END_OF_FUNC',
sub path_info {
    return $ENV{'PATH_INFO'};
}
END_OF_FUNC
'request_method' => <<'END_OF_FUNC',
sub request_method {
    return $ENV{'REQUEST_METHOD'};
}
END_OF_FUNC
'path_translated' => <<'END_OF_FUNC',
sub path_translated {
    return $ENV{'PATH_TRANSLATED'};
}
END_OF_FUNC
'query_string' => <<'END_OF_FUNC',
sub query_string {
    my($self) = self_or_default(@_);
    my($param,$value,@pairs);
    foreach $param ($self->param) {
	my($eparam) = &escape($param);
	foreach $value ($self->param($param)) {
	    $value = &escape($value);
	    push(@pairs,"$eparam=$value");
	}
    }
    return join("&",@pairs);
}
END_OF_FUNC
'accept' => <<'END_OF_FUNC',
sub accept {
    my($self,$search) = self_or_CGI(@_);
    my(%prefs,$type,$pref,$pat);
    my(@accept) = split(',',$self->http('accept'));
    foreach (@accept) {
	($pref) = /q=(\d\.\d+|\d+)/;
	($type) = m
	next unless $type;
	$prefs{$type}=$pref || 1;
    }
    return keys %prefs unless $search;
    return $prefs{$search} if $prefs{$search};
    foreach (keys %prefs) {
	next unless /\*/;       
	($pat = $_) =~ s/([^\w*])/\\$1/g; 
	$pat =~ s/\*/.*/g; 
	return $prefs{$_} if $search=~/$pat/;
    }
}
END_OF_FUNC
'user_agent' => <<'END_OF_FUNC',
sub user_agent {
    my($self,$match)=self_or_CGI(@_);
    return $self->http('user_agent') unless $match;
    return $self->http('user_agent') =~ /$match/i;
}
END_OF_FUNC
'raw_cookie' => <<'END_OF_FUNC',
sub raw_cookie {
    my($self) = self_or_CGI(@_);
    return $self->http('cookie') || '';
}
END_OF_FUNC
'virtual_host' => <<'END_OF_FUNC',
sub virtual_host {
    return http('host') || server_name();
}
END_OF_FUNC
'remote_host' => <<'END_OF_FUNC',
sub remote_host {
    return $ENV{'REMOTE_HOST'} || $ENV{'REMOTE_ADDR'} 
    || 'localhost';
}
END_OF_FUNC
'remote_addr' => <<'END_OF_FUNC',
sub remote_addr {
    return $ENV{'REMOTE_ADDR'} || '127.0.0.1';
}
END_OF_FUNC
'script_name' => <<'END_OF_FUNC',
sub script_name {
    return $ENV{'SCRIPT_NAME'} if $ENV{'SCRIPT_NAME'};
    return "/$0" unless $0=~/^\//;
    return $0;
}
END_OF_FUNC
'referer' => <<'END_OF_FUNC',
sub referer {
    my($self) = self_or_CGI(@_);
    return $self->http('referer');
}
END_OF_FUNC
'server_name' => <<'END_OF_FUNC',
sub server_name {
    return $ENV{'SERVER_NAME'} || 'localhost';
}
END_OF_FUNC
'server_software' => <<'END_OF_FUNC',
sub server_software {
    return $ENV{'SERVER_SOFTWARE'} || 'cmdline';
}
END_OF_FUNC
'server_port' => <<'END_OF_FUNC',
sub server_port {
    return $ENV{'SERVER_PORT'} || 80; 
}
END_OF_FUNC
'server_protocol' => <<'END_OF_FUNC',
sub server_protocol {
    return $ENV{'SERVER_PROTOCOL'} || 'HTTP/1.0'; 
}
END_OF_FUNC
'http' => <<'END_OF_FUNC',
sub http {
    my ($self,$parameter) = self_or_CGI(@_);
    return $ENV{$parameter} if $parameter=~/^HTTP/;
    return $ENV{"HTTP_\U$parameter\E"} if $parameter;
    my(@p);
    foreach (keys %ENV) {
	push(@p,$_) if /^HTTP/;
    }
    return @p;
}
END_OF_FUNC
'https' => <<'END_OF_FUNC',
sub https {
    local($^W)=0;
    my ($self,$parameter) = self_or_CGI(@_);
    return $ENV{HTTPS} unless $parameter;
    return $ENV{$parameter} if $parameter=~/^HTTPS/;
    return $ENV{"HTTPS_\U$parameter\E"} if $parameter;
    my(@p);
    foreach (keys %ENV) {
	push(@p,$_) if /^HTTPS/;
    }
    return @p;
}
END_OF_FUNC
'protocol' => <<'END_OF_FUNC',
sub protocol {
    local($^W)=0;
    my $self = shift;
    return 'https' if $self->https() eq 'ON'; 
    return 'https' if $self->server_port == 443;
    my $prot = $self->server_protocol;
    my($protocol,$version) = split('/',$prot);
    return "\L$protocol\E";
}
END_OF_FUNC
'remote_ident' => <<'END_OF_FUNC',
sub remote_ident {
    return $ENV{'REMOTE_IDENT'};
}
END_OF_FUNC
'auth_type' => <<'END_OF_FUNC',
sub auth_type {
    return $ENV{'AUTH_TYPE'};
}
END_OF_FUNC
'remote_user' => <<'END_OF_FUNC',
sub remote_user {
    return $ENV{'REMOTE_USER'};
}
END_OF_FUNC
'user_name' => <<'END_OF_FUNC',
sub user_name {
    my ($self) = self_or_CGI(@_);
    return $self->http('from') || $ENV{'REMOTE_IDENT'} || $ENV{'REMOTE_USER'};
}
END_OF_FUNC
'nph' => <<'END_OF_FUNC',
sub nph {
    my ($self,$param) = self_or_CGI(@_);
    $CGI::nph = $param if defined($param);
    return $CGI::nph;
}
END_OF_FUNC
'rearrange' => <<'END_OF_FUNC',
sub rearrange {
    my($self,$order,@param) = @_;
    return () unless @param;
    return @param unless (defined($param[0]) && substr($param[0],0,1) eq '-')
	|| $self->use_named_parameters;
    my $i;
    for ($i=0;$i<@param;$i+=2) {
	$param[$i]=~s/^\-//;     
	$param[$i]=~tr/a-z/A-Z/; 
    }
    my(%param) = @param;                
    my(@return_array);
    my($key)='';
    foreach $key (@$order) {
	my($value);
	if (ref($key) && ref($key) eq 'ARRAY') {
	    foreach (@$key) {
		last if defined($value);
		$value = $param{$_};
		delete $param{$_};
	    }
	} else {
	    $value = $param{$key};
	    delete $param{$key};
	}
	push(@return_array,$value);
    }
    push (@return_array,$self->make_attributes(\%param)) if %param;
    return (@return_array);
}
END_OF_FUNC
'previous_or_default' => <<'END_OF_FUNC',
sub previous_or_default {
    my($self,$name,$defaults,$override) = @_;
    my(%selected);
    if (!$override && ($self->{'.fieldnames'}->{$name} || 
		       defined($self->param($name)) ) ) {
	grep($selected{$_}++,$self->param($name));
    } elsif (defined($defaults) && ref($defaults) && 
	     (ref($defaults) eq 'ARRAY')) {
	grep($selected{$_}++,@{$defaults});
    } else {
	$selected{$defaults}++ if defined($defaults);
    }
    return %selected;
}
END_OF_FUNC
'register_parameter' => <<'END_OF_FUNC',
sub register_parameter {
    my($self,$param) = @_;
    $self->{'.parametersToAdd'}->{$param}++;
}
END_OF_FUNC
'get_fields' => <<'END_OF_FUNC',
sub get_fields {
    my($self) = @_;
    return $self->hidden('-name'=>'.cgifields',
			 '-values'=>[keys %{$self->{'.parametersToAdd'}}],
			 '-override'=>1);
}
END_OF_FUNC
'read_from_cmdline' => <<'END_OF_FUNC',
sub read_from_cmdline {
    require "shellwords.pl";
    my($input,@words);
    my($query_string);
    if (@ARGV) {
	$input = join(" ",@ARGV);
    } else {
	print STDERR "(offline mode: enter name=value pairs on standard input)\n";
	chomp(@lines = <>); 
	$input = join(" ",@lines);
    }
    $input=~s/\\=/%3D/g;
    $input=~s/\\&/%26/g;
    @words = &shellwords($input);
    if ("@words"=~/=/) {
	$query_string = join('&',@words);
    } else {
	$query_string = join('+',@words);
    }
    return $query_string;
}
END_OF_FUNC
'read_multipart' => <<'END_OF_FUNC',
sub read_multipart {
    my($self,$boundary,$length) = @_;
    my($buffer) = $self->new_MultipartBuffer($boundary,$length);
    return unless $buffer;
    my(%header,$body);
    while (!$buffer->eof) {
	%header = $buffer->readHeader;
	my($key) = $header{'Content-disposition'} ? 'Content-disposition' : 'Content-Disposition';
	my($param)= $header{$key}=~/ name="([^\"]*)"/;
	my($filename) = $header{$key}=~/ filename="(.*)"$/;
	$self->add_parameter($param);
	unless ($filename) {
	    my($value) = $buffer->readBody;
	    push(@{$self->{$param}},$value);
	    next;
	}
	my($tmpfile) = new TempFile;
	open (OUT,">$tmpfile") || die "CGI open of $tmpfile: $!\n";
	$CGI::DefaultClass->binmode(OUT) if $CGI::needs_binmode;
	chmod 0666,$tmpfile;    
	my $data;
	while ($data = $buffer->read) {
	    print OUT $data;
	}
	close OUT;
	my($filehandle);
	if ($filename=~/^[a-zA-Z_]/) {
	    my($frame,$cp)=(1);
	    do { $cp = caller($frame++); } until !eval("$cp->isaCGI()");
	    $filehandle = "$cp\:\:$filename";
	} else {
	    $filehandle = "\:\:$filename";
	}
	open($filehandle,$tmpfile) || die "CGI open of $tmpfile: $!\n";
	$CGI::DefaultClass->binmode($filehandle) if $CGI::needs_binmode;
	push(@{$self->{$param}},$filename);
	$self->{'.tmpfiles'}->{$filename}=$tmpfile;
    }
}
END_OF_FUNC
'tmpFileName' => <<'END_OF_FUNC'
sub tmpFileName {
    my($self,$filename) = self_or_default(@_);
    return $self->{'.tmpfiles'}->{$filename};
}
END_OF_FUNC
);
END_OF_AUTOLOAD
;
package MultipartBuffer;
$FILLUNIT = 1024 * 5;
$TIMEOUT = 10*60;       
$SPIN_LOOP_MAX = 1000;  
$CRLF=$CGI::CRLF;
*MultipartBuffer::AUTOLOAD = \&CGI::AUTOLOAD;
$AUTOLOADED_ROUTINES = '';      
$AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
%SUBS =  (
'new' => <<'END_OF_FUNC',
sub new {
    my($package,$interface,$boundary,$length,$filehandle) = @_;
    my $IN;
    if ($filehandle) {
	my($package) = caller;
	$IN = $filehandle=~/[':]/ ? $filehandle : "$package\:\:$filehandle"; 
    }
    $IN = "main::STDIN" unless $IN;
    $CGI::DefaultClass->binmode($IN) if $CGI::needs_binmode;
    if ($boundary) {
	$boundary = "--$boundary";
	my($null) = '';
	$length -= $interface->read_from_client($IN,\$null,length($boundary)+2,0);
    } else { 
	my($old);
	($old,$/) = ($/,$CRLF); 
	$boundary = <$IN>;      
	$length -= length($boundary);
	chomp($boundary);               
	$/ = $old;                      
    }
    my $self = {LENGTH=>$length,
		BOUNDARY=>$boundary,
		IN=>$IN,
		INTERFACE=>$interface,
		BUFFER=>'',
	    };
    $FILLUNIT = length($boundary)
	if length($boundary) > $FILLUNIT;
    return bless $self,ref $package || $package;
}
END_OF_FUNC
'readHeader' => <<'END_OF_FUNC',
sub readHeader {
    my($self) = @_;
    my($end);
    my($ok) = 0;
    do {
	$self->fillBuffer($FILLUNIT);
	$ok++ if ($end = index($self->{BUFFER},"${CRLF}${CRLF}")) >= 0;
	$ok++ if $self->{BUFFER} eq '';
	$FILLUNIT *= 2 if length($self->{BUFFER}) >= $FILLUNIT; 
    } until $ok;
    my($header) = substr($self->{BUFFER},0,$end+2);
    substr($self->{BUFFER},0,$end+4) = '';
    my %return;
    while ($header=~/^([\w-]+): (.*)$CRLF/mog) {
	$return{$1}=$2;
    }
    return %return;
}
END_OF_FUNC
'readBody' => <<'END_OF_FUNC',
sub readBody {
    my($self) = @_;
    my($data);
    my($returnval)='';
    while (defined($data = $self->read)) {
	$returnval .= $data;
    }
    return $returnval;
}
END_OF_FUNC
'read' => <<'END_OF_FUNC',
sub read {
    my($self,$bytes) = @_;
    $bytes = $bytes || $FILLUNIT;       
    $self->fillBuffer($bytes);
    my $start = index($self->{BUFFER},$self->{BOUNDARY});
    if ($start == 0) {
	if (index($self->{BUFFER},"$self->{BOUNDARY}--")==0) {
	    $self->{BUFFER}='';
	    $self->{LENGTH}=0;
	    return undef;
	}
	substr($self->{BUFFER},0,length($self->{BOUNDARY})+2)='';
	return undef;
    }
    my $bytesToReturn;    
    if ($start > 0) {           
	$bytesToReturn = $start > $bytes ? $bytes : $start;
    } else {    
	$bytesToReturn = $bytes - (length($self->{BOUNDARY})+1);
    }
    my $returnval=substr($self->{BUFFER},0,$bytesToReturn);
    substr($self->{BUFFER},0,$bytesToReturn)='';
    return ($start > 0) ? substr($returnval,0,-2) : $returnval;
}
END_OF_FUNC
'fillBuffer' => <<'END_OF_FUNC',
sub fillBuffer {
    my($self,$bytes) = @_;
    return unless $self->{LENGTH};
    my($boundaryLength) = length($self->{BOUNDARY});
    my($bufferLength) = length($self->{BUFFER});
    my($bytesToRead) = $bytes - $bufferLength + $boundaryLength + 2;
    $bytesToRead = $self->{LENGTH} if $self->{LENGTH} < $bytesToRead;
    my $bytesRead = $self->{INTERFACE}->read_from_client($self->{IN},
							 \$self->{BUFFER},
							 $bytesToRead,
							 $bufferLength);
    if ($bytesRead == 0) {
	die  "CGI.pm: Server closed socket during multipart read (client aborted?).\n"
	    if ($self->{ZERO_LOOP_COUNTER}++ >= $SPIN_LOOP_MAX);
    } else {
	$self->{ZERO_LOOP_COUNTER}=0;
    }
    $self->{LENGTH} -= $bytesRead;
}
END_OF_FUNC
'eof' => <<'END_OF_FUNC'
sub eof {
    my($self) = @_;
    return 1 if (length($self->{BUFFER}) == 0)
		 && ($self->{LENGTH} <= 0);
}
END_OF_FUNC
);
END_OF_AUTOLOAD
package TempFile;
$SL = $CGI::SL;
unless ($TMPDIRECTORY) {
    @TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp","${SL}tmp","${SL}temp","${SL}Temporary Items");
    foreach (@TEMP) {
	do {$TMPDIRECTORY = $_; last} if -d $_ && -w _;
    }
}
$TMPDIRECTORY  = "." unless $TMPDIRECTORY;
$SEQUENCE="CGItemp$$0000";
%OVERLOAD = ('""'=>'as_string');
*TempFile::AUTOLOAD = \&CGI::AUTOLOAD;
sub as_string {
    my($self) = @_;
    return $$self;
}
$AUTOLOADED_ROUTINES = '';      
$AUTOLOADED_ROUTINES=<<'END_OF_AUTOLOAD';
%SUBS = (
'new' => <<'END_OF_FUNC',
sub new {
    my($package) = @_;
    $SEQUENCE++;
    my $directory = "${TMPDIRECTORY}${SL}${SEQUENCE}";
    return bless \$directory;
}
END_OF_FUNC
'DESTROY' => <<'END_OF_FUNC'
sub DESTROY {
    my($self) = @_;
    unlink $$self;              
}
END_OF_FUNC
);
END_OF_AUTOLOAD
package CGI;
if ($^W) {
    $CGI::CGI = '';
    $CGI::CGI=<<EOF;
    $CGI::VERSION;
    $MultipartBuffer::SPIN_LOOP_MAX;
    $MultipartBuffer::CRLF;
    $MultipartBuffer::TIMEOUT;
    $MultipartBuffer::FILLUNIT;
    $TempFile::SEQUENCE;
EOF
    ;
}
$revision;