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

5 files changed, 175 insertions, 119 deletions

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