add CGI.pm v2.66 (from Lincoln Stein)

p4raw-id: //depot/perl@6029

11 files changed, 641 insertions, 416 deletions

diff --git a/MANIFEST b/MANIFEST
index 8d4a8d3fbd..72686196b7 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -568,6 +568,7 @@ lib/CGI/Fast.pm		Support for FastCGI (persistent server process)
 lib/CGI/Pretty.pm	Output nicely formatted HTML
 lib/CGI/Push.pm		Support for server push
 lib/CGI/Switch.pm	Simple interface for multiple server types
+lib/CGI/Util.pm		Utility functions
 lib/CPAN.pm		Interface to Comprehensive Perl Archive Network
 lib/CPAN/FirstTime.pm	Utility for creating CPAN config files
 lib/CPAN/Nox.pm		Runs CPAN while avoiding compiled extensions
@@ -1215,6 +1216,7 @@ t/lib/bigintpm.t	See if BigInt.pm works
 t/lib/cgi-form.t	See if CGI.pm works
 t/lib/cgi-function.t	See if CGI.pm works
 t/lib/cgi-html.t	See if CGI.pm works
+t/lib/cgi-pretty.t	See if CGI.pm works
 t/lib/cgi-request.t	See if CGI.pm works
 t/lib/charnames.t	See if character names work
 t/lib/checktree.t	See if File::CheckTree works
diff --git a/lib/CGI.pm b/lib/CGI.pm
index 3e032578b2..63805544f8 100644
--- a/lib/CGI.pm
+++ b/lib/CGI.pm
@@ -17,12 +17,13 @@ require 5.004;
 # The most recent version and complete docs are available at:
 #   http://stein.cshl.org/WWW/software/CGI/
 
-$CGI::revision = '$Id: CGI.pm,v 1.19 1999/08/31 17:04:37 lstein Exp $';
-$CGI::VERSION='2.56';
+$CGI::revision = '$Id: CGI.pm,v 1.30 2000/03/28 21:31:40 lstein Exp $';
+$CGI::VERSION='2.66';
 
 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
 # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
 # $TempFile::TMPDIRECTORY = '/usr/tmp';
+use CGI::Util qw(rearrange make_attributes unescape escape expires);
 
 # >>>>> Here are some globals that you might want to adjust <<<<<<
 sub initialize_globals {
@@ -31,24 +32,31 @@ sub initialize_globals {
 
     # Change this to the preferred DTD to print in start_html()
     # or use default_dtd('text of DTD to use');
-    $DEFAULT_DTD = '-//IETF//DTD HTML//EN';
+    $DEFAULT_DTD = [ '-//W3C//DTD HTML 4.01 Transitional//EN',
+		     'http://www.w3.org/TR/html4/loose.dtd' ] ;
+
+    # Set this to 1 to enable NOSTICKY scripts
+    # or: 
+    #    1) use CGI qw(-nosticky)
+    #    2) $CGI::nosticky(1)
+    $NOSTICKY = 0;
 
     # Set this to 1 to enable NPH scripts
     # or: 
     #    1) use CGI qw(-nph)
-    #    2) $CGI::nph(1)
+    #    2) CGI::nph(1)
     #    3) print header(-nph=>1)
     $NPH = 0;
 
-    # Set this to 1 to disable debugging from the
-    # command line
-    $NO_DEBUG = 0;
+    # Set this to 1 to enable debugging from @ARGV
+    # Set to 2 to enable debugging from STDIN
+    $DEBUG = 1;
 
     # Set this to 1 to make the temporary files created
     # during file uploads safe from prying eyes
     # or do...
     #    1) use CGI qw(:private_tempfiles)
-    #    2) $CGI::private_tempfiles(1);
+    #    2) CGI::private_tempfiles(1);
     $PRIVATE_TEMPFILES = 0;
 
     # Set this to a positive value to limit the size of a POSTing
@@ -65,7 +73,7 @@ sub initialize_globals {
     $HEADERS_ONCE = 0;
 
     # separate the name=value pairs by semicolons rather than ampersands
-    $USE_PARAM_SEMICOLONS = 0;
+    $USE_PARAM_SEMICOLONS = 1;
 
     # Other globals that you shouldn't worry about.
     undef $Q;
@@ -153,27 +161,6 @@ if ($OS eq 'VMS') {
   $CRLF = "\015\012";
 }
 
-if ($EBCDIC) {
-@A2E = (
-  0,  1,  2,  3, 55, 45, 46, 47, 22,  5, 21, 11, 12, 13, 14, 15,
- 16, 17, 18, 19, 60, 61, 50, 38, 24, 25, 63, 39, 28, 29, 30, 31,
- 64, 90,127,123, 91,108, 80,125, 77, 93, 92, 78,107, 96, 75, 97,
-240,241,242,243,244,245,246,247,248,249,122, 94, 76,126,110,111,
-124,193,194,195,196,197,198,199,200,201,209,210,211,212,213,214,
-215,216,217,226,227,228,229,230,231,232,233,173,224,189, 95,109,
-121,129,130,131,132,133,134,135,136,137,145,146,147,148,149,150,
-151,152,153,162,163,164,165,166,167,168,169,192, 79,208,161,  7,
- 32, 33, 34, 35, 36, 37,  6, 23, 40, 41, 42, 43, 44,  9, 10, 27,
- 48, 49, 26, 51, 52, 53, 54,  8, 56, 57, 58, 59,  4, 20, 62,255,
- 65,170, 74,177,159,178,106,181,187,180,154,138,176,202,175,188,
-144,143,234,250,190,160,182,179,157,218,155,139,183,184,185,171,
-100,101, 98,102, 99,103,158,104,116,113,114,115,120,117,118,119,
-172,105,237,238,235,239,236,191,128,253,254,251,252,186,174, 89,
- 68, 69, 66, 70, 67, 71,156, 72, 84, 81, 82, 83, 88, 85, 86, 87,
-140, 73,205,206,203,207,204,225,112,221,222,219,220,141,142,223
-      );
-}
-
 if ($needs_binmode) {
     $CGI::DefaultClass->binmode(main::STDOUT);
     $CGI::DefaultClass->binmode(main::STDIN);
@@ -184,7 +171,7 @@ if ($needs_binmode) {
 		':html2'=>['h1'..'h6',qw/p br hr ol ul li dl dt dd menu code var strong em
 			   tt u 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 comment/],
+			   input Select option comment charset escapeHTML/],
 		':html3'=>[qw/div table caption th td TR Tr sup Sub strike applet Param 
 			   embed basefont style span layer ilayer font frameset frame script small big/],
 		':netscape'=>[qw/blink fontsize center/],
@@ -195,7 +182,7 @@ if ($needs_binmode) {
 		':cgi'=>[qw/param upload path_info path_translated url self_url script_name cookie Dump
 			 raw_cookie request_method query_string Accept user_agent remote_host content_type
 			 remote_addr referer server_name server_software server_port server_protocol
-			 virtual_host remote_ident auth_type http use_named_parameters 
+			 virtual_host remote_ident auth_type http
 			 save_parameters restore_parameters param_fetch
 			 remote_user user_name header redirect import_names put 
 			 Delete Delete_all url_param cgi_error/],
@@ -259,9 +246,9 @@ sub new {
     my($class,$initializer) = @_;
     my $self = {};
     bless $self,ref $class || $class || $DefaultClass;
-    if ($MOD_PERL) {
-	Apache->request->register_cleanup(\&CGI::_reset_globals);
-	undef $NPH;
+    if ($MOD_PERL && defined Apache->request) {
+      Apache->request->register_cleanup(\&CGI::_reset_globals);
+      undef $NPH;
     }
     $self->_reset_globals if $PERLEX;
     $self->init($initializer);
@@ -291,10 +278,10 @@ sub param {
     # For compatibility between old calling style and use_named_parameters() style, 
     # we have to special case for a single parameter present.
     if (@p > 1) {
-	($name,$value,@other) = $self->rearrange([NAME,[DEFAULT,VALUE,VALUES]],@p);
+	($name,$value,@other) = rearrange([NAME,[DEFAULT,VALUE,VALUES]],@p);
 	my(@values);
 
-	if (substr($p[0],0,1) eq '-' || $self->use_named_parameters) {
+	if (substr($p[0],0,1) eq '-') {
 	    @values = defined($value) ? (ref($value) && ref($value) eq 'ARRAY' ? @{$value} : $value) : ();
 	} else {
 	    foreach ($value,@other) {
@@ -322,7 +309,7 @@ sub self_or_default {
 	$Q = $CGI::DefaultClass->new unless defined($Q);
 	unshift(@_,$Q);
     }
-    return @_;
+    return wantarray ? @_ : $Q;
 }
 
 sub self_or_CGI {
@@ -432,6 +419,7 @@ sub init {
 	      $query_string = Apache->request->args;
 	  } else {
 	      $query_string = $ENV{'QUERY_STRING'} if defined $ENV{'QUERY_STRING'};
+	      $query_string ||= $ENV{'REDIRECT_QUERY_STRING'} if defined $ENV{'REDIRECT_QUERY_STRING'};
 	  }
 	  last METHOD;
       }
@@ -450,13 +438,13 @@ sub init {
       # Check the command line and then the standard input for data.
       # We use the shellwords package in order to behave the way that
       # UN*X programmers expect.
-      $query_string = read_from_cmdline() unless $NO_DEBUG;
+      $query_string = read_from_cmdline() if $DEBUG;
   }
 
     # We now have the query string in hand.  We do slightly
     # different things for keyword lists and parameter lists.
     if (defined $query_string && $query_string) {
-	if ($query_string =~ /=/) {
+	if ($query_string =~ /[&=;]/) {
 	    $self->parse_params($query_string);
 	} else {
 	    $self->add_parameter('keywords');
@@ -479,6 +467,9 @@ sub init {
     # Clear out our default submission button flag if present
     $self->delete('.submit');
     $self->delete('.cgifields');
+
+    # set charset to the safe ISO-8859-1
+    $self->charset('ISO-8859-1');
     $self->save_request unless $initializer;
 }
 
@@ -518,29 +509,6 @@ sub cgi_error {
     return $self->{'.cgi_error'};
 }
 
-# unescape URL-encoded data
-sub unescape {
-  shift() if ref($_[0]) || (defined $_[1] && $_[0] eq $DefaultClass);
-  my $todecode = shift;
-  return undef unless defined($todecode);
-  $todecode =~ tr/+/ /;       # pluses become spaces
-    if ($EBCDIC) {
-      $todecode =~ s/%([0-9a-fA-F]{2})/pack("c",$A2E[hex($1)])/ge;
-    } else {
-      $todecode =~ s/%([0-9a-fA-F]{2})/pack("c",hex($1))/ge;
-    }
-  return $todecode;
-}
-
-# URL-encode data
-sub escape {
-  shift() if ref($_[0]) || (defined $_[1] && $_[0] eq $DefaultClass);
-  my $toencode = shift;
-  return undef unless defined($toencode);
-  $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
-  return $toencode;
-}
-
 sub save_request {
     my($self) = @_;
     # We're going to play with the package globals now so that if we get called
@@ -548,7 +516,8 @@ sub save_request {
     # us to have several of these objects.
     @QUERY_PARAM = $self->param; # save list of parameters
     foreach (@QUERY_PARAM) {
-	$QUERY_PARAM{$_}=$self->{$_};
+      next unless defined $_;
+      $QUERY_PARAM{$_}=$self->{$_};
     }
 }
 
@@ -558,6 +527,7 @@ sub parse_params {
     my($param,$value);
     foreach (@pairs) {
 	($param,$value) = split('=',$_,2);
+	$value = '' unless defined $value;
 	$param = unescape($param);
 	$value = unescape($value);
 	$self->add_parameter($param);
@@ -567,6 +537,7 @@ sub parse_params {
 
 sub add_parameter {
     my($self,$param)=@_;
+    return unless defined $param;
     push (@{$self->{'.parameters'}},$param) 
 	unless defined($self->{$param});
 }
@@ -586,16 +557,14 @@ sub binmode {
 sub _make_tag_func {
     my ($self,$tagname) = @_;
     my $func = qq(
-	sub $tagname { 
-	    shift if \$_[0] && 
-#		(!ref(\$_[0]) && \$_[0] eq \$CGI::DefaultClass) ||
-		    (ref(\$_[0]) &&
-		     (substr(ref(\$_[0]),0,3) eq 'CGI' ||
-		    UNIVERSAL::isa(\$_[0],'CGI')));
-	    
+	sub $tagname {
+            shift if \$_[0] && 
+                    (ref(\$_[0]) &&
+                     (substr(ref(\$_[0]),0,3) eq 'CGI' ||
+                    UNIVERSAL::isa(\$_[0],'CGI')));
 	    my(\$attr) = '';
 	    if (ref(\$_[0]) && ref(\$_[0]) eq 'HASH') {
-		my(\@attr) = make_attributes( '',shift() );
+		my(\@attr) = make_attributes(shift()||undef,1);
 		\$attr = " \@attr" if \@attr;
 	    }
 	);
@@ -607,7 +576,8 @@ sub _make_tag_func {
 	$func .= qq#
 	    my(\$tag,\$untag) = ("\U<$tagname\E\$attr>","\U</$tagname>\E");
 	    return \$tag unless \@_;
-	    my \@result = map { "\$tag\$_\$untag" } (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
+	    my \@result = map { "\$tag\$_\$untag" } 
+                              (ref(\$_[0]) eq 'ARRAY') ? \@{\$_[0]} : "\@_";
 	    return "\@result";
             }#;
     }
@@ -620,47 +590,6 @@ sub AUTOLOAD {
     goto &$func;
 }
 
-# PRIVATE SUBROUTINE
-# Smart rearrangement of parameters to allow named parameter
-# calling.  We do the rearangement if:
-# 1. The first parameter begins with a -
-# 2. The use_named_parameters() method returns true
-sub rearrange {
-    my($self,$order,@param) = @_;
-    return () unless @param;
-
-    if (ref($param[0]) eq 'HASH') {
-	@param = %{$param[0]};
-    } else {
-	return @param 
-	    unless (defined($param[0]) && substr($param[0],0,1) eq '-')
-		|| $self->use_named_parameters;
-    }
-
-    # map parameters into positional indices
-    my ($i,%pos);
-    $i = 0;
-    foreach (@$order) {
-	foreach (ref($_) eq 'ARRAY' ? @$_ : $_) { $pos{$_} = $i; }
-	$i++;
-    }
-
-    my (@result,%leftover);
-    $#result = $#$order;  # preextend
-    while (@param) {
-	my $key = uc(shift(@param));
-	$key =~ s/^\-//;
-	if (exists $pos{$key}) {
-	    $result[$pos{$key}] = shift(@param);
-	} else {
-	    $leftover{$key} = shift(@param);
-	}
-    }
-
-    push (@result,$self->make_attributes(\%leftover)) if %leftover;
-    @result;
-}
-
 sub _compile {
     my($func) = $AUTOLOAD;
     my($pack,$func_name);
@@ -711,8 +640,11 @@ sub _setup_symbols {
     foreach (@_) {
 	$HEADERS_ONCE++,         next if /^[:-]unique_headers$/;
 	$NPH++,                  next if /^[:-]nph$/;
-	$NO_DEBUG++,             next if /^[:-]no_?[Dd]ebug$/;
+	$NOSTICKY++,             next if /^[:-]nosticky$/;
+	$DEBUG=0,                next if /^[:-]no_?[Dd]ebug$/;
+	$DEBUG=2,                next if /^[:-][Dd]ebug$/;
 	$USE_PARAM_SEMICOLONS++, next if /^[:-]newstyle_urls$/;
+	$USE_PARAM_SEMICOLONS=0, next if /^[:-]oldstyle_urls$/;
 	$PRIVATE_TEMPFILES++,    next if /^[:-]private_tempfiles$/;
 	$EXPORT{$_}++,           next if /^[:-]any$/;
 	$compile++,              next if /^[:-]compile$/;
@@ -736,6 +668,12 @@ sub _setup_symbols {
     _compile_all(keys %EXPORT) if $compile;
 }
 
+sub charset {
+  my ($self,$charset) = self_or_default(@_);
+  $self->{'.charset'} = $charset if defined $charset;
+  $self->{'.charset'};
+}
+
 ###############################################################################
 ################# THESE FUNCTIONS ARE AUTOLOADED ON DEMAND ####################
 ###############################################################################
@@ -756,21 +694,6 @@ END_OF_FUNC
 sub SERVER_PUSH { 'multipart/x-mixed-replace; boundary="' . shift() . '"'; }
 END_OF_FUNC
 
-'use_named_parameters' => <<'END_OF_FUNC',
-#### Method: use_named_parameters
-# Force CGI.pm to use named parameter-style method calls
-# rather than positional parameters.  The same effect
-# will happen automatically if the first parameter
-# begins with a -.
-sub use_named_parameters {
-    my($self,$use_named) = self_or_default(@_);
-    return $self->{'.named'} unless defined ($use_named);
-
-    # stupidity to avoid annoying warnings
-    return $self->{'.named'}=$use_named;
-}
-END_OF_FUNC
-
 'new_MultipartBuffer' => <<'END_OF_FUNC',
 # Create a new multipart buffer
 sub new_MultipartBuffer {
@@ -920,13 +843,16 @@ END_OF_FUNC
 'TIEHASH' => <<'END_OF_FUNC',
 sub TIEHASH { 
     return $_[1] if defined $_[1];
-    return $Q || new shift;
+    return $Q ||= new shift;
 }
 END_OF_FUNC
 
 'STORE' => <<'END_OF_FUNC',
 sub STORE {
-    $_[0]->param($_[1],split("\0",$_[2]));
+    my $self = shift;
+    my $tag  = shift;
+    my @vals = split("\0",shift);
+    $self->param(-name=>$tag,-value=>\@vals);
 }
 END_OF_FUNC
 
@@ -976,7 +902,7 @@ END_OF_FUNC
 'append' => <<'EOF',
 sub append {
     my($self,@p) = @_;
-    my($name,$value) = $self->rearrange([NAME,[VALUE,VALUES]],@p);
+    my($name,$value) = rearrange([NAME,[VALUE,VALUES]],@p);
     my(@values) = defined($value) ? (ref($value) ? @{$value} : $value) : ();
     if (@values) {
 	$self->add_parameter($name);
@@ -1030,21 +956,6 @@ sub 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/^\-//;     # get rid of initial - if present
-	$key=~tr/a-z_/A-Z-/; # parameters are upper case, use dashes
-	push(@att,defined($attr->{$_}) ? qq/$key="$attr->{$_}"/ : qq/$key/);
-    }
-    return @att;
-}
-END_OF_FUNC
-
 #### Method: url_param
 # Return a parameter in the QUERY_STRING, regardless of
 # whether this was a POST or a GET
@@ -1076,13 +987,13 @@ sub url_param {
 }
 END_OF_FUNC
 
-#### Method: dump
+#### Method: Dump
 # Returns a string in which all the known parameter/value 
 # pairs are represented as nested lists, mainly for the purposes 
 # of debugging.
 ####
-'dump' => <<'END_OF_FUNC',
-sub dump {
+'Dump' => <<'END_OF_FUNC',
+sub Dump {
     my($self) = self_or_default(@_);
     my($param,$value,@result);
     return '<UL></UL>' unless $self->param;
@@ -1109,7 +1020,7 @@ END_OF_FUNC
 ####
 'as_string' => <<'END_OF_FUNC',
 sub as_string {
-    &dump(@_);
+    &Dump(@_);
 }
 END_OF_FUNC
 
@@ -1167,7 +1078,7 @@ END_OF_FUNC
 'multipart_init' => <<'END_OF_FUNC',
 sub multipart_init {
     my($self,@p) = self_or_default(@_);
-    my($boundary,@other) = $self->rearrange([BOUNDARY],@p);
+    my($boundary,@other) = rearrange([BOUNDARY],@p);
     $boundary = $boundary || '------- =_aaaaaaaaaa0';
     $self->{'separator'} = "\n--$boundary\n";
     $type = SERVER_PUSH($boundary);
@@ -1189,7 +1100,7 @@ END_OF_FUNC
 'multipart_start' => <<'END_OF_FUNC',
 sub multipart_start {
     my($self,@p) = self_or_default(@_);
-    my($type,@other) = $self->rearrange([TYPE],@p);
+    my($type,@other) = rearrange([TYPE],@p);
     $type = $type || 'text/html';
     return $self->header(
 	-type => $type,
@@ -1224,11 +1135,18 @@ sub header {
 
     return undef if $self->{'.header_printed'}++ and $HEADERS_ONCE;
 
-    my($type,$status,$cookie,$target,$expires,$nph,@other) = 
-	$self->rearrange([['TYPE','CONTENT_TYPE','CONTENT-TYPE'],
-			  STATUS,[COOKIE,COOKIES],TARGET,EXPIRES,NPH],@p);
+    my($type,$status,$cookie,$target,$expires,$nph,$charset,@other) = 
+	rearrange([['TYPE','CONTENT_TYPE','CONTENT-TYPE'],
+			    'STATUS',['COOKIE','COOKIES'],'TARGET',
+                            'EXPIRES','NPH','CHARSET'],@p);
+
+    $nph     ||= $NPH;
+    if (defined $charset) {
+      $self->charset($charset);
+    } else {
+      $charset = $self->charset;
+    }
 
-    $nph ||= $NPH;
     # rearrange() was designed for the HTML portion, so we
     # need to fix it up a little.
     foreach (@other) {
@@ -1237,6 +1155,7 @@ sub header {
     }
 
     $type ||= 'text/html' unless defined($type);
+    $type .= "; charset=$charset" if $type ne '' and $type !~ /\bcharset\b/;
 
     # Maybe future compatibility.  Maybe not.
     my $protocol = $ENV{SERVER_PROTOCOL} || 'HTTP/1.0';
@@ -1296,7 +1215,7 @@ END_OF_FUNC
 'redirect' => <<'END_OF_FUNC',
 sub redirect {
     my($self,@p) = self_or_default(@_);
-    my($url,$target,$cookie,$nph,@other) = $self->rearrange([[LOCATION,URI,URL],TARGET,COOKIE,NPH],@p);
+    my($url,$target,$cookie,$nph,@other) = rearrange([[LOCATION,URI,URL],TARGET,COOKIE,NPH],@p);
     $url = $url || $self->self_url;
     my(@o);
     foreach (@other) { tr/\"//d; push(@o,split("=",$_,2)); }
@@ -1335,15 +1254,27 @@ END_OF_FUNC
 sub start_html {
     my($self,@p) = &self_or_default(@_);
     my($title,$author,$base,$xbase,$script,$noscript,$target,$meta,$head,$style,$dtd,@other) = 
-	$self->rearrange([TITLE,AUTHOR,BASE,XBASE,SCRIPT,NOSCRIPT,TARGET,META,HEAD,STYLE,DTD],@p);
+	rearrange([TITLE,AUTHOR,BASE,XBASE,SCRIPT,NOSCRIPT,TARGET,META,HEAD,STYLE,DTD],@p);
 
     # strangely enough, the title needs to be escaped as HTML
     # while the author needs to be escaped as a URL
     $title = $self->escapeHTML($title || 'Untitled Document');
     $author = $self->escape($author);
     my(@result);
-    $dtd = $DEFAULT_DTD unless $dtd && $dtd =~ m|^-//|;
-    push(@result,qq(<!DOCTYPE HTML PUBLIC "$dtd">)) if $dtd;
+    if ($dtd) {
+        if (ref $dtd && $ref eq 'ARRAY') {
+            $dtd = $DEFAULT_DTD unless $dtd->[0] =~ m|^-//|;
+        } else {
+            $dtd = $DEFAULT_DTD unless $dtd =~ m|^-//|;
+        }
+    } else {
+        $dtd = $DEFAULT_DTD;
+    }
+    if (ref($dtd) && ref($dtd) eq 'ARRAY') {
+        push(@result,qq(<!DOCTYPE HTML PUBLIC "$dtd->[0]"\n\t"$dtd->[1]">));
+    } else {
+        push(@result,qq(<!DOCTYPE HTML PUBLIC "$dtd">));
+    }
     push(@result,"<HTML><HEAD><TITLE>$title</TITLE>");
     push(@result,"<LINK REV=MADE HREF=\"mailto:$author\">") if defined $author;
 
@@ -1386,7 +1317,7 @@ sub _style {
     my $type = 'text/css';
     if (ref($style)) {
 	my($src,$code,$stype,@other) =
-	    $self->rearrange([SRC,CODE,TYPE],
+	    rearrange([SRC,CODE,TYPE],
 			     '-foo'=>'bar',	# a trick to allow the '-' to be omitted
 			     ref($style) eq 'ARRAY' ? @$style : %$style);
 	$type = $stype if $stype;
@@ -1408,21 +1339,32 @@ sub _script {
     foreach $script (@scripts) {
 	my($src,$code,$language);
 	if (ref($script)) { # script is a hash
-	    ($src,$code,$language) =
-		$self->rearrange([SRC,CODE,LANGUAGE],
+	    ($src,$code,$language, $type) =
+		rearrange([SRC,CODE,LANGUAGE,TYPE],
 				 '-foo'=>'bar',	# a trick to allow the '-' to be omitted
 				 ref($script) eq 'ARRAY' ? @$script : %$script);
-	    
+            # User may not have specified language
+            $language ||= 'JavaScript';
+            unless (defined $type) {
+                $type = lc $language;
+                # strip '1.2' from 'javascript1.2'
+                $type =~ s/^(\D+).*$/text\/$1/;
+            }
 	} else {
-	    ($src,$code,$language) = ('',$script,'JavaScript');
+	    ($src,$code,$language, $type) = ('',$script,'JavaScript', 'text/javascript');
 	}
 	my(@satts);
 	push(@satts,'src'=>$src) if $src;
-	push(@satts,'language'=>$language || 'JavaScript');
+	push(@satts,'language'=>$language);
+        push(@satts,'type'=>$type);
 	$code = "<!-- Hide script\n$code\n// End script hiding -->"
-	    if $code && $language=~/javascript/i;
+	    if $code && $type=~/javascript/i;
+	$code = "<!-- Hide script\n$code\n\# End script hiding -->"
+	    if $code && $type=~/perl/i;
 	$code = "<!-- Hide script\n$code\n\# End script hiding -->"
-	    if $code && $language=~/perl/i;
+	    if $code && $type=~/tcl/i;
+        $code = "<!-- Hide script\n$code\n' End script hiding -->"
+            if $code && $type=~/vbscript/i;
 	push(@result,script({@satts},$code || ''));
     }
     @result;
@@ -1453,7 +1395,7 @@ END_OF_FUNC
 'isindex' => <<'END_OF_FUNC',
 sub isindex {
     my($self,@p) = self_or_default(@_);
-    my($action,@other) = $self->rearrange([ACTION],@p);
+    my($action,@other) = rearrange([ACTION],@p);
     $action = qq/ACTION="$action"/ if $action;
     my($other) = @other ? " @other" : '';
     return "<ISINDEX $action$other>";
@@ -1472,7 +1414,7 @@ sub startform {
     my($self,@p) = self_or_default(@_);
 
     my($method,$action,$enctype,@other) = 
-	$self->rearrange([METHOD,ACTION,ENCTYPE],@p);
+	rearrange([METHOD,ACTION,ENCTYPE],@p);
 
     $method = $method || 'POST';
     $enctype = $enctype || &URL_ENCODED;
@@ -1504,14 +1446,13 @@ 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 '-')) {
+    if (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);
+	    rearrange([METHOD,ACTION],@p);
 	return $self->startform($method,$action,&MULTIPART,@other);
     }
 }
@@ -1523,8 +1464,12 @@ END_OF_FUNC
 'endform' => <<'END_OF_FUNC',
 sub endform {
     my($self,@p) = self_or_default(@_);    
+    if ( $NOSTICKY ) {
+    return wantarray ? ("</FORM>") : "\n</FORM>";
+    } else {
     return wantarray ? ($self->get_fields,"</FORM>") : 
                         $self->get_fields ."\n</FORM>";
+    }
 }
 END_OF_FUNC
 
@@ -1542,7 +1487,7 @@ END_OF_FUNC
 sub _textfield {
     my($self,$tag,@p) = self_or_default(@_);
     my($name,$default,$size,$maxlength,$override,@other) = 
-	$self->rearrange([NAME,[DEFAULT,VALUE],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p);
+	rearrange([NAME,[DEFAULT,VALUE],SIZE,MAXLENGTH,[OVERRIDE,FORCE]],@p);
 
     my $current = $override ? $default : 
 	(defined($self->param($name)) ? $self->param($name) : $default);
@@ -1626,7 +1571,7 @@ 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);
+	rearrange([NAME,[DEFAULT,VALUE],ROWS,[COLS,COLUMNS],[OVERRIDE,FORCE]],@p);
 
     my($current)= $override ? $default :
 	(defined($self->param($name)) ? $self->param($name) : $default);
@@ -1655,7 +1600,7 @@ END_OF_FUNC
 sub button {
     my($self,@p) = self_or_default(@_);
 
-    my($label,$value,$script,@other) = $self->rearrange([NAME,[VALUE,LABEL],
+    my($label,$value,$script,@other) = rearrange([NAME,[VALUE,LABEL],
 							 [ONCLICK,SCRIPT]],@p);
 
     $label=$self->escapeHTML($label);
@@ -1687,12 +1632,12 @@ END_OF_FUNC
 sub submit {
     my($self,@p) = self_or_default(@_);
 
-    my($label,$value,@other) = $self->rearrange([NAME,[VALUE,LABEL]],@p);
+    my($label,$value,@other) = rearrange([NAME,[VALUE,LABEL]],@p);
 
     $label=$self->escapeHTML($label);
     $value=$self->escapeHTML($value);
 
-    my($name) = ' NAME=".submit"';
+    my($name) = ' NAME=".submit"' unless $NOSTICKY;
     $name = qq/ NAME="$label"/ if defined($label);
     $value = defined($value) ? $value : $label;
     my($val) = '';
@@ -1713,7 +1658,7 @@ END_OF_FUNC
 'reset' => <<'END_OF_FUNC',
 sub reset {
     my($self,@p) = self_or_default(@_);
-    my($label,@other) = $self->rearrange([NAME],@p);
+    my($label,@other) = rearrange([NAME],@p);
     $label=$self->escapeHTML($label);
     my($value) = defined($label) ? qq/ VALUE="$label"/ : '';
     my($other) = @other ? " @other" : '';
@@ -1737,7 +1682,7 @@ END_OF_FUNC
 sub defaults {
     my($self,@p) = self_or_default(@_);
 
-    my($label,@other) = $self->rearrange([[NAME,VALUE]],@p);
+    my($label,@other) = rearrange([[NAME,VALUE]],@p);
 
     $label=$self->escapeHTML($label);
     $label = $label || "Defaults";
@@ -1775,7 +1720,7 @@ 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);
+	rearrange([NAME,[CHECKED,SELECTED,ON],VALUE,LABEL,[OVERRIDE,FORCE]],@p);
     
     $value = defined $value ? $value : 'on';
 
@@ -1823,7 +1768,7 @@ sub checkbox_group {
 
     my($name,$values,$defaults,$linebreak,$labels,$rows,$columns,
        $rowheaders,$colheaders,$override,$nolabels,@other) =
-	$self->rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT],
+	rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT],
 			  LINEBREAK,LABELS,ROWS,[COLUMNS,COLS],
 			  ROWHEADERS,COLHEADERS,
 			  [OVERRIDE,FORCE],NOLABELS],@p);
@@ -1865,11 +1810,20 @@ sub escapeHTML {
     my ($self,$toencode) = self_or_default(@_);
     return undef unless defined($toencode);
     return $toencode if ref($self) && $self->{'dontescape'};
-
-    $toencode=~s/&/&amp;/g;
-    $toencode=~s/\"/&quot;/g;
-    $toencode=~s/>/&gt;/g;
-    $toencode=~s/</&lt;/g;
+    if (uc $self->{'.charset'} eq 'ISO-8859-1') {
+       # fix non-compliant bug in IE and Netscape
+       $toencode =~ s{(.)}{
+              if    ($1 eq '<')                            { '&lt;'    }
+              elsif ($1 eq '>')                            { '&gt;'    }
+              elsif ($1 eq '&')                            { '&amp;'   }
+              elsif ($1 eq '"')                            { '&quot;'  }
+              elsif ($1 eq "\x8b")                         { '&#139;'  }
+              elsif ($1 eq "\x9b")                         { '&#155;'  }
+              else                                         { $1        }
+       }gsex;
+     } else {
+        $toencode =~ s/(.)/'&#'.ord($1).';'/gsex;
+     }
     return $toencode;
 }
 END_OF_FUNC
@@ -1911,7 +1865,7 @@ sub _tableize {
     $result = "<TABLE>";
     my($row,$column);
     unshift(@$colheaders,'') if @$colheaders && @$rowheaders;
-    $result .= "<TR>" if @$colheaders;
+    $result .= "<TR>" if @{$colheaders};
     foreach (@{$colheaders}) {
 	$result .= "<TH>$_</TH>";
     }
@@ -1953,7 +1907,7 @@ sub radio_group {
 
     my($name,$values,$default,$linebreak,$labels,
        $rows,$columns,$rowheaders,$colheaders,$override,$nolabels,@other) =
-	$self->rearrange([NAME,[VALUES,VALUE],DEFAULT,LINEBREAK,LABELS,
+	rearrange([NAME,[VALUES,VALUE],DEFAULT,LINEBREAK,LABELS,
 			  ROWS,[COLUMNS,COLS],
 			  ROWHEADERS,COLHEADERS,
 			  [OVERRIDE,FORCE],NOLABELS],@p);
@@ -2011,7 +1965,7 @@ 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);
+	rearrange([NAME,[VALUES,VALUE],[DEFAULT,DEFAULTS],LABELS,[OVERRIDE,FORCE]],@p);
     my($result,$selected);
 
     if (!$override && defined($self->param($name))) {
@@ -2065,7 +2019,7 @@ 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],
+	= rearrange([NAME,[VALUES,VALUE],[DEFAULTS,DEFAULT],
 			    SIZE,MULTIPLE,LABELS,[OVERRIDE,FORCE]],@p);
 
     my($result,@values);
@@ -2086,7 +2040,7 @@ sub scrolling_list {
 	$label = $labels->{$_} if defined($labels) && defined($labels->{$_});
 	$label=$self->escapeHTML($label);
 	my($value)=$self->escapeHTML($_);
-	$result .= "<OPTION $selectit VALUE=\"$value\">$label\n";
+	$result .= "<OPTION $selectit VALUE=\"$value\">$label</OPTION>\n";
     }
     $result .= "</SELECT>\n";
     $self->register_parameter($name);
@@ -2112,10 +2066,10 @@ sub hidden {
     # calling scheme, so we have to special-case (darn)
     my(@result,@value);
     my($name,$default,$override,@other) = 
-	$self->rearrange([NAME,[DEFAULT,VALUE,VALUES],[OVERRIDE,FORCE]],@p);
+	rearrange([NAME,[DEFAULT,VALUE,VALUES],[OVERRIDE,FORCE]],@p);
 
     my $do_override = 0;
-    if ( ref($p[0]) || substr($p[0],0,1) eq '-' || $self->use_named_parameters ) {
+    if ( ref($p[0]) || substr($p[0],0,1) eq '-') {
 	@value = ref($default) ? @{$default} : $default;
 	$do_override = $override;
     } else {
@@ -2151,7 +2105,7 @@ sub image_button {
     my($self,@p) = self_or_default(@_);
 
     my($name,$src,$alignment,@other) =
-	$self->rearrange([NAME,SRC,ALIGN],@p);
+	rearrange([NAME,SRC,ALIGN],@p);
 
     my($align) = $alignment ? " ALIGN=\U$alignment" : '';
     my($other) = @other ? " @other" : '';
@@ -2192,7 +2146,7 @@ END_OF_FUNC
 sub url {
     my($self,@p) = self_or_default(@_);
     my ($relative,$absolute,$full,$path_info,$query) = 
-	$self->rearrange(['RELATIVE','ABSOLUTE','FULL',['PATH','PATH_INFO'],['QUERY','QUERY_STRING']],@p);
+	rearrange(['RELATIVE','ABSOLUTE','FULL',['PATH','PATH_INFO'],['QUERY','QUERY_STRING']],@p);
     my $url;
     $full++ if !($relative || $absolute);
 
@@ -2204,8 +2158,10 @@ sub url {
         # strip query string
         substr($script_name,$index) = '' if ($index = index($script_name,'?')) >= 0;
         # and path
-        substr($script_name,$index) = '' if exists($ENV{PATH_INFO})
-                                     and ($index = rindex($script_name,$ENV{PATH_INFO})) >= 0;
+        if (exists($ENV{PATH_INFO})) {
+           my $decoded_path = unescape($ENV{PATH_INFO});
+           substr($script_name,$index) = '' if ($index = rindex($script_name,$decoded_path)) >= 0;
+         }
     } else {
 	$script_name = $self->script_name;
     }
@@ -2231,6 +2187,8 @@ sub url {
     }
     $url .= $path if $path_info and defined $path;
     $url .= "?" . $self->query_string if $query and $self->query_string;
+    $url = '' unless defined $url;
+    $url =~ s/([^a-zA-Z0-9_.%;&?\/\\:+=~-])/uc sprintf("%%%02x",ord($1))/eg;
     return $url;
 }
 
@@ -2252,7 +2210,7 @@ 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);
+	rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@p);
 
     require CGI::Cookie;
 
@@ -2285,69 +2243,6 @@ sub cookie {
 }
 END_OF_FUNC
 
-# This internal routine creates an expires time exactly some number of
-# hours from the current time.  It incorporates modifications from 
-# Mark Fisher.
-'expire_calc' => <<'END_OF_FUNC',
-sub expire_calc {
-    my($time) = @_;
-    my(%mult) = ('s'=>1,
-                 'm'=>60,
-                 'h'=>60*60,
-                 'd'=>60*60*24,
-                 'M'=>60*60*24*30,
-                 'y'=>60*60*24*365);
-    # format for time can be in any of the forms...
-    # "now" -- expire immediately
-    # "+180s" -- in 180 seconds
-    # "+2m" -- in 2 minutes
-    # "+12h" -- in 12 hours
-    # "+1d"  -- in 1 day
-    # "+3M"  -- in 3 months
-    # "+2y"  -- in 2 years
-    # "-3m"  -- 3 minutes ago(!)
-    # If you don't supply one of these forms, we assume you are
-    # specifying the date yourself
-    my($offset);
-    if (!$time || (lc($time) eq 'now')) {
-        $offset = 0;
-    } elsif ($time=~/^\d+/) {
-        return $time;
-    } elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([mhdMy]?)/) {
-        $offset = ($mult{$2} || 1)*$1;
-    } else {
-        return $time;
-    }
-    return (time+$offset);
-}
-END_OF_FUNC
-
-# This internal routine creates date strings suitable for use in
-# cookies and HTTP headers.  (They differ, unfortunately.)
-# Thanks to Mark Fisher for this.
-'expires' => <<'END_OF_FUNC',
-sub expires {
-    my($time,$format) = @_;
-    $format ||= 'http';
-
-    my(@MON)=qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
-    my(@WDAY) = qw/Sun Mon Tue Wed Thu Fri Sat/;
-
-    # pass through preformatted dates for the sake of expire_calc()
-    $time = expire_calc($time);
-    return $time unless $time =~ /^\d+$/;
-
-    # make HTTP/cookie date string from GMT'ed time
-    # (cookies use '-' as date separator, HTTP uses ' ')
-    my($sc) = ' ';
-    $sc = '-' if $format eq "cookie";
-    my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time);
-    $year += 1900;
-    return sprintf("%s, %02d$sc%s$sc%04d %02d:%02d:%02d GMT",
-                   $WDAY[$wday],$mday,$MON[$mon],$year,$hour,$min,$sec);
-}
-END_OF_FUNC
-
 'parse_keywordlist' => <<'END_OF_FUNC',
 sub parse_keywordlist {
     my($self,$tosplit) = @_;
@@ -2361,7 +2256,7 @@ END_OF_FUNC
 'param_fetch' => <<'END_OF_FUNC',
 sub param_fetch {
     my($self,@p) = self_or_default(@_);
-    my($name) = $self->rearrange([NAME],@p);
+    my($name) = rearrange([NAME],@p);
     unless (exists($self->{$name})) {
 	$self->add_parameter($name);
 	$self->{$name} = [];
@@ -2730,6 +2625,17 @@ sub user_name {
 }
 END_OF_FUNC
 
+#### Method: nosticky
+# Set or return the NOSTICKY global flag
+####
+'nosticky' => <<'END_OF_FUNC',
+sub nosticky {
+    my ($self,$param) = self_or_CGI(@_);
+    $CGI::NOSTICKY = $param if defined($param);
+    return $CGI::NOSTICKY;
+}
+END_OF_FUNC
+
 #### Method: nph
 # Set or return the NPH global flag
 ####
@@ -2757,8 +2663,12 @@ END_OF_FUNC
 ####
 'default_dtd' => <<'END_OF_FUNC',
 sub default_dtd {
-    my ($self,$param) = self_or_CGI(@_);
-    $CGI::DEFAULT_DTD = $param if defined($param);
+    my ($self,$param,$param2) = self_or_CGI(@_);
+    if (defined $param2 && defined $param) {
+        $CGI::DEFAULT_DTD = [ $param, $param2 ];
+    } elsif (defined $param) {
+        $CGI::DEFAULT_DTD = $param;
+    }
     return $CGI::DEFAULT_DTD;
 }
 END_OF_FUNC
@@ -2803,9 +2713,9 @@ END_OF_FUNC
 sub read_from_cmdline {
     my($input,@words);
     my($query_string);
-    if (@ARGV) {
+    if ($DEBUG && @ARGV) {
 	@words = @ARGV;
-    } else {
+    } elsif ($DEBUG > 1) {
 	require "shellwords.pl";
 	print STDERR "(offline mode: enter name=value pairs on standard input)\n";
 	chomp(@lines = <STDIN>); # remove newlines
@@ -3010,7 +2920,9 @@ END_OF_FUNC
 sub new {
     my($pack,$name,$file,$delete) = @_;
     require Fcntl unless defined &Fcntl::O_RDWR;
-    my $ref = \*{'Fh::' .  ++$FH . quotemeta($name)};
+    my $fv = ('Fh::' .  ++$FH . quotemeta($name));
+    warn unless *{$fv};
+    my $ref = \*{$fv};
     sysopen($ref,$file,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL(),0600) || return;
     unlink($file) if $delete;
     CORE::delete $Fh::{$FH};
@@ -3073,6 +2985,7 @@ sub new {
 
     # Netscape seems to be a little bit unreliable
     # about providing boundary strings.
+    my $boundary_read = 0;
     if ($boundary) {
 
 	# Under the MIME spec, the boundary consists of the 
@@ -3089,6 +3002,7 @@ sub new {
 	$length -= length($boundary);
 	chomp($boundary);               # remove the CRLF
 	$/ = $old;                      # restore old line separator
+        $boundary_read++;
     }
 
     my $self = {LENGTH=>$length,
@@ -3104,7 +3018,9 @@ sub new {
     my $retval = bless $self,ref $package || $package;
 
     # Read the preamble and the topmost (boundary) line plus the CRLF.
-    while ($self->read(0)) { }
+    unless ($boundary_read) {
+      while ($self->read(0)) { }
+    }
     die "Malformed multipart POST\n" if $self->eof;
 
     return $retval;
@@ -3118,9 +3034,7 @@ sub readHeader {
     my($ok) = 0;
     my($bad) = 0;
 
-    if ($CGI::OS eq 'VMS') {  # tssk, tssk: inconsistency alert!
-	local($CRLF) = "\015\012";
-    }
+    local($CRLF) = "\015\012" if $CGI::OS eq 'VMS';
 
     do {
 	$self->fillBuffer($FILLUNIT);
@@ -3280,17 +3194,18 @@ my ($vol) = $MAC ? MacPerl::Volumes() =~ /:(.*)/ : "";
 unless ($TMPDIRECTORY) {
     @TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp",
 	   "C:${SL}temp","${SL}tmp","${SL}temp",
-	   "${vol}${SL}Temporary Items","${SL}sys\$scratch",
-	   "${SL}WWW_ROOT");
+	   "${vol}${SL}Temporary Items",
+           "${SL}WWW_ROOT", "${SL}SYS\$SCRATCH");
     unshift(@TEMP,$ENV{'TMPDIR'}) if exists $ENV{'TMPDIR'};
 
-    #
+    # this feature was supposed to provide per-user tmpfiles, but
+    # it is problematic.
     #    unshift(@TEMP,(getpwuid($<))[7].'/tmp') if $CGI::OS eq 'UNIX';
     # Rob: getpwuid() is unfortunately UNIX specific. On brain dead OS'es this
     #    : can generate a 'getpwuid() not implemented' exception, even though
     #    : it's never called.  Found under DOS/Win with the DJGPP perl port.
     #    : Refer to getpwuid() only at run-time if we're fortunate and have  UNIX.
-    unshift(@TEMP,(eval {(getpwuid($<))[7]}).'/tmp') if $CGI::OS eq 'UNIX';
+    # unshift(@TEMP,(eval {(getpwuid($>))[7]}).'/tmp') if $CGI::OS eq 'UNIX' and $> != 0;
 
     foreach (@TEMP) {
 	do {$TMPDIRECTORY = $_; last} if -d $_ && -w _;
@@ -3319,7 +3234,7 @@ sub new {
 	last if ! -f ($filename = sprintf("${TMPDIRECTORY}${SL}CGItemp%d",$sequence++));
     }
     # untaint the darn thing
-    return unless $filename =~ m!^([a-zA-Z0-9_ '":/\\]+)$!;
+    return unless $filename =~ m!^([a-zA-Z0-9_ '":/.\$\\]+)$!;
     $filename = $1;
     return bless \$filename;
 }
@@ -3479,17 +3394,6 @@ acceptable.  In fact, only the first argument needs to begin with a
 dash.  If a dash is present in the first argument, CGI.pm assumes
 dashes for the subsequent ones.
 
-You don't have to use the hyphen at all if you don't want to.  After
-creating a CGI object, call the B<use_named_parameters()> method with
-a nonzero value.  This will tell CGI.pm that you intend to use named
-parameters exclusively:
-
-   $query = new CGI;
-   $query->use_named_parameters(1);
-   $field = $query->radio_group('name'=>'OS',
-				'values'=>['Unix','Windows','Macintosh'],
-				'default'=>'Unix');
-
 Several routines are commonly called with just one argument.  In the
 case of these routines you can provide the single argument without an
 argument name.  header() happens to be one of these routines.  In this
@@ -3506,7 +3410,7 @@ For example, the param() routine is used to set a CGI parameter to a
 single or a multi-valued value.  The two cases are shown below:
 
    $q->param(-name=>'veggie',-value=>'tomato');
-   $q->param(-name=>'veggie',-value=>'[tomato','tomahto','potato','potahto']);
+   $q->param(-name=>'veggie',-value=>['tomato','tomahto','potato','potahto']);
 
 A large number of routines in CGI.pm actually aren't specifically
 defined in the module, but are generated automatically as needed.
@@ -3655,10 +3559,11 @@ parsed keywords can be obtained as an array using the keywords() method.
      @names = $query->param
 
 If the script was invoked with a parameter list
-(e.g. "name1=value1&name2=value2&name3=value3"), the param()
-method will return the parameter names as a list.  If the
-script was invoked as an <ISINDEX> script, there will be a
-single parameter named 'keywords'.
+(e.g. "name1=value1&name2=value2&name3=value3"), the param() method
+will return the parameter names as a list.  If the script was invoked
+as an <ISINDEX> script and contains a string without ampersands
+(e.g. "value1+value2+value3") , there will be a single parameter named
+"keywords" containing the "+"-delimited keywords.
 
 NOTE: As of version 1.5, the array of parameter names returned will
 be in the same order as they were submitted by the browser.
@@ -3679,6 +3584,10 @@ named parameter. If the parameter is multivalued (e.g. from multiple
 selections in a scrolling list), you can ask to receive an array.  Otherwise
 the method will return a single value.
 
+If a value is not given in the query string, as in the queries
+"name1=&name2=" or "name1&name2", it will be returned as an empty
+string.  This feature is new in 2.63.
+
 =head2 SETTING THE VALUE(S) OF A NAMED PARAMETER:
 
     $query->param('foo','an','array','of','values');
@@ -3982,10 +3891,10 @@ you can import.  Pragmas, which are always preceded by a hyphen,
 change the way that CGI.pm functions in various ways.  Pragmas,
 function sets, and individual functions can all be imported in the
 same use() line.  For example, the following use statement imports the
-standard set of functions and disables debugging mode (pragma
--no_debug):
+standard set of functions and enables debugging mode (pragma
+-debug):
 
-   use CGI qw/:standard -no_debug/;
+   use CGI qw/:standard -debug/;
 
 The current list of pragmas is as follows:
 
@@ -4025,6 +3934,14 @@ the effect of importing the compiled functions into the current
 namespace.  If you want to compile without importing use the
 compile() method instead (see below).
 
+=item -nosticky
+
+This makes CGI.pm not generating the hidden fields .submit
+and .cgifields. It is very useful if you don't want to
+have the hidden fields appear in the querystring in a GET method.
+For example, a search script generated this way will have
+a very nice url with search parameters for bookmarking.
+
 =item -nph
 
 This makes CGI.pm produce a header appropriate for an NPH (no
@@ -4043,6 +3960,13 @@ Semicolon-delimited query strings are always accepted, but will not be
 emitted by self_url() and query_string() unless the -newstyle_urls
 pragma is specified.
 
+This became the default in version 2.64.
+
+=item -oldstyle_urls
+
+Separate the name=value pairs in CGI parameter query strings with
+ampersands rather than semicolons.  This is no longer the default.
+
 =item -autoload
 
 This overrides the autoloader so that any function in your program
@@ -4059,16 +3983,17 @@ to the top of your script.
 
 This turns off the command-line processing features.  If you want to
 run a CGI.pm script from the command line to produce HTML, and you
-don't want it pausing to request CGI parameters from standard input or
-the command line, then use this pragma:
+don't want it to read CGI parameters from the command line or STDIN,
+then use this pragma:
 
    use CGI qw(-no_debug :standard);
 
-If you'd like to process the command-line parameters but not standard
-input, this should work:
+=item -debug
 
-   use CGI qw(-no_debug :standard);
-   restore_parameters(join('&',@ARGV));
+This turns on full debugging.  In addition to reading CGI arguments
+from the command-line processing, CGI.pm will pause and try to read
+arguments from STDIN, producing the message "(offline mode: enter
+name=value pairs on standard input)" features.
 
 See the section on debugging for more details.
 
@@ -4188,6 +4113,7 @@ pages.
 			     -status=>'402 Payment required',
 			     -expires=>'+3d',
 			     -cookie=>$cookie,
+                             -charset=>'utf-7',
 			     -Cost=>'$2.00');
 
 header() returns the Content-type: header.  You can provide your own
@@ -4230,8 +4156,11 @@ session cookies.
 
 The B<-nph> parameter, if set to a true value, will issue the correct
 headers to work with a NPH (no-parse-header) script.  This is important
-to use with certain servers, such as Microsoft Internet Explorer, which
-expect all their scripts to be NPH.
+to use with certain servers that expect all their scripts to be NPH.
+
+The B<-charset> parameter can be used to control the character set
+sent to the browser.  If not provided, defaults to ISO-8859-1.  As a
+side effect, this sets the charset() method as well.
 
 =head2 GENERATING A REDIRECTION HEADER
 
@@ -4294,8 +4223,10 @@ different from the current location, as in
 All relative links will be interpreted relative to this tag.
 
 The argument B<-target> allows you to provide a default target frame
-for all the links and fill-out forms on the page.  See the Netscape
-documentation on frames for details of how to manipulate this.
+for all the links and fill-out forms on the page.  B<This is a
+non-standard HTTP feature which only works with Netscape browsers!>
+See the Netscape documentation on frames for details of how to
+manipulate this.
 
     -target=>"answer_window"
 
@@ -4308,10 +4239,10 @@ into a series of header <META> tags that look something like this:
     <META NAME="keywords" CONTENT="pharaoh secret mummy">
     <META NAME="description" CONTENT="copyright 1996 King Tut">
 
-There is no support for the HTTP-EQUIV type of <META> tag.  This is
-because you can modify the HTTP header directly with the B<header()>
-method.  For example, if you want to send the Refresh: header, do it
-in the header() method:
+There is no direct support for the HTTP-EQUIV type of <META> tag.
+This is because you can modify the HTTP header directly with the
+B<header()> method.  For example, if you want to send the Refresh:
+header, do it in the header() method:
 
     print $q->header(-Refresh=>'10; URL=http://www.capricorn.com');
 
@@ -4464,7 +4395,7 @@ This ends an HTML document by printing the </BODY></HTML> tags.
 =head2 CREATING A SELF-REFERENCING URL THAT PRESERVES STATE INFORMATION:
 
     $myself = $query->self_url;
-    print "<A HREF=$myself>I'm talking to myself.</A>";
+    print q(<A HREF="$myself">I'm talking to myself.</A>);
 
 self_url() will return a URL, that, when selected, will reinvoke
 this script with all its state information intact.  This is most
@@ -4724,6 +4655,49 @@ In addition, start_html(), end_html(), start_form(), end_form(),
 start_multipart_form() and all the fill-out form tags are special.
 See their respective sections.
 
+=head2 AUTOESCAPING HTML
+
+By default, all HTML that is emitted by the form-generating functions
+is passed through a function called escapeHTML():
+
+=over 4
+
+=item $escaped_string = escapeHTML("unescaped string");
+
+Escape HTML formatting characters in a string.
+
+=back
+
+Provided that you have specified a character set of ISO-8859-1 (the
+default), the standard HTML escaping rules will be used.  The "<"
+character becomes "&lt;", ">" becomes "&gt;", "&" becomes "&amp;", and
+the quote character becomes "&quot;".  In addition, the hexadecimal
+0x8b and 0x9b characters, which many windows-based browsers interpret
+as the left and right angle-bracket characters, are replaced by their
+numeric HTML entities ("&#139" and "&#155;").  If you manually change
+the charset, either by calling the charset() method explicitly or by
+passing a -charset argument to header(), then B<all> characters will
+be replaced by their numeric entities, since CGI.pm has no lookup
+table for all the possible encodings.
+
+The automatic escaping does not apply to other shortcuts, such as
+h1().  You should call escapeHTML() yourself on untrusted data in
+order to protect your pages against nasty tricks that people may enter
+into guestbooks, etc..  To change the character set, use charset().
+To turn autoescaping off completely, use autoescape():
+
+=over 4
+
+=item $charset = charset([$charset]);
+
+Get or set the current character set.
+
+=item $flag = autoEscape([$flag]);
+
+Get or set the value of the autoescape flag.
+
+=back
+
 =head2 PRETTY-PRINTING HTML
 
 By default, all the HTML produced by these functions comes out as one
@@ -4769,7 +4743,6 @@ autoEscape() method with a false value immediately after creating the CGI object
    $query = new CGI;
    $query->autoEscape(undef);
 
-
 =head2 CREATING AN ISINDEX TAG
 
    print $query->isindex(-action=>$action);
@@ -4784,7 +4757,7 @@ default is to process the query with the current script.
 
 =head2 STARTING AND ENDING A FORM
 
-    print $query->startform(-method=>$method,
+    print $query->start_form(-method=>$method,
 			    -action=>$action,
 			    -enctype=>$encoding);
       <... various form stuff ...>
@@ -4792,11 +4765,11 @@ default is to process the query with the current script.
 
 	-or-
 
-    print $query->startform($method,$action,$encoding);
+    print $query->start_form($method,$action,$encoding);
       <... various form stuff ...>
     print $query->endform;
 
-startform() will return a <FORM> tag with the optional method,
+start_form() will return a <FORM> tag with the optional method,
 action and form encoding that you specify.  The defaults are:
 
     method: POST
@@ -4805,10 +4778,13 @@ action and form encoding that you specify.  The defaults are:
 
 endform() returns the closing </FORM> tag.  
 
-Startform()'s enctype argument tells the browser how to package the various
+Start_form()'s enctype argument tells the browser how to package the various
 fields of the form before sending the form to the server.  Two
 values are possible:
 
+B<Note:> This method was previously named startform(), and startform()
+is still recognized as an alias.
+
 =over 4
 
 =item B<application/x-www-form-urlencoded>
@@ -4834,10 +4810,10 @@ to handle them.
 
 =back
 
-For compatibility, the startform() method uses the older form of
+For compatibility, the start_form() method uses the older form of
 encoding by default.  If you want to use the newer form of encoding
 by default, you can call B<start_multipart_form()> instead of
-B<startform()>.
+B<start_form()>.
 
 JAVASCRIPTING: The B<-name> and B<-onSubmit> parameters are provided
 for use with JavaScript.  The -name parameter gives the
@@ -4971,9 +4947,9 @@ recognized.  See textfield().
 filefield() will return a file upload field for Netscape 2.0 browsers.
 In order to take full advantage of this I<you must use the new 
 multipart encoding scheme> for the form.  You can do this either
-by calling B<startform()> with an encoding type of B<$CGI::MULTIPART>,
+by calling B<start_form()> with an encoding type of B<$CGI::MULTIPART>,
 or by calling the new method B<start_multipart_form()> instead of
-vanilla B<startform()>.
+vanilla B<start_form()>.
 
 =over 4
 
@@ -5795,7 +5771,7 @@ details.
 You can specify the frame to load in the FORM tag itself.  With
 CGI.pm it looks like this:
 
-    print $q->startform(-target=>'ResultsWindow');
+    print $q->start_form(-target=>'ResultsWindow');
 
 When your script is reinvoked by the form, its output will be loaded
 into the frame named "ResultsWindow".  If one doesn't already exist
@@ -5880,12 +5856,11 @@ http://www.w3.org/pub/WWW/TR/Wd-css-1.html for more information.
 
 =head1 DEBUGGING
 
-If you are running the script
-from the command line or in the perl debugger, you can pass the script
-a list of keywords or parameter=value pairs on the command line or 
-from standard input (you don't have to worry about tricking your
-script into reading from environment variables).
-You can pass keywords like this:
+If you are running the script from the command line or in the perl
+debugger, you can pass the script a list of keywords or
+parameter=value pairs on the command line or from standard input (you
+don't have to worry about tricking your script into reading from
+environment variables).  You can pass keywords like this:
 
     your_script.pl keyword1 keyword2 keyword3
 
@@ -5901,7 +5876,11 @@ or this:
 
     your_script.pl name1=value1&name2=value2
 
-or even as newline-delimited parameters on standard input.
+To turn off this feature, use the -no_debug pragma.
+
+To test the POST method, you may enable full debugging with the -debug
+pragma.  This will allow you to feed newline-delimited name=value
+pairs to the script on standard input.
 
 When debugging, you can use quotes and backslashes to escape 
 characters in the familiar shell manner, letting you place
@@ -5912,11 +5891,11 @@ pairs:
 
 =head2 DUMPING OUT ALL THE NAME/VALUE PAIRS
 
-The dump() method produces a string consisting of all the query's
+The Dump() method produces a string consisting of all the query's
 name/value pairs formatted nicely as a nested list.  This is useful
 for debugging purposes:
 
-    print $query->dump
+    print $query->Dump
 
 
 Produces something that looks like:
@@ -6395,7 +6374,7 @@ for suggestions and bug fixes.
 	sub print_prompt {
 	   my($query) = @_;
 
-	   print $query->startform;
+	   print $query->start_form;
 	   print "<EM>What's your name?</EM><BR>";
 	   print $query->textfield('name');
 	   print $query->checkbox('Not my real name');
diff --git a/lib/CGI/Carp.pm b/lib/CGI/Carp.pm
index 90e9552c75..0a5c1218ee 100644
--- a/lib/CGI/Carp.pm
+++ b/lib/CGI/Carp.pm
@@ -194,14 +194,14 @@ use Carp;
 
 BEGIN {
   $] >= 5.005
-    ? eval q#sub ineval { $^S }#
-      : eval q#sub ineval { _longmess() =~ /eval [\{\']/m }#;
+    ? eval q#sub ineval { defined $^S ? $^S : _longmess() =~ /eval [\{\']/m }#
+    : eval q#sub ineval { _longmess() =~ /eval [\{\']/m }#;
   $@ and die;
 }
 
 $main::SIG{__WARN__}=\&CGI::Carp::warn;
 $main::SIG{__DIE__}=\&CGI::Carp::die;
-$CGI::Carp::VERSION = '1.14';
+$CGI::Carp::VERSION = '1.16';
 $CGI::Carp::CUSTOM_MSG = undef;
 
 # fancy import routine detects and handles 'errorWrap' specially.
@@ -335,8 +335,7 @@ $outer_message
 END
     ;
 
-    if ($mod_perl) {
-	my $r = Apache->request;
+    if ($mod_perl && (my $r = Apache->request)) {
 	# If bytes have already been sent, then
 	# we print the message out directly.
 	# Otherwise we make a custom error
diff --git a/lib/CGI/Cookie.pm b/lib/CGI/Cookie.pm
index bd3c3d8875..9e5a14b47b 100644
--- a/lib/CGI/Cookie.pm
+++ b/lib/CGI/Cookie.pm
@@ -13,9 +13,9 @@ package CGI::Cookie;
 # wish, but if you redistribute a modified version, please attach a note
 # listing the modifications you have made.
 
-$CGI::Cookie::VERSION='1.12';
+$CGI::Cookie::VERSION='1.16';
 
-use CGI qw(-no_debug);
+use CGI::Util qw(rearrange unescape escape);
 use overload '""' => \&as_string,
     'cmp' => \&compare,
     'fallback'=>1;
@@ -63,8 +63,11 @@ sub parse {
     my(@pairs) = split("; ",$raw_cookie);
     foreach (@pairs) {
 	my($key,$value) = split("=");
-	my(@values) = map CGI::unescape($_),split('&',$value);
-	$key = CGI::unescape($key);
+	my(@values) = map unescape($_),split('&',$value);
+	$key = unescape($key);
+	# Some foreign cookies are not in name=value format, so ignore
+	# them.
+	next if !defined($value);
 	# A bug in Netscape can cause several cookies with same name to
 	# appear.  The FIRST one in HTTP_COOKIE is the most recent version.
 	$results{$key} ||= $self->new(-name=>$key,-value=>\@values);
@@ -77,7 +80,7 @@ sub new {
     my $class = shift;
     $class = ref($class) if ref($class);
     my($name,$value,$path,$domain,$secure,$expires) =
-	CGI->rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@_);
+      rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@_);
 
     # Pull out our parameters.
     my @values;
@@ -97,7 +100,7 @@ sub new {
 	},$class;
 
     # IE requires the path and domain to be present for some reason.
-    $path   = CGI::url(-absolute=>1) unless defined $path;
+    $path   ||= '/';
 # however, this breaks networks which use host tables without fully qualified
 # names, so we comment it out.
 #    $domain = CGI::virtual_host()    unless defined $domain;
@@ -120,8 +123,8 @@ sub as_string {
     push(@constant_values,"expires=$expires") if $expires = $self->expires;
     push(@constant_values,'secure') if $secure = $self->secure;
 
-    my($key) = CGI::escape($self->name);
-    my($cookie) = join("=",$key,join("&",map CGI::escape($_),$self->value));
+    my($key) = escape($self->name);
+    my($cookie) = join("=",$key,join("&",map escape($_),$self->value));
     return join("; ",$cookie,@constant_values);
 }
 
@@ -163,7 +166,7 @@ sub secure {
 sub expires {
     my $self = shift;
     my $expires = shift;
-    $self->{'expires'} = CGI::expires($expires,'cookie') if defined $expires;
+    $self->{'expires'} = CGI::Util::expires($expires,'cookie') if defined $expires;
     return $self->{'expires'};
 }
 
@@ -252,8 +255,8 @@ against your script's URL before returning the cookie.  For example,
 if you specify the path "/cgi-bin", then the cookie will be returned
 to each of the scripts "/cgi-bin/tally.pl", "/cgi-bin/order.pl", and
 "/cgi-bin/customer_service/complain.pl", but not to the script
-"/cgi-private/site_admin.pl".  By default, the path is set to your
-script, so that only it will receive the cookie.
+"/cgi-private/site_admin.pl".  By default, the path is set to "/", so
+that all scripts at your site will receive the cookie.
 
 =item B<4. secure flag>
 
diff --git a/lib/CGI/Pretty.pm b/lib/CGI/Pretty.pm
index 4f2eed4ce9..20173f9acf 100644
--- a/lib/CGI/Pretty.pm
+++ b/lib/CGI/Pretty.pm
@@ -10,7 +10,7 @@ package CGI::Pretty;
 use strict;
 use CGI ();
 
-$CGI::Pretty::VERSION = '1.03';
+$CGI::Pretty::VERSION = '1.04';
 $CGI::DefaultClass = __PACKAGE__;
 $CGI::Pretty::AutoloadClass = 'CGI';
 @CGI::Pretty::ISA = qw( CGI );
@@ -62,15 +62,13 @@ sub _make_tag_func {
 	sub $tagname { 
 	    # handle various cases in which we're called
 	    # most of this bizarre stuff is to avoid -w errors
-	    shift if \$_[0] && 
-		(!ref(\$_[0]) && \$_[0] eq \$CGI::DefaultClass) ||
-		    (ref(\$_[0]) &&
-		     (substr(ref(\$_[0]),0,3) eq 'CGI' ||
-		    UNIVERSAL::isa(\$_[0],'CGI')));
-	    
+            shift if \$_[0] && 
+                    (ref(\$_[0]) &&
+                     (substr(ref(\$_[0]),0,3) eq 'CGI' ||
+                    UNIVERSAL::isa(\$_[0],'CGI')));
 	    my(\$attr) = '';
 	    if (ref(\$_[0]) && ref(\$_[0]) eq 'HASH') {
-		my(\@attr) = make_attributes('',shift);
+		my(\@attr) = make_attributes(shift);
 		\$attr = " \@attr" if \@attr;
 	    }
 
diff --git a/lib/CGI/Push.pm b/lib/CGI/Push.pm
index 80683a2e80..6b8e012a15 100644
--- a/lib/CGI/Push.pm
+++ b/lib/CGI/Push.pm
@@ -16,8 +16,9 @@ package CGI::Push;
 # The most recent version and complete docs are available at:
 #   http://stein.cshl.org/WWW/software/CGI/
 
-$CGI::Push::VERSION='1.01';
+$CGI::Push::VERSION='1.02';
 use CGI;
+use CGI::Util 'rearrange';
 @ISA = ('CGI');
 
 $CGI::DefaultClass = 'CGI::Push';
@@ -37,7 +38,7 @@ sub do_push {
 
     my (@header);
     my ($type,$callback,$delay,$last_page,$cookie,$target,$expires,@other) =
-	$self->rearrange([TYPE,NEXT_PAGE,DELAY,LAST_PAGE,[COOKIE,COOKIES],TARGET,EXPIRES],@p);
+	rearrange([TYPE,NEXT_PAGE,DELAY,LAST_PAGE,[COOKIE,COOKIES],TARGET,EXPIRES],@p);
     $type = 'text/html' unless $type;
     $callback = \&simple_counter unless $callback && ref($callback) eq 'CODE';
     $delay = 1 unless defined($delay);
@@ -53,7 +54,7 @@ sub do_push {
     push(@o,'-nph'=>1);
     print $self->header(@o);
     print "${boundary}$CGI::CRLF";
-    
+
     # now we enter a little loop
     my @contents;
     while (1) {
@@ -143,6 +144,9 @@ in such a way that it will replace what was there beforehand.  The
 technique will work with HTML pages as well as with graphics files, 
 allowing you to create animated GIFs.
 
+Only Netscape Navigator supports server push.  Internet Explorer
+browsers do not.
+
 =head1 USING CGI::Push
 
 CGI::Push adds one new method to the standard CGI suite, do_push().
diff --git a/lib/CGI/Util.pm b/lib/CGI/Util.pm
new file mode 100644
index 0000000000..0a5c48b6f3
--- /dev/null
+++ b/lib/CGI/Util.pm
@@ -0,0 +1,182 @@
+package CGI::Util;
+
+use strict;
+use vars '$VERSION','@EXPORT_OK','@ISA','$EBCDIC','@A2E';
+require Exporter;
+@ISA = qw(Exporter);
+@EXPORT_OK = qw(rearrange make_attributes unescape escape expires);
+
+$VERSION = '1.1';
+
+$EBCDIC = "\t" ne "\011";
+if ($EBCDIC) {
+@A2E = (
+  0,  1,  2,  3, 55, 45, 46, 47, 22,  5, 21, 11, 12, 13, 14, 15,
+ 16, 17, 18, 19, 60, 61, 50, 38, 24, 25, 63, 39, 28, 29, 30, 31,
+ 64, 90,127,123, 91,108, 80,125, 77, 93, 92, 78,107, 96, 75, 97,
+240,241,242,243,244,245,246,247,248,249,122, 94, 76,126,110,111,
+124,193,194,195,196,197,198,199,200,201,209,210,211,212,213,214,
+215,216,217,226,227,228,229,230,231,232,233,173,224,189, 95,109,
+121,129,130,131,132,133,134,135,136,137,145,146,147,148,149,150,
+151,152,153,162,163,164,165,166,167,168,169,192, 79,208,161,  7,
+ 32, 33, 34, 35, 36, 37,  6, 23, 40, 41, 42, 43, 44,  9, 10, 27,
+ 48, 49, 26, 51, 52, 53, 54,  8, 56, 57, 58, 59,  4, 20, 62,255,
+ 65,170, 74,177,159,178,106,181,187,180,154,138,176,202,175,188,
+144,143,234,250,190,160,182,179,157,218,155,139,183,184,185,171,
+100,101, 98,102, 99,103,158,104,116,113,114,115,120,117,118,119,
+172,105,237,238,235,239,236,191,128,253,254,251,252,186,174, 89,
+ 68, 69, 66, 70, 67, 71,156, 72, 84, 81, 82, 83, 88, 85, 86, 87,
+140, 73,205,206,203,207,204,225,112,221,222,219,220,141,142,223
+      );
+}
+
+# Smart rearrangement of parameters to allow named parameter
+# calling.  We do the rearangement if:
+# the first parameter begins with a -
+sub rearrange {
+    my($order,@param) = @_;
+    return () unless @param;
+
+    if (ref($param[0]) eq 'HASH') {
+	@param = %{$param[0]};
+    } else {
+	return @param 
+	    unless (defined($param[0]) && substr($param[0],0,1) eq '-');
+    }
+
+    # map parameters into positional indices
+    my ($i,%pos);
+    $i = 0;
+    foreach (@$order) {
+	foreach (ref($_) eq 'ARRAY' ? @$_ : $_) { $pos{$_} = $i; }
+	$i++;
+    }
+
+    my (@result,%leftover);
+    $#result = $#$order;  # preextend
+    while (@param) {
+	my $key = uc(shift(@param));
+	$key =~ s/^\-//;
+	if (exists $pos{$key}) {
+	    $result[$pos{$key}] = shift(@param);
+	} else {
+	    $leftover{$key} = shift(@param);
+	}
+    }
+
+    push (@result,make_attributes(\%leftover)) if %leftover;
+    @result;
+}
+
+sub make_attributes {
+    my $attr = shift;
+    return () unless $attr && ref($attr) && ref($attr) eq 'HASH';
+    my $escape = shift || 0;
+    my(@att);
+    foreach (keys %{$attr}) {
+	my($key) = $_;
+	$key=~s/^\-//;     # get rid of initial - if present
+	$key=~tr/a-z_/A-Z-/; # parameters are upper case, use dashes
+	my $value = $escape ? simple_escape($attr->{$_}) : $attr->{$_};
+	push(@att,defined($attr->{$_}) ? qq/$key="$value"/ : qq/$key/);
+    }
+    return @att;
+}
+
+sub simple_escape {
+  return unless defined (my $toencode = shift);
+  $toencode =~ s{(.)}{
+              if    ($1 eq '<')                            { '&lt;'    }
+              elsif ($1 eq '>')                            { '&gt;'    }
+              elsif ($1 eq '&')                            { '&amp;'   }
+              elsif ($1 eq '"')                            { '&quot;'  }
+              elsif ($1 eq "\x8b")                         { '&#139;'  }
+              elsif ($1 eq "\x9b")                         { '&#155;'  }
+              else                                         { $1        }
+       }gsex;
+  $toencode;
+}
+
+# unescape URL-encoded data
+sub unescape {
+  shift() if ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass);
+  my $todecode = shift;
+  return undef unless defined($todecode);
+  $todecode =~ tr/+/ /;       # pluses become spaces
+    if ($EBCDIC) {
+      $todecode =~ s/%([0-9a-fA-F]{2})/chr $A2E[hex($1)]/ge;
+    } else {
+      $todecode =~ s/%([0-9a-fA-F]{2})/chr hex($1)/ge;
+    }
+  return $todecode;
+}
+
+# URL-encode data
+sub escape {
+  shift() if ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass);
+  my $toencode = shift;
+  return undef unless defined($toencode);
+  $toencode=~s/([^a-zA-Z0-9_.-])/uc sprintf("%%%02x",ord($1))/eg;
+  return $toencode;
+}
+
+# This internal routine creates date strings suitable for use in
+# cookies and HTTP headers.  (They differ, unfortunately.)
+# Thanks to Mark Fisher for this.
+sub expires {
+    my($time,$format) = @_;
+    $format ||= 'http';
+
+    my(@MON)=qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
+    my(@WDAY) = qw/Sun Mon Tue Wed Thu Fri Sat/;
+
+    # pass through preformatted dates for the sake of expire_calc()
+    $time = expire_calc($time);
+    return $time unless $time =~ /^\d+$/;
+
+    # make HTTP/cookie date string from GMT'ed time
+    # (cookies use '-' as date separator, HTTP uses ' ')
+    my($sc) = ' ';
+    $sc = '-' if $format eq "cookie";
+    my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time);
+    $year += 1900;
+    return sprintf("%s, %02d$sc%s$sc%04d %02d:%02d:%02d GMT",
+                   $WDAY[$wday],$mday,$MON[$mon],$year,$hour,$min,$sec);
+}
+
+# This internal routine creates an expires time exactly some number of
+# hours from the current time.  It incorporates modifications from 
+# Mark Fisher.
+sub expire_calc {
+    my($time) = @_;
+    my(%mult) = ('s'=>1,
+                 'm'=>60,
+                 'h'=>60*60,
+                 'd'=>60*60*24,
+                 'M'=>60*60*24*30,
+                 'y'=>60*60*24*365);
+    # format for time can be in any of the forms...
+    # "now" -- expire immediately
+    # "+180s" -- in 180 seconds
+    # "+2m" -- in 2 minutes
+    # "+12h" -- in 12 hours
+    # "+1d"  -- in 1 day
+    # "+3M"  -- in 3 months
+    # "+2y"  -- in 2 years
+    # "-3m"  -- 3 minutes ago(!)
+    # If you don't supply one of these forms, we assume you are
+    # specifying the date yourself
+    my($offset);
+    if (!$time || (lc($time) eq 'now')) {
+        $offset = 0;
+    } elsif ($time=~/^\d+/) {
+        return $time;
+    } elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([mhdMy]?)/) {
+        $offset = ($mult{$2} || 1)*$1;
+    } else {
+        return $time;
+    }
+    return (time+$offset);
+}
+
+1;
diff --git a/t/lib/cgi-function.t b/t/lib/cgi-function.t
index b4cd56811f..934e27cdc9 100755
--- a/t/lib/cgi-function.t
+++ b/t/lib/cgi-function.t
@@ -8,7 +8,7 @@ BEGIN {
     unshift @INC, '../lib' if -d '../lib';
 }
 
-BEGIN {$| = 1; print "1..24\n"; }
+BEGIN {$| = 1; print "1..27\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use Config;
 use CGI (':standard','keywords');
@@ -24,6 +24,8 @@ sub test {
     print($true ? "ok $num\n" : "not ok $num $msg\n");
 }
 
+my $CRLF = "\015\012";
+
 # Set up a CGI environment
 $ENV{REQUEST_METHOD}='GET';
 $ENV{QUERY_STRING}  ='game=chess&game=checkers&weather=dull';
@@ -36,7 +38,7 @@ $ENV{SERVER_NAME} = 'the.good.ship.lollypop.com';
 $ENV{HTTP_LOVE} = 'true';
 
 test(2,request_method() eq 'GET',"CGI::request_method()");
-test(3,query_string() eq 'game=chess&game=checkers&weather=dull',"CGI::query_string()");
+test(3,query_string() eq 'game=chess;game=checkers;weather=dull',"CGI::query_string()");
 test(4,param() == 2,"CGI::param()");
 test(5,join(' ',sort {$a cmp $b} param()) eq 'game weather',"CGI::param()");
 test(6,param('game') eq 'chess',"CGI::param()");
@@ -44,18 +46,18 @@ test(7,param('weather') eq 'dull',"CGI::param()");
 test(8,join(' ',param('game')) eq 'chess checkers',"CGI::param()");
 test(9,param(-name=>'foo',-value=>'bar'),'CGI::param() put');
 test(10,param(-name=>'foo') eq 'bar','CGI::param() get');
-test(11,query_string() eq 'game=chess&game=checkers&weather=dull&foo=bar',"CGI::query_string() redux");
+test(11,query_string() eq 'game=chess;game=checkers;weather=dull;foo=bar',"CGI::query_string() redux");
 test(12,http('love') eq 'true',"CGI::http()");
 test(13,script_name() eq '/cgi-bin/foo.cgi',"CGI::script_name()");
 test(14,url() eq 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi',"CGI::url()");
 test(15,self_url() eq 
-     'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi/somewhere/else?game=chess&game=checkers&weather=dull&foo=bar',
+     'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
      "CGI::url()");
 test(16,url(-absolute=>1) eq '/cgi-bin/foo.cgi','CGI::url(-absolute=>1)');
 test(17,url(-relative=>1) eq 'foo.cgi','CGI::url(-relative=>1)');
 test(18,url(-relative=>1,-path=>1) eq 'foo.cgi/somewhere/else','CGI::url(-relative=>1,-path=>1)');
 test(19,url(-relative=>1,-path=>1,-query=>1) eq 
-     'foo.cgi/somewhere/else?game=chess&game=checkers&weather=dull&foo=bar',
+     'foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
      'CGI::url(-relative=>1,-path=>1,-query=>1)');
 Delete('foo');
 test(20,!param('foo'),'CGI::delete()');
@@ -65,21 +67,25 @@ $ENV{QUERY_STRING}='mary+had+a+little+lamb';
 test(21,join(' ',keywords()) eq 'mary had a little lamb','CGI::keywords');
 test(22,join(' ',param('keywords')) eq 'mary had a little lamb','CGI::keywords');
 
-if (!$Config{d_fork} or $^O eq 'MSWin32' or $^O eq 'VMS') {
-    for (23,24) { print "ok $_ # Skipped: fork n/a\n" }
-}
-else {
-    CGI::_reset_globals;
-    $test_string = 'game=soccer&game=baseball&weather=nice';
-    $ENV{REQUEST_METHOD}='POST';
-    $ENV{CONTENT_LENGTH}=length($test_string);
-    $ENV{QUERY_STRING}='big_balls=basketball&small_balls=golf';
-    if (open(CHILD,"|-")) {  # cparent
-	print CHILD $test_string;
-	close CHILD;
-	exit 0;
-    }
-    # at this point, we're in a new (child) process
-    test(23,param('weather') eq 'nice',"CGI::param() from POST");
-    test(24,url_param('big_balls') eq 'basketball',"CGI::url_param()");
+CGI::_reset_globals;
+if ($Config{d_fork}) {
+  $test_string = 'game=soccer&game=baseball&weather=nice';
+  $ENV{REQUEST_METHOD}='POST';
+  $ENV{CONTENT_LENGTH}=length($test_string);
+  $ENV{QUERY_STRING}='big_balls=basketball&small_balls=golf';
+  if (open(CHILD,"|-")) {  # cparent
+    print CHILD $test_string;
+    close CHILD;
+    exit 0;
+  }
+  # at this point, we're in a new (child) process
+  test(23,param('weather') eq 'nice',"CGI::param() from POST");
+  test(24,url_param('big_balls') eq 'basketball',"CGI::url_param()");
+} else {
+  print "ok 23 # Skip\n";
+  print "ok 24 # Skip\n";
 }
+
+test(25,redirect('http://somewhere.else') eq "Status: 302 Moved${CRLF}Location: http://somewhere.else${CRLF}${CRLF}","CGI::redirect() 1");
+test(26,redirect(-Location=>'http://somewhere.else',-Type=>'text/html') eq "Status: 302 Moved${CRLF}Location: http://somewhere.else${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
+test(27,redirect(-Location=>'http://somewhere.else/bin/foo&bar',-Type=>'text/html') eq "Status: 302 Moved${CRLF}Location: http://somewhere.else/bin/foo&bar${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}","CGI::redirect() 2");
diff --git a/t/lib/cgi-html.t b/t/lib/cgi-html.t
index 43d41ec10f..1e20a315fa 100755
--- a/t/lib/cgi-html.t
+++ b/t/lib/cgi-html.t
@@ -9,7 +9,7 @@ BEGIN {
     require Config; import Config;
 }
 
-BEGIN {$| = 1; print "1..20\n"; }
+BEGIN {$| = 1; print "1..24\n"; }
 END {print "not ok 1\n" unless $loaded;}
 use CGI (':standard','-no_debug','*h3','start_table');
 $loaded = 1;
@@ -41,12 +41,13 @@ test(7,h1({-align=>'CENTER'},['fred','agnes']) eq
     test(8,h1('fred','agnes','maura') eq '<H1>fred-agnes-maura</H1>',"open/close tag \$\" interpolation");
 }
 
-test(9,header() eq "Content-Type: text/html$crlf$crlf","header()");
-test(10,header(-type=>'image/gif') eq "Content-Type: image/gif$crlf$crlf","header()");
-test(11,header(-type=>'image/gif',-status=>'500 Sucks') eq "Status: 500 Sucks${crlf}Content-Type: image/gif$crlf$crlf","header()");
-test(12,header(-nph=>1) eq "HTTP/1.0 200 OK${crlf}Content-Type: text/html$crlf$crlf","header()");
+test(9,header() eq "Content-Type: text/html; charset=ISO-8859-1$crlf$crlf","header()");
+test(10,header(-type=>'image/gif') eq "Content-Type: image/gif; charset=ISO-8859-1$crlf$crlf","header()");
+test(11,header(-type=>'image/gif',-status=>'500 Sucks') eq "Status: 500 Sucks${crlf}Content-Type: image/gif; charset=ISO-8859-1$crlf$crlf","header()");
+test(12,header(-nph=>1) eq "HTTP/1.0 200 OK${crlf}Content-Type: text/html; charset=ISO-8859-1$crlf$crlf","header()");
 test(13,start_html() ."\n" eq <<END,"start_html()");
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
+	"http://www.w3.org/TR/html4/loose.dtd">
 <HTML><HEAD><TITLE>Untitled Document</TITLE>
 </HEAD><BODY>
 END
@@ -58,7 +59,8 @@ test(14,start_html(-dtd=>"-//IETF//DTD HTML 3.2//FR") ."\n" eq <<END,"start_html
 END
     ;
 test(15,start_html(-Title=>'The world of foo') ."\n" eq <<END,"start_html()");
-<!DOCTYPE HTML PUBLIC "-//IETF//DTD HTML//EN">
+<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN"
+	"http://www.w3.org/TR/html4/loose.dtd">
 <HTML><HEAD><TITLE>The world of foo</TITLE>
 </HEAD><BODY>
 END
@@ -70,6 +72,9 @@ test(17,header(-Cookie=>$cookie) =~ m!^Set-Cookie: fred=chocolate&chip\; path=/$
 test(18,start_h3 eq '<H3>');
 test(19,end_h3 eq '</H3>');
 test(20,start_table({-border=>undef}) eq '<TABLE BORDER>');
-
-
-
+test(21,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<H1>this is &lt;not&gt; &#139;right&#155;</H1>');
+charset('utf-8');
+test(22,h1(escapeHTML("this is <not> \x8bright\x9b")) eq '<H1>&#116;&#104;&#105;&#115;&#32;&#105;&#115;&#32;&#60;&#110;&#111;&#116;&#62;&#32;&#139;&#114;&#105;&#103;&#104;&#116;&#155;</H1>');
+test(23,i(p('hello there')) eq '<I><P>hello there</P></I>');
+my $q = new CGI;
+test(24,$q->h1('hi') eq '<H1>hi</H1>');
diff --git a/t/lib/cgi-pretty.t b/t/lib/cgi-pretty.t
new file mode 100755
index 0000000000..e217a7dbd4
--- /dev/null
+++ b/t/lib/cgi-pretty.t
@@ -0,0 +1,39 @@
+#!./perl
+
+# Test ability to retrieve HTTP request info
+######################### We start with some black magic to print on failure.
+BEGIN {
+    chdir 't' if -d 't';
+    unshift @INC, '../lib' if -d '../lib';
+}
+
+BEGIN {$| = 1; print "1..5\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use CGI::Pretty (':standard','-no_debug','*h3','start_table');
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# util
+sub test {
+    local($^W) = 0;
+    my($num, $true,$msg) = @_;
+    print($true ? "ok $num\n" : "not ok $num $msg\n");
+}
+
+# all the automatic tags
+test(2,h1() eq '<H1>',"single tag");
+test(3,ol(li('fred'),li('ethel')) eq "<OL>\n\t<LI>\n\t\tfred\n\t</LI>\n\t <LI>\n\t\tethel\n\t</LI>\n</OL>\n","basic indentation");
+test(4,p('hi',pre('there'),'frog') eq 
+'<P>
+	hi <PRE>there</PRE>
+	 frog
+</P>
+',"<pre> tags");
+test(5,p('hi',a({-href=>'frog'},'there'),'frog') eq 
+'<P>
+	hi <A HREF="frog">there</A>
+	 frog
+</P>
+',"as-is");
diff --git a/t/lib/cgi-request.t b/t/lib/cgi-request.t
index 9e8cdc290a..390c08cccd 100755
--- a/t/lib/cgi-request.t
+++ b/t/lib/cgi-request.t
@@ -8,10 +8,10 @@ BEGIN {
     unshift @INC, '../lib' if -d '../lib';
 }
 
-BEGIN {$| = 1; print "1..31\n"; }
+BEGIN {$| = 1; print "1..33\n"; }
 END {print "not ok 1\n" unless $loaded;}
-use Config;
 use CGI ();
+use Config;
 $loaded = 1;
 print "ok 1\n";
 
@@ -39,7 +39,7 @@ $ENV{HTTP_LOVE}       = 'true';
 $q = new CGI;
 test(2,$q,"CGI::new()");
 test(3,$q->request_method eq 'GET',"CGI::request_method()");
-test(4,$q->query_string eq 'game=chess&game=checkers&weather=dull',"CGI::query_string()");
+test(4,$q->query_string eq 'game=chess;game=checkers;weather=dull',"CGI::query_string()");
 test(5,$q->param() == 2,"CGI::param()");
 test(6,join(' ',sort $q->param()) eq 'game weather',"CGI::param()");
 test(7,$q->param('game') eq 'chess',"CGI::param()");
@@ -47,18 +47,18 @@ test(8,$q->param('weather') eq 'dull',"CGI::param()");
 test(9,join(' ',$q->param('game')) eq 'chess checkers',"CGI::param()");
 test(10,$q->param(-name=>'foo',-value=>'bar'),'CGI::param() put');
 test(11,$q->param(-name=>'foo') eq 'bar','CGI::param() get');
-test(12,$q->query_string eq 'game=chess&game=checkers&weather=dull&foo=bar',"CGI::query_string() redux");
+test(12,$q->query_string eq 'game=chess;game=checkers;weather=dull;foo=bar',"CGI::query_string() redux");
 test(13,$q->http('love') eq 'true',"CGI::http()");
 test(14,$q->script_name eq '/cgi-bin/foo.cgi',"CGI::script_name()");
 test(15,$q->url eq 'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi',"CGI::url()");
 test(16,$q->self_url eq 
-     'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi/somewhere/else?game=chess&game=checkers&weather=dull&foo=bar',
+     'http://the.good.ship.lollypop.com:8080/cgi-bin/foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
      "CGI::url()");
 test(17,$q->url(-absolute=>1) eq '/cgi-bin/foo.cgi','CGI::url(-absolute=>1)');
 test(18,$q->url(-relative=>1) eq 'foo.cgi','CGI::url(-relative=>1)');
 test(19,$q->url(-relative=>1,-path=>1) eq 'foo.cgi/somewhere/else','CGI::url(-relative=>1,-path=>1)');
 test(20,$q->url(-relative=>1,-path=>1,-query=>1) eq 
-     'foo.cgi/somewhere/else?game=chess&game=checkers&weather=dull&foo=bar',
+     'foo.cgi/somewhere/else?game=chess;game=checkers;weather=dull;foo=bar',
      'CGI::url(-relative=>1,-path=>1,-query=>1)');
 $q->delete('foo');
 test(21,!$q->param('foo'),'CGI::delete()');
@@ -73,22 +73,30 @@ test(26,$q->param('foo') eq 'bar','CGI::param() redux');
 test(27,$q=new CGI({'foo'=>'bar','bar'=>'froz'}),"CGI::new() redux 2");
 test(28,$q->param('bar') eq 'froz',"CGI::param() redux 2");
 
-if (!$Config{d_fork} or $^O eq 'MSWin32' or $^O eq 'VMS') {
-    for (29..31) { print "ok $_ # Skipped: fork n/a\n" }
-}
-else {
-    $q->_reset_globals;
-    $test_string = 'game=soccer&game=baseball&weather=nice';
-    $ENV{REQUEST_METHOD}='POST';
-    $ENV{CONTENT_LENGTH}=length($test_string);
-    $ENV{QUERY_STRING}='big_balls=basketball&small_balls=golf';
-    if (open(CHILD,"|-")) {  # cparent
-	print CHILD $test_string;
-	close CHILD;
-	exit 0;
-    }
-    # at this point, we're in a new (child) process
-    test(29,$q=new CGI,"CGI::new() from POST");
-    test(30,$q->param('weather') eq 'nice',"CGI::param() from POST");
-    test(31,$q->url_param('big_balls') eq 'basketball',"CGI::url_param()");
+# test tied interface
+my $p = $q->Vars;
+test(29,$p->{bar} eq 'froz',"tied interface fetch");
+$p->{bar} = join("\0",qw(foo bar baz));
+test(30,join(' ',$q->param('bar')) eq 'foo bar baz','tied interface store');
+
+# test posting
+$q->_reset_globals;
+if ($Config{d_fork}) {
+  $test_string = 'game=soccer&game=baseball&weather=nice';
+  $ENV{REQUEST_METHOD}='POST';
+  $ENV{CONTENT_LENGTH}=length($test_string);
+  $ENV{QUERY_STRING}='big_balls=basketball&small_balls=golf';
+  if (open(CHILD,"|-")) {  # cparent
+    print CHILD $test_string;
+    close CHILD;
+    exit 0;
+  }
+  # at this point, we're in a new (child) process
+  test(31,$q=new CGI,"CGI::new() from POST");
+  test(32,$q->param('weather') eq 'nice',"CGI::param() from POST");
+  test(33,$q->url_param('big_balls') eq 'basketball',"CGI::url_param()");
+} else {
+  print "ok 31 # Skip\n";
+  print "ok 32 # Skip\n";
+  print "ok 33 # Skip\n";
 }