Upgrade to CGI.pm 2.752, from Lincoln Stein.

(Note: there were some conflicts due to EBCDIC and EPOC
 patches, in general I preferred the repository code.)
(When 2.753 comes out, we need to synchronize.)

p4raw-id: //depot/perl@8866

8 files changed, 293 insertions, 173 deletions

diff --git a/lib/CGI.pm b/lib/CGI.pm
index 6b870545b3..1c9d2d4661 100644
--- a/lib/CGI.pm
+++ b/lib/CGI.pm
@@ -1,5 +1,6 @@
 package CGI;
 require 5.004;
+use Carp 'croak';
 
 # See the bottom of this file for the POD documentation.  Search for the
 # string '=head'.
@@ -17,16 +18,16 @@ 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.45 2000/09/13 02:55:41 lstein Exp $';
-$CGI::VERSION='2.74';
+$CGI::revision = '$Id: CGI.pm,v 1.49 2001/02/04 23:08:39 lstein Exp $';
+$CGI::VERSION='2.752';
 
 # 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);
 
-use constant XHTML_DTD => ['-//W3C//DTD XHTML 1.0 Transitional//EN',
-			   'DTD/xhtml1-transitional.dtd'];
+use constant XHTML_DTD => ['-//W3C//DTD XHTML Basic 1.0//EN',
+                           'http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd'];
 
 # >>>>> Here are some globals that you might want to adjust <<<<<<
 sub initialize_globals {
@@ -135,7 +136,8 @@ $AutoloadClass = $DefaultClass unless defined $CGI::AutoloadClass;
 # The path separator is a slash, backslash or semicolon, depending
 # on the paltform.
 $SL = {
-    UNIX=>'/', EPOC=>'/', OS2=>'\\', WINDOWS=>'\\', DOS=>'\\', MACINTOSH=>':', VMS=>'/'
+    UNIX=>'/', OS2=>'\\', EPOC=>'/', 
+    WINDOWS=>'\\', DOS=>'\\', MACINTOSH=>':', VMS=>'/'
     }->{$OS};
 
 # This no longer seems to be necessary
@@ -199,7 +201,7 @@ if ($needs_binmode) {
 		':cgi-lib' => [qw/ReadParse PrintHeader HtmlTop HtmlBot SplitParam Vars/],
 		':html' => [qw/:html2 :html3 :netscape/],
 		':standard' => [qw/:html2 :html3 :form :cgi/],
-		':push' => [qw/multipart_init multipart_start multipart_end/],
+		':push' => [qw/multipart_init multipart_start multipart_end multipart_final/],
 		':all' => [qw/:html2 :html3 :netscape :form :cgi :internal/]
 		);
 
@@ -456,7 +458,7 @@ sub init {
 
     # 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 (defined $query_string && length $query_string) {
 	if ($query_string =~ /[&=;]/) {
 	    $self->parse_params($query_string);
 	} else {
@@ -618,7 +620,7 @@ sub _compile {
         unless (%$sub) {
 	   my($auto) = \${"$pack\:\:AUTOLOADED_ROUTINES"};
 	   eval "package $pack; $$auto";
-	   die $@ if $@;
+	   croak("$AUTOLOAD: $@") if $@;
            $$auto = '';  # Free the unneeded storage (but don't undef it!!!)
        }
        my($code) = $sub->{$func_name};
@@ -634,11 +636,11 @@ sub _compile {
 	       $code = $CGI::DefaultClass->_make_tag_func($func_name);
 	   }
        }
-       die "Undefined subroutine $AUTOLOAD\n" unless $code;
+       croak("Undefined subroutine $AUTOLOAD\n") unless $code;
        eval "package $pack; $code";
        if ($@) {
 	   $@ =~ s/ at .*\n//;
-	   die $@;
+	   croak("$AUTOLOAD: $@");
        }
     }       
     CORE::delete($sub->{$func_name});  #free storage
@@ -706,7 +708,7 @@ sub MULTIPART {  'multipart/form-data'; }
 END_OF_FUNC
 
 'SERVER_PUSH' => <<'END_OF_FUNC',
-sub SERVER_PUSH { 'multipart/x-mixed-replace; boundary="' . shift() . '"'; }
+sub SERVER_PUSH { 'multipart/x-mixed-replace;boundary="' . shift() . '"'; }
 END_OF_FUNC
 
 'new_MultipartBuffer' => <<'END_OF_FUNC',
@@ -1090,23 +1092,24 @@ END_OF_FUNC
 
 #### Method: multipart_init
 # Return a Content-Type: style header for server-push
-# This has to be NPH, and it is advisable to set $| = 1
+# This has to be NPH on most web servers, and it is advisable to set $| = 1
 #
 # Many thanks to Ed Jordan <ed@fidalgo.net> for this
-# contribution
+# contribution, updated by Andrew Benham (adsb@bigfoot.com)
 ####
 'multipart_init' => <<'END_OF_FUNC',
 sub multipart_init {
     my($self,@p) = self_or_default(@_);
     my($boundary,@other) = rearrange([BOUNDARY],@p);
     $boundary = $boundary || '------- =_aaaaaaaaaa0';
-    $self->{'separator'} = "\n--$boundary\n";
+    $self->{'separator'} = "$CRLF--$boundary$CRLF";
+    $self->{'final_separator'} = "$CRLF--$boundary--$CRLF";
     $type = SERVER_PUSH($boundary);
     return $self->header(
 	-nph => 1,
 	-type => $type,
 	(map { split "=", $_, 2 } @other),
-    ) . $self->multipart_end;
+    ) . "WARNING: YOUR BROWSER DOESN'T SUPPORT THIS SERVER-PUSH TECHNOLOGY." . $self->multipart_end;
 }
 END_OF_FUNC
 
@@ -1115,23 +1118,31 @@ END_OF_FUNC
 # Return a Content-Type: style header for server-push, start of section
 #
 # Many thanks to Ed Jordan <ed@fidalgo.net> for this
-# contribution
+# contribution, updated by Andrew Benham (adsb@bigfoot.com)
 ####
 'multipart_start' => <<'END_OF_FUNC',
 sub multipart_start {
+    my(@header);
     my($self,@p) = self_or_default(@_);
     my($type,@other) = rearrange([TYPE],@p);
     $type = $type || 'text/html';
-    return $self->header(
-	-type => $type,
-	(map { split "=", $_, 2 } @other),
-    );
+    push(@header,"Content-Type: $type");
+
+    # rearrange() was designed for the HTML portion, so we
+    # need to fix it up a little.
+    foreach (@other) {
+        next unless my($header,$value) = /([^\s=]+)=\"?(.+?)\"?$/;
+	($_ = $header) =~ s/^(\w)(.*)/$1 . lc ($2) . ': '.$self->unescapeHTML($value)/e;
+    }
+    push(@header,@other);
+    my $header = join($CRLF,@header)."${CRLF}${CRLF}";
+    return $header;
 }
 END_OF_FUNC
 
 
 #### Method: multipart_end
-# Return a Content-Type: style header for server-push, end of section
+# Return a MIME boundary separator for server-push, end of section
 #
 # Many thanks to Ed Jordan <ed@fidalgo.net> for this
 # contribution
@@ -1144,6 +1155,19 @@ sub multipart_end {
 END_OF_FUNC
 
 
+#### Method: multipart_final
+# Return a MIME boundary separator for server-push, end of all sections
+#
+# Contributed by Andrew Benham (adsb@bigfoot.com)
+####
+'multipart_final' => <<'END_OF_FUNC',
+sub multipart_final {
+    my($self,@p) = self_or_default(@_);
+    return $self->{'final_separator'} . "WARNING: YOUR BROWSER DOESN'T SUPPORT THIS SERVER-PUSH TECHNOLOGY." . $CRLF;
+}
+END_OF_FUNC
+
+
 #### Method: header
 # Return a Content-Type: style header
 #
@@ -1181,6 +1205,7 @@ sub header {
     # Maybe future compatibility.  Maybe not.
     my $protocol = $ENV{SERVER_PROTOCOL} || 'HTTP/1.0';
     push(@header,$protocol . ' ' . ($status || '200 OK')) if $nph;
+    push(@header,"Server: " . &server_software()) if $nph;
 
     push(@header,"Status: $status") if $status;
     push(@header,"Window-Target: $target") if $target;
@@ -1197,7 +1222,7 @@ sub header {
     # uses OUR clock)
     push(@header,"Expires: " . expires($expires,'http'))
 	if $expires;
-    push(@header,"Date: " . expires(0,'http')) if $expires || $cookie;
+    push(@header,"Date: " . expires(0,'http')) if $expires || $cookie || $nph;
     push(@header,"Pragma: no-cache") if $self->cache();
     push(@header,"Content-Disposition: attachment; filename=\"$attachment\"") if $attachment;
     push(@header,@other);
@@ -1283,7 +1308,7 @@ sub start_html {
     $title = $self->escapeHTML($title || 'Untitled Document');
     $author = $self->escape($author);
     $lang ||= 'en-US';
-    my(@result);
+    my(@result,$xml_dtd);
     if ($dtd) {
         if (defined(ref($dtd)) and (ref($dtd) eq 'ARRAY')) {
             $dtd = $DEFAULT_DTD unless $dtd->[0] =~ m|^-//|;
@@ -1293,6 +1318,11 @@ sub start_html {
     } else {
         $dtd = $XHTML ? XHTML_DTD : $DEFAULT_DTD;
     }
+
+    $xml_dtd++ if ref($dtd) eq 'ARRAY' && $dtd->[0] =~ /\bXHTML\b/i;
+    $xml_dtd++ if ref($dtd) eq '' && $dtd =~ /\bXHTML\b/i;
+    push @result,q(<?xml version="1.0" encoding="utf-8"?>) if $xml_dtd; 
+
     if (ref($dtd) && ref($dtd) eq 'ARRAY') {
         push(@result,qq(<!DOCTYPE html\n\tPUBLIC "$dtd->[0]"\n\t"$dtd->[1]">));
     } else {
@@ -1357,12 +1387,15 @@ sub _style {
      { # If it is, push a LINK tag for each one.
        foreach $src (@$src)
        {
-         push(@result,qq/<link rel="stylesheet" type="$type" href="$src">/) if $src;
+         push(@result,$XHTML ? qq(<link rel="stylesheet" type="$type" href="$src" />)
+                             : qq(<link rel="stylesheet" type="$type" href="$src">/)) if $src;
        }
      }
      else
      { # Otherwise, push the single -src, if it exists.
-       push(@result,qq/<link rel="stylesheet" type="$type" href="$src">/) if $src;
+       push(@result,$XHTML ? qq(<link rel="stylesheet" type="$type" href="$src" />)
+                           : qq(<link rel="stylesheet" type="$type" href="$src">)
+            ) if $src;
       }
      push(@result,style({'type'=>$type},"$cdata_start\n$code\n$cdata_end")) if $code;
     } else {
@@ -1409,7 +1442,7 @@ sub _script {
 	push(@satts,'src'=>$src) if $src;
 	push(@satts,'language'=>$language);
         push(@satts,'type'=>$type);
-	$code = "$cdata_start$code$cdata_end";
+	$code = "$cdata_start$code$cdata_end" if defined $code;
 	push(@result,script({@satts},$code || ''));
     }
     @result;
@@ -1542,8 +1575,8 @@ sub _textfield {
 
     $current = defined($current) ? $self->escapeHTML($current,1) : '';
     $name = defined($name) ? $self->escapeHTML($name) : '';
-    my($s) = defined($size) ? qq/ size=$size/ : '';
-    my($m) = defined($maxlength) ? qq/ maxlength=$maxlength/ : '';
+    my($s) = defined($size) ? qq/ size="$size"/ : '';
+    my($m) = defined($maxlength) ? qq/ maxlength="$maxlength"/ : '';
     my($other) = @other ? " @other" : '';
     # this entered at cristy's request to fix problems with file upload fields
     # and WebTV -- not sure it won't break stuff
@@ -1657,7 +1690,7 @@ sub button {
     $script=$self->escapeHTML($script);
 
     my($name) = '';
-    $name = qq/ NAME="$label"/ if $label;
+    $name = qq/ name="$label"/ if $label;
     $value = $value || $label;
     my($val) = '';
     $val = qq/ value="$value"/ if $value;
@@ -1877,6 +1910,7 @@ sub escapeHTML {
          my $latin = uc $self->{'.charset'} eq 'ISO-8859-1' ||
                      uc $self->{'.charset'} eq 'WINDOWS-1252';
          if ($latin) {  # bug in some browsers
+                $toencode =~ s{'}{&#39;}gso;
                 $toencode =~ s{\x8b}{&#139;}gso;
                 $toencode =~ s{\x9b}{&#155;}gso;
                 if (defined $newlinestoo && $newlinestoo) {
@@ -1994,10 +2028,10 @@ sub radio_group {
 	my($checkit) = $checked eq $_ ? qq/ checked/ : '';
 	my($break);
 	if ($linebreak) {
-    $break = $XHTML ? "<br />" : "<br>";
+          $break = $XHTML ? "<br />" : "<br>";
 	}
 	else {
-	$break = '';
+	  $break = '';
 	}
 	my($label)='';
 	unless (defined($nolabels) && $nolabels) {
@@ -2156,7 +2190,7 @@ sub hidden {
     $name=$self->escapeHTML($name);
     foreach (@value) {
 	$_ = defined($_) ? $self->escapeHTML($_,1) : '';
-	push @result,$XHTMl ? qq(<input type="hidden" name="$name" value="$_" />)
+	push @result,$XHTML ? qq(<input type="hidden" name="$name" value="$_" />)
                             : qq(<input type="hidden" name="$name" value="$_">);
     }
     return wantarray ? @result : join('',@result);
@@ -2306,7 +2340,7 @@ sub cookie {
     }
 
     # If we get here, we're creating a new cookie
-    return undef unless $name;	# this is an error
+    return undef unless defined($name) && $name ne '';	# this is an error
 
     my @param;
     push(@param,'-name'=>$name);
@@ -2975,7 +3009,7 @@ sub asString {
     my $self = shift;
     # get rid of package name
     (my $i = $$self) =~ s/^\*(\w+::fh\d{5})+//; 
-    $i =~ s/\\(.)/$1/g;
+    $i =~ s/%(..)/ chr(hex($1)) /eg;
     return $i;
 # BEGIN DEAD CODE
 # This was an extremely clever patch that allowed "use strict refs".
@@ -3000,7 +3034,8 @@ END_OF_FUNC
 sub new {
     my($pack,$name,$file,$delete) = @_;
     require Fcntl unless defined &Fcntl::O_RDWR;
-    my $fv = ++$FH . quotemeta($name);
+    (my $safename = $name) =~ s/([':%])/ sprintf '%%%02X', ord $1 /eg;
+    my $fv = ++$FH . $safename;
     my $ref = \*{"Fh::$fv"};
     sysopen($ref,$file,Fcntl::O_RDWR()|Fcntl::O_CREAT()|Fcntl::O_EXCL(),0600) || return;
     unlink($file) if $delete;
@@ -3274,7 +3309,8 @@ unless ($TMPDIRECTORY) {
     @TEMP=("${SL}usr${SL}tmp","${SL}var${SL}tmp",
 	   "C:${SL}temp","${SL}tmp","${SL}temp",
 	   "${vol}${SL}Temporary Items",
-           "${SL}WWW_ROOT", "${SL}SYS\$SCRATCH", "C:${SL}system${SL}temp");
+           "${SL}WWW_ROOT", "${SL}SYS\$SCRATCH",
+	   "C:${SL}system${SL}temp");
     unshift(@TEMP,$ENV{'TMPDIR'}) if exists $ENV{'TMPDIR'};
 
     # this feature was supposed to provide per-user tmpfiles, but
@@ -3313,7 +3349,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;
 }
@@ -4348,7 +4384,7 @@ The B<-lang> argument is used to incorporate a language attribute into
 the <HTML> tag.  The default if not specified is "en-US" for US
 English.  For example:
 
-    print $q->header(-lang=>'fr-CA');
+    print $q->start_html(-lang=>'fr-CA');
 
 You can place other arbitrary HTML elements to the <HEAD> section with the
 B<-head> tag.  For example, to place the rarely-used <LINK> element in the
@@ -4370,8 +4406,8 @@ array reference:
 
 And here's how to create an HTTP-EQUIV <META> tag:
 
-      print header(-head=>meta({-http_equiv => 'Content-Type',
-                                -content    => 'text/html'}))
+      print start_html(-head=>meta({-http_equiv => 'Content-Type',
+                                    -content    => 'text/html'}))
 
 
 JAVASCRIPTING: The B<-script>, B<-noScript>, B<-onLoad>,
@@ -6238,7 +6274,7 @@ in the B<header()> and B<redirect()>  statements:
 
 =head1 Server Push
 
-CGI.pm provides three simple functions for producing multipart
+CGI.pm provides four simple functions for producing multipart
 documents of the type needed to implement server push.  These
 functions were graciously provided by Ed Jordan <ed@fidalgo.net>.  To
 import these into your namespace, you must import the ":push" set.
@@ -6250,19 +6286,25 @@ Here is a simple script that demonstrates server push:
   #!/usr/local/bin/perl
   use CGI qw/:push -nph/;
   $| = 1;
-  print multipart_init(-boundary=>'----------------here we go!');
-  while (1) {
+  print multipart_init(-boundary=>'----here we go!');
+  foreach (0 .. 4) {
       print multipart_start(-type=>'text/plain'),
-            "The current time is ",scalar(localtime),"\n",
-            multipart_end;
+            "The current time is ",scalar(localtime),"\n";
+      if ($_ < 4) {
+              print multipart_end;
+      } else {
+              print multipart_final;
+      }
       sleep 1;
   }
 
 This script initializes server push by calling B<multipart_init()>.
-It then enters an infinite loop in which it begins a new multipart
-section by calling B<multipart_start()>, prints the current local time,
+It then enters a loop in which it begins a new multipart section by
+calling B<multipart_start()>, prints the current local time,
 and ends a multipart section with B<multipart_end()>.  It then sleeps
-a second, and begins again.
+a second, and begins again. On the final iteration, it ends the
+multipart section with B<multipart_final()> rather than with
+B<multipart_end()>.
 
 =over 4
 
@@ -6286,13 +6328,24 @@ type.  If not specified, text/html is assumed.
   multipart_end()
 
 End a part.  You must remember to call multipart_end() once for each
-multipart_start().
+multipart_start(), except at the end of the last part of the multipart
+document when multipart_final() should be called instead of multipart_end().
+
+=item multipart_final()
+
+  multipart_final()
+
+End all parts.  You should call multipart_final() rather than
+multipart_end() at the end of the last part of the multipart document.
 
 =back
 
 Users interested in server push applications should also have a look
 at the CGI::Push module.
 
+Only Netscape Navigator supports server push.  Internet Explorer
+browsers do not.
+
 =head1 Avoiding Denial of Service Attacks
 
 A potential problem with CGI.pm is that, by default, it attempts to
diff --git a/lib/CGI/Carp.pm b/lib/CGI/Carp.pm
index 5aea1985ec..3af2e9f221 100644
--- a/lib/CGI/Carp.pm
+++ b/lib/CGI/Carp.pm
@@ -71,9 +71,9 @@ compiler errors will be caught.  Example:
 
 carpout() does not handle file locking on the log for you at this point.
 
-The real STDERR is not closed -- it is moved to SAVEERR.  Some
+The real STDERR is not closed -- it is moved to CGI::Carp::SAVEERR.  Some
 servers, when dealing with CGI scripts, close their connection to the
-browser when the script closes STDOUT and STDERR.  SAVEERR is used to
+browser when the script closes STDOUT and STDERR.  CGI::Carp::SAVEERR is there to
 prevent this from happening prematurely.
 
 You can pass filehandles to carpout() in a variety of ways.  The "correct"
diff --git a/lib/CGI/Cookie.pm b/lib/CGI/Cookie.pm
index 6737832080..de91be2780 100644
--- a/lib/CGI/Cookie.pm
+++ b/lib/CGI/Cookie.pm
@@ -13,7 +13,7 @@ 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.16';
+$CGI::Cookie::VERSION='1.18';
 
 use CGI::Util qw(rearrange unescape escape);
 use overload '""' => \&as_string,
@@ -57,61 +57,67 @@ sub raw_fetch {
     return %results;
 }
 
-sub parse {
-    my ($self,$raw_cookie) = @_;
-    my %results;
 
-    my(@pairs) = split("; ?",$raw_cookie);
-    foreach (@pairs) {
-      s/\s*(.*?)\s*/$1/;
-      my($key,$value) = split("=");
-      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);
+sub parse {
+  my ($self,$raw_cookie) = @_;
+  my %results;
+
+  my(@pairs) = split("; ?",$raw_cookie);
+  foreach (@pairs) {
+    s/\s*(.*?)\s*/$1/;
+    my($key,$value) = split("=");
+
+    # Some foreign cookies are not in name=value format, so ignore
+    # them.
+    next if !defined($value);
+    my @values = ();
+    if ($value ne '') {
+      @values = map CGI::unescape($_),split(/[&;]/,$value.'&dmy');
+      pop @values;
     }
-    return \%results unless wantarray;
-    return %results;
+    $key = unescape($key);
+    # 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);
+  }
+  return \%results unless wantarray;
+  return %results;
 }
 
 sub new {
-    my $class = shift;
-    $class = ref($class) if ref($class);
-    my($name,$value,$path,$domain,$secure,$expires) =
-      rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@_);
-
-    # Pull out our parameters.
-    my @values;
-    if (ref($value)) {
-	if (ref($value) eq 'ARRAY') {
-	    @values = @$value;
-	} elsif (ref($value) eq 'HASH') {
-	    @values = %$value;
-	}
-    } else {
-	@values = ($value);
+  my $class = shift;
+  $class = ref($class) if ref($class);
+  my($name,$value,$path,$domain,$secure,$expires) =
+    rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@_);
+  
+  # Pull out our parameters.
+  my @values;
+  if (ref($value)) {
+    if (ref($value) eq 'ARRAY') {
+      @values = @$value;
+    } elsif (ref($value) eq 'HASH') {
+      @values = %$value;
     }
-
-    bless my $self = {
-	'name'=>$name,
-	'value'=>[@values],
-	},$class;
-
-    # IE requires the path and domain to be present for some reason.
-    $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;
-
-    $self->path($path)     if defined $path;
-    $self->domain($domain) if defined $domain;
-    $self->secure($secure) if defined $secure;
-    $self->expires($expires) if defined $expires;
-    return $self;
+  } else {
+    @values = ($value);
+  }
+  
+  bless my $self = {
+		    'name'=>$name,
+		    'value'=>[@values],
+		   },$class;
+
+  # IE requires the path and domain to be present for some reason.
+  $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;
+
+  $self->path($path)     if defined $path;
+  $self->domain($domain) if defined $domain;
+  $self->secure($secure) if defined $secure;
+  $self->expires($expires) if defined $expires;
+  return $self;
 }
 
 sub as_string {
@@ -123,7 +129,7 @@ sub as_string {
     push(@constant_values,"domain=$domain") if $domain = $self->domain;
     push(@constant_values,"path=$path") if $path = $self->path;
     push(@constant_values,"expires=$expires") if $expires = $self->expires;
-    push(@constant_values,'secure') if $secure = $self->secure;
+    push(@constant_values,"secure") if $secure = $self->secure;
 
     my($key) = escape($self->name);
     my($cookie) = join("=",$key,join("&",map escape($_),$self->value));
diff --git a/lib/CGI/Pretty.pm b/lib/CGI/Pretty.pm
index d348807d68..a26ab81d26 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.04';
+$CGI::Pretty::VERSION = '1.05';
 $CGI::DefaultClass = __PACKAGE__;
 $CGI::Pretty::AutoloadClass = 'CGI';
 @CGI::Pretty::ISA = qw( CGI );
@@ -30,14 +30,14 @@ sub _prettyPrint {
 	    return;
 	}
     }
-    $$input =~ s/$CGI::Pretty::LINEBREAK/$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT/g;
+    $$input =~ s/$CGI::Pretty::LINEBREAK/$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT/g if $CGI::Pretty::LINEBREAK; 
 }
 
 sub comment {
     my($self,@p) = CGI::self_or_CGI(@_);
 
     my $s = "@p";
-    $s =~ s/$CGI::Pretty::LINEBREAK/$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT/g; 
+    $s =~ s/$CGI::Pretty::LINEBREAK/$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT/g if $CGI::Pretty::LINEBREAK; 
     
     return $self->SUPER::comment( "$CGI::Pretty::LINEBREAK$CGI::Pretty::INDENT$s$CGI::Pretty::LINEBREAK" ) . $CGI::Pretty::LINEBREAK;
 }
@@ -66,6 +66,7 @@ sub _make_tag_func {
                     (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);
@@ -86,7 +87,7 @@ sub _make_tag_func {
 		\@result = map { 
 		    chomp; 
 		    if ( \$_ !~ /<\\// ) {
-			s/\$CGI::Pretty::LINEBREAK/\$CGI::Pretty::LINEBREAK\$CGI::Pretty::INDENT/g; 
+			s/\$CGI::Pretty::LINEBREAK/\$CGI::Pretty::LINEBREAK\$CGI::Pretty::INDENT/g if \$CGI::Pretty::LINEBREAK; 
 		    } 
 		    else {
 			my \$tmp = \$_;
diff --git a/lib/CGI/Push.pm b/lib/CGI/Push.pm
index 83002f2336..9e72abda55 100644
--- a/lib/CGI/Push.pm
+++ b/lib/CGI/Push.pm
@@ -7,7 +7,7 @@ package CGI::Push;
 # documentation in manual or html file format (these utilities are part of the
 # Perl 5 distribution).
 
-# Copyright 1995,1996, Lincoln D. Stein.  All rights reserved.
+# Copyright 1995-2000, Lincoln D. Stein.  All rights reserved.
 # It may be used and modified freely, but I do request that this copyright
 # notice remain attached to the file.  You may modify this module as you 
 # wish, but if you redistribute a modified version, please attach a note
@@ -16,7 +16,7 @@ package CGI::Push;
 # The most recent version and complete docs are available at:
 #   http://stein.cshl.org/WWW/software/CGI/
 
-$CGI::Push::VERSION='1.03';
+$CGI::Push::VERSION='1.04';
 use CGI;
 use CGI::Util 'rearrange';
 @ISA = ('CGI');
@@ -33,71 +33,78 @@ sub do_push {
     # unbuffer output
     $| = 1;
     srand;
-    my ($random) = sprintf("%16.0f",rand()*1E16);
-    my ($boundary) = "----------------------------------$random";
+    my ($random) = sprintf("%08.0f",rand()*1E8);
+    my ($boundary) = "----=_NeXtPaRt$random";
 
     my (@header);
-    my ($type,$callback,$delay,$last_page,$cookie,$target,$expires,@other) =
-	rearrange([TYPE,NEXT_PAGE,DELAY,LAST_PAGE,[COOKIE,COOKIES],TARGET,EXPIRES],@p);
+    my ($type,$callback,$delay,$last_page,$cookie,$target,$expires,$nph,@other) = rearrange([TYPE,NEXT_PAGE,DELAY,LAST_PAGE,[COOKIE,COOKIES],TARGET,EXPIRES,NPH],@p);
     $type = 'text/html' unless $type;
     $callback = \&simple_counter unless $callback && ref($callback) eq 'CODE';
     $delay = 1 unless defined($delay);
     $self->push_delay($delay);
+    $nph = 1 unless defined($nph);
 
     my(@o);
     foreach (@other) { push(@o,split("=")); }
     push(@o,'-Target'=>$target) if defined($target);
     push(@o,'-Cookie'=>$cookie) if defined($cookie);
-    push(@o,'-Type'=>"multipart/x-mixed-replace; boundary=$boundary");
-    push(@o,'-Server'=>"CGI.pm Push Module");
+    push(@o,'-Type'=>"multipart/x-mixed-replace;boundary=\"$boundary\"");
+    push(@o,'-Server'=>"CGI.pm Push Module") if $nph;
     push(@o,'-Status'=>'200 OK');
-    push(@o,'-nph'=>1);
+    push(@o,'-nph'=>1) if $nph;
     print $self->header(@o);
-    print "${boundary}$CGI::CRLF";
+
+    $boundary = "$CGI::CRLF--$boundary";
+
+    print "WARNING: YOUR BROWSER DOESN'T SUPPORT THIS SERVER-PUSH TECHNOLOGY.${boundary}$CGI::CRLF";
+
+    my (@contents) = &$callback($self,++$COUNTER);
 
     # now we enter a little loop
-    my @contents;
     while (1) {
-	last unless (@contents = &$callback($self,++$COUNTER)) && defined($contents[0]);
-	print "Content-type: ${type}$CGI::CRLF$CGI::CRLF" 
-	    unless $type =~ /^dynamic|heterogeneous$/i;
-	print @contents,"$CGI::CRLF";
-	print "${boundary}$CGI::CRLF";
-	do_sleep($self->push_delay()) if $self->push_delay();
-    }
-
-    # Optional last page
-    if ($last_page && ref($last_page) eq 'CODE') {
-	print "Content-type: ${type}$CGI::CRLF$CGI::CRLF" unless $type =~ /^dynamic|heterogeneous$/i;
-	print  &$last_page($self,$COUNTER),"$CGI::CRLF${boundary}$CGI::CRLF";
+        print "Content-type: ${type}$CGI::CRLF$CGI::CRLF" unless $type =~ /^dynamic|heterogeneous$/i;
+        print @contents;
+        @contents = &$callback($self,++$COUNTER);
+        if ((@contents) && defined($contents[0])) {
+            print "${boundary}$CGI::CRLF";
+            do_sleep($self->push_delay()) if $self->push_delay();
+        } else {
+            if ($last_page && ref($last_page) eq 'CODE') {
+                print "${boundary}$CGI::CRLF";
+                do_sleep($self->push_delay()) if $self->push_delay();
+                print "Content-type: ${type}$CGI::CRLF$CGI::CRLF" unless $type =~ /^dynamic|heterogeneous$/i;
+                print  &$last_page($self,$COUNTER);
+            }
+            print "${boundary}--$CGI::CRLF";
+            last;
+        }
     }
+    print "WARNING: YOUR BROWSER DOESN'T SUPPORT THIS SERVER-PUSH TECHNOLOGY.$CGI::CRLF";
 }
 
 sub simple_counter {
     my ($self,$count) = @_;
-    return (
-	    CGI->start_html("CGI::Push Default Counter"),
-	    CGI->h1("CGI::Push Default Counter"),
-	    "This page has been updated ",CGI->strong($count)," times.",
-	    CGI->hr(),
-	    CGI->a({'-href'=>'http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html'},'CGI.pm home page'),
-	    CGI->end_html
-	    );
+    return $self->start_html("CGI::Push Default Counter"),
+           $self->h1("CGI::Push Default Counter"),
+           "This page has been updated ",$self->strong($count)," times.",
+           $self->hr(),
+           $self->a({'-href'=>'http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html'},'CGI.pm home page'),
+           $self->end_html;
 }
 
 sub do_sleep {
     my $delay = shift;
     if ( ($delay >= 1) && ($delay!~/\./) ){
-	sleep($delay);
+        sleep($delay);
     } else {
-	select(undef,undef,undef,$delay);
+        select(undef,undef,undef,$delay);
     }
 }
 
 sub push_delay {
-   my ($self,$delay) = CGI::self_or_default(@_);
-   return defined($delay) ? $self->{'.delay'} = 
-	$delay : $self->{'.delay'};
+    my ($self,$delay) = CGI::self_or_default(@_);
+    return defined($delay) ? $self->{'.delay'} = 
+        $delay : $self->{'.delay'};
 }
 
 1;
@@ -118,18 +125,18 @@ CGI::Push - Simple Interface to Server Push
         my($q,$counter) = @_;
         return undef if $counter >= 10;
         return start_html('Test'),
-  	       h1('Visible'),"\n",
+               h1('Visible'),"\n",
                "This page has been called ", strong($counter)," times",
                end_html();
-      }
+    }
 
-     sub last_page {
-	 my($q,$counter) = @_;
-         return start_html('Done'),
-                h1('Finished'),
-                strong($counter),' iterations.',
-                end_html;
-     }
+    sub last_page {
+        my($q,$counter) = @_;
+        return start_html('Done'),
+               h1('Finished'),
+               strong($counter - 1),' iterations.',
+               end_html;
+    }
 
 =head1 DESCRIPTION
 
@@ -189,7 +196,7 @@ redrawing loop and print out the final page (if any)
         return undef if $counter > 100;
         return start_html('testing'),
                h1('testing'),
-	       "This page called $counter times";
+               "This page called $counter times";
     }
 
 You are of course free to refer to create and use global variables
@@ -220,11 +227,13 @@ refresh the page faster.  Fractional values are allowed.
 
 B<If not specified, -delay will default to 1 second>
 
-=item -cookie, -target, -expires
+=item -cookie, -target, -expires, -nph
 
 These have the same meaning as the like-named parameters in
 CGI::header().
 
+If not specified, -nph will default to 1 (as needed for many servers, see below).
+
 =back
 
 =head2 Heterogeneous Pages
@@ -241,9 +250,9 @@ look like this:
     sub my_draw_routine {
         my($q,$counter) = @_;
         return header('text/html'),   # note we're producing the header here
-	       start_html('testing'),
+               start_html('testing'),
                h1('testing'),
-	       "This page called $counter times";
+               "This page called $counter times";
     }
 
 You can add any header fields that you like, but some (cookies and
@@ -255,21 +264,21 @@ as shown below:
 
     sub my_draw_routine {
         my($q,$counter) = @_;
-	return undef if $counter > 10;
+        return undef if $counter > 10;
         return header('text/html'),   # note we're producing the header here
-	       start_html('testing'),
+               start_html('testing'),
                h1('testing'),
-	       "This page called $counter times";
+               "This page called $counter times";
     }
 
     sub my_last_page {
-	header(-refresh=>'5; URL=http://somewhere.else/finished.html',
-	       -type=>'text/html'),
-        start_html('Moved'),
-        h1('This is the last page'),
-	'Goodbye!'
-         hr,	
-         end_html; 
+        return header(-refresh=>'5; URL=http://somewhere.else/finished.html',
+                      -type=>'text/html'),
+               start_html('Moved'),
+               h1('This is the last page'),
+               'Goodbye!'
+               hr,
+               end_html; 
     }
 
 =head2 Changing the Page Delay on the Fly
@@ -283,13 +292,18 @@ parameters, push_delay() just returns the current delay.
 
 =head1 INSTALLING CGI::Push SCRIPTS
 
-Server push scripts B<must> be installed as no-parsed-header (NPH)
-scripts in order to work correctly.  On Unix systems, this is most
-often accomplished by prefixing the script's name with "nph-".  
+Server push scripts must be installed as no-parsed-header (NPH)
+scripts in order to work correctly on many servers.  On Unix systems,
+this is most often accomplished by prefixing the script's name with "nph-".  
 Recognition of NPH scripts happens automatically with WebSTAR and 
 Microsoft IIS.  Users of other servers should see their documentation
 for help.
 
+Apache web server from version 1.3b2 on does not need server
+push scripts installed as NPH scripts: the -nph parameter to do_push()
+may be set to a false value to disable the extra headers needed by an
+NPH script.
+
 =head1 AUTHOR INFORMATION
 
 Copyright 1995-1998, Lincoln D. Stein.  All rights reserved.  
diff --git a/lib/CGI/Util.pm b/lib/CGI/Util.pm
index 0049667745..aba0ba5834 100644
--- a/lib/CGI/Util.pm
+++ b/lib/CGI/Util.pm
@@ -140,6 +140,7 @@ sub unescape {
   my $todecode = shift;
   return undef unless defined($todecode);
   $todecode =~ tr/+/ /;       # pluses become spaces
+    $EBCDIC = "\t" ne "\011";
     if ($EBCDIC) {
       $todecode =~ s/%([0-9a-fA-F]{2})/chr $A2E[hex($1)]/ge;
     } else {
@@ -221,3 +222,37 @@ sub expire_calc {
 }
 
 1;
+
+__END__
+
+=head1 NAME
+
+CGI::Util - Internal utilities used by CGI module
+
+=head1 SYNOPSIS
+
+none
+
+=head1 DESCRIPTION
+
+no public subroutines
+
+=head1 AUTHOR INFORMATION
+
+Copyright 1995-1998, Lincoln D. Stein.  All rights reserved.  
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+Address bug reports and comments to: lstein@cshl.org.  When sending
+bug reports, please provide the version of CGI.pm, the version of
+Perl, the name and version of your Web server, and the name and
+version of the operating system you are using.  If the problem is even
+remotely browser dependent, please provide information about the
+affected browers as well.
+
+=head1 SEE ALSO
+
+L<CGI>
+
+=cut
diff --git a/t/lib/cgi-form.t b/t/lib/cgi-form.t
index 6bdd7dec53..2922903499 100755
--- a/t/lib/cgi-form.t
+++ b/t/lib/cgi-form.t
@@ -24,6 +24,15 @@ sub test {
     print($true ? "ok $num\n" : "not ok $num $msg\n");
 }
 
+my $CRLF = "\015\012";
+if ($^O eq 'VMS') { 
+    $CRLF = "\n";  # via web server carriage is inserted automatically
+}
+if (ord("\t") != 9) { # EBCDIC?
+    $CRLF = "\r\n";
+}
+
+
 # Set up a CGI environment
 $ENV{REQUEST_METHOD}='GET';
 $ENV{QUERY_STRING}  ='game=chess&game=checkers&weather=dull';
diff --git a/t/lib/cgi-html.t b/t/lib/cgi-html.t
index 3d3da10b25..93e5dac648 100755
--- a/t/lib/cgi-html.t
+++ b/t/lib/cgi-html.t
@@ -49,11 +49,12 @@ test(7,h1({-align=>'CENTER'},['fred','agnes']) eq
 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${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; charset=ISO-8859-1${CRLF}${CRLF}","header()");
+test(12,header(-nph=>1) =~ m!HTTP/1.0 200 OK${CRLF}Server: cmdline${CRLF}Date:.+${CRLF}Content-Type: text/html; charset=ISO-8859-1${CRLF}${CRLF}!,"header()");
 test(13,start_html() ."\n" eq <<END,"start_html()");
+<?xml version="1.0" encoding="utf-8"?>
 <!DOCTYPE html
-	PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
-	"DTD/xhtml1-transitional.dtd">
+	PUBLIC "-//W3C//DTD XHTML Basic 1.0//EN"
+	"http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd">
 <html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"><head><title>Untitled Document</title>
 </head><body>
 END
@@ -66,9 +67,10 @@ 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()");
+<?xml version="1.0" encoding="utf-8"?>
 <!DOCTYPE html
-	PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
-	"DTD/xhtml1-transitional.dtd">
+	PUBLIC "-//W3C//DTD XHTML Basic 1.0//EN"
+	"http://www.w3.org/TR/xhtml-basic/xhtml-basic10.dtd">
 <html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"><head><title>The world of foo</title>
 </head><body>
 END