add CGI-2.42, its and testsuite

p4raw-id: //depot/perl@1223

5 files changed, 612 insertions, 39 deletions

diff --git a/lib/CGI/Apache.pm b/lib/CGI/Apache.pm
index 61b55f5205..eed3e55c51 100644
--- a/lib/CGI/Apache.pm
+++ b/lib/CGI/Apache.pm
@@ -4,7 +4,7 @@ use vars qw(@ISA $VERSION);
 require CGI;
 @ISA = qw(CGI);
 
-$VERSION = (qw$Revision: 1.01 $)[1];
+$VERSION = (qw$Revision: 1.1 $)[1];
 $CGI::DefaultClass = 'CGI::Apache';
 $CGI::Apache::AutoloadClass = 'CGI';
 
@@ -98,6 +98,6 @@ perl(1), Apache(3), CGI(3)
 
 =head1 AUTHOR
 
-Doug MacEachern E<lt>dougm@osf.orgE<gt>, hacked over by Andreas König E<lt>a.koenig@mind.deE<gt>, modified by Lincoln Stein <lt>lstein@genome.wi.mit.edu<gt>
+Doug MacEachern E<lt>dougm@osf.orgE<gt>, hacked over by Andreas KE<ouml>nig E<lt>a.koenig@mind.deE<gt>, modified by Lincoln Stein <lt>lstein@genome.wi.mit.edu<gt>
 
 =cut
diff --git a/lib/CGI/Carp.pm b/lib/CGI/Carp.pm
index 4cd79467fd..9b67d76d00 100644
--- a/lib/CGI/Carp.pm
+++ b/lib/CGI/Carp.pm
@@ -87,6 +87,8 @@ accepted as well:
 
     ... and so on
 
+FileHandle and other objects work as well.
+
 Use of carpout() is not great for performance, so it is recommended
 for debugging purposes or for moderate-use applications.  A future
 version of this module may delay redirecting STDERR until one of the
@@ -106,6 +108,34 @@ occur in the early compile phase will be seen.
 Nonfatal errors will still be directed to the log file only (unless redirected
 with carpout).
 
+=head2 Changing the default message
+
+By default, the software error message is followed by a note to
+contact the Webmaster by e-mail with the time and date of the error.
+If this message is not to your liking, you can change it using the
+set_message() routine.  This is not imported by default; you should
+import it on the use() line:
+
+    use CGI::Carp qw(fatalsToBrowser set_message);
+    set_message("It's not a bug, it's a feature!");
+
+You may also pass in a code reference in order to create a custom
+error message.  At run time, your code will be called with the text
+of the error message that caused the script to die.  Example:
+
+    use CGI::Carp qw(fatalsToBrowser set_message);
+    BEGIN {
+       sub handle_errors {
+          my $msg = shift;
+          print "<h1>Oh gosh</h1>";
+          print "Got an error: $msg";
+      }
+      set_message(\&handle_errors);
+    }
+
+In order to correctly intercept compile-time errors, you should call
+set_message() from within a BEGIN{} block.
+
 =head1 CHANGE LOG
 
 1.05 carpout() added and minor corrections by Marc Hedlund
@@ -114,6 +144,17 @@ with carpout).
 1.06 fatalsToBrowser() no longer aborts for fatal errors within
      eval() statements.
 
+1.08 set_message() added and carpout() expanded to allow for FileHandle
+     objects.
+
+1.09 set_message() now allows users to pass a code REFERENCE for 
+     really custom error messages.  croak and carp are now
+     exported by default.  Thanks to Gunther Birznieks for the
+     patches.
+
+1.10 Patch from Chris Dean (ctdean@cogit.com) to allow 
+     module to run correctly under mod_perl.
+
 =head1 AUTHORS
 
 Lincoln D. Stein <lstein@genome.wi.mit.edu>.  Feel free to redistribute
@@ -133,18 +174,19 @@ use Carp;
 
 @ISA = qw(Exporter);
 @EXPORT = qw(confess croak carp);
-@EXPORT_OK = qw(carpout fatalsToBrowser);
+@EXPORT_OK = qw(carpout fatalsToBrowser wrap set_message);
 
 $main::SIG{__WARN__}=\&CGI::Carp::warn;
 $main::SIG{__DIE__}=\&CGI::Carp::die;
-$CGI::Carp::VERSION = '1.06';
+$CGI::Carp::VERSION = '1.10';
+$CGI::Carp::CUSTOM_MSG = undef;
 
 # fancy import routine detects and handles 'errorWrap' specially.
 sub import {
     my $pkg = shift;
     my(%routines);
-    grep($routines{$_}++,@_);
-    $WRAP++ if $routines{'fatalsToBrowser'};
+    grep($routines{$_}++,@_,@EXPORT);
+    $WRAP++ if $routines{'fatalsToBrowser'} || $routines{'wrap'};
     my($oldlevel) = $Exporter::ExportLevel;
     $Exporter::ExportLevel = 1;
     Exporter::import($pkg,keys %routines);
@@ -183,18 +225,32 @@ sub warn {
     realwarn $message;
 }
 
+# The mod_perl package Apache::Registry loads CGI programs by calling
+# eval.  These evals don't count when looking at the stack backtrace.
+sub _longmess {
+    my $message = Carp::longmess();
+    my $mod_perl = ($ENV{'GATEWAY_INTERFACE'} 
+                    && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-Perl\//);
+    $message =~ s,eval[^\n]+Apache/Registry\.pm.*,,s if $mod_perl;
+    return( $message );    
+}
+
 sub die {
     my $message = shift;
     my $time = scalar(localtime);
     my($file,$line,$id) = id(1);
-    return undef if $file=~/^\(eval/;
     $message .= " at $file line $line.\n" unless $message=~/\n$/;
-    &fatalsToBrowser($message) if $WRAP;
+    &fatalsToBrowser($message) if $WRAP && _longmess() !~ /eval [{\']/m;
     my $stamp = stamp;
     $message=~s/^/$stamp/gm;
     realdie $message;
 }
 
+sub set_message {
+    $CGI::Carp::CUSTOM_MSG = shift;
+    return $CGI::Carp::CUSTOM_MSG;
+}
+
 # Avoid generating "subroutine redefined" warnings with the following
 # hack:
 {
@@ -211,14 +267,8 @@ EOF
 # or a string.
 sub carpout {
     my($in) = @_;
-    $in = $$in if ref($in); # compatability with Marc's method;
-    my($no) = fileno($in);
-    unless (defined($no)) {
-	my($package) = caller;
-	my($handle) = $in=~/[':]/ ? $in : "$package\:\:$in"; 
-	$no = fileno($handle);
-    }
-    die "Invalid filehandle $in\n" unless $no;
+    my($no) = fileno(to_filehandle($in));
+    die "Invalid filehandle $in\n" unless defined $no;
     
     open(SAVEERR, ">&STDERR");
     open(STDERR, ">&$no") or 
@@ -230,13 +280,51 @@ sub fatalsToBrowser {
     my($msg) = @_;
     $msg=~s/>/&gt;/g;
     $msg=~s/</&lt;/g;
+    $msg=~s/&/&amp;/g;
+    $msg=~s/\"/&quot;/g;
+    my($wm) = $ENV{SERVER_ADMIN} ? 
+	qq[the webmaster (<a href="mailto:$ENV{SERVER_ADMIN}">$ENV{SERVER_ADMIN}</a>)] :
+	"this site's webmaster";
+    my ($outer_message) = <<END;
+For help, please send mail to $wm, giving this error message 
+and the time and date of the error.
+END
+    ;
     print STDOUT "Content-type: text/html\n\n";
+
+    if ($CUSTOM_MSG) {
+	if (ref($CUSTOM_MSG) eq 'CODE') {
+	    &$CUSTOM_MSG($msg); # nicer to perl 5.003 users
+	    return;
+	} else {
+	    $outer_message = $CUSTOM_MSG;
+	}
+    }
+    
     print STDOUT <<END;
 <H1>Software error:</H1>
 <CODE>$msg</CODE>
 <P>
-Please send mail to this site's webmaster for help.
+$outer_message;
 END
+    ;
+}
+
+# Cut and paste from CGI.pm so that we don't have the overhead of
+# always loading the entire CGI module.
+sub to_filehandle {
+    my $thingy = shift;
+    return undef unless $thingy;
+    return $thingy if UNIVERSAL::isa($thingy,'GLOB');
+    return $thingy if UNIVERSAL::isa($thingy,'FileHandle');
+    if (!ref($thingy)) {
+	my $caller = 1;
+	while (my $package = caller($caller++)) {
+	    my($tmp) = $thingy=~/[\':]/ ? $thingy : "$package\:\:$thingy"; 
+	    return $tmp if defined(fileno($tmp));
+	}
+    }
+    return undef;
 }
 
 1;
diff --git a/lib/CGI/Cookie.pm b/lib/CGI/Cookie.pm
new file mode 100644
index 0000000000..c32891a331
--- /dev/null
+++ b/lib/CGI/Cookie.pm
@@ -0,0 +1,418 @@
+package CGI::Cookie;
+
+# See the bottom of this file for the POD documentation.  Search for the
+# string '=head'.
+
+# You can run this file through either pod2man or pod2html to produce pretty
+# 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.
+# 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
+# listing the modifications you have made.
+
+# The most recent version and complete docs are available at:
+#   http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
+#   ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
+
+$CGI::Cookie::VERSION='1.06';
+
+use CGI;
+use overload '""' => \&as_string,
+    'cmp' => \&compare,
+    'fallback'=>1;
+
+# fetch a list of cookies from the environment and
+# return as a hash.  the cookies are parsed as normal
+# escaped URL data.
+sub fetch {
+    my $class = shift;
+    my $raw_cookie = $ENV{HTTP_COOKIE} || $ENV{COOKIE};
+    return () unless $raw_cookie;
+    return $class->parse($raw_cookie);
+}
+
+# fetch a list of cookies from the environment and
+# return as a hash.  the cookie values are not unescaped
+# or altered in any way.
+sub raw_fetch {
+    my $class = shift;
+    my $raw_cookie = $ENV{HTTP_COOKIE} || $ENV{COOKIE};
+    return () unless $raw_cookie;
+    my %results;
+    my($key,$value);
+
+    my(@pairs) = split("; ",$raw_cookie);
+    foreach (@pairs) {
+	if (/^([^=]+)=(.*)/) {
+	    $key = $1;
+	    $value = $2;
+	}
+	else {
+	    $key = $_;
+	    $value = '';
+	}
+	$results{$key} = $value;
+    }
+    return \%results unless wantarray;
+    return %results;
+}
+
+sub parse {
+    my ($self,$raw_cookie) = @_;
+    my %results;
+
+    my(@pairs) = split("; ",$raw_cookie);
+    foreach (@pairs) {
+	my($key,$value) = split("=");
+	my(@values) = map CGI::unescape($_),split('&',$value);
+	$key = CGI::unescape($key);
+	$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) =
+	CGI->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);
+    }
+
+    bless my $self = {
+	'name'=>$name,
+	'value'=>[@values],
+	},$class;
+
+    # IE requires the path to be present for some reason.
+    ($path = $ENV{'SCRIPT_NAME'})=~s![^/]+$!! unless $path;
+
+    $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 {
+    my $self = shift;
+    return "" unless $self->name;
+
+    my(@constant_values,$domain,$path,$expires,$secure);
+
+    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;
+
+    my($key) = CGI::escape($self->name);
+    my($cookie) = join("=",$key,join("&",map CGI::escape($_),$self->value));
+    return join("; ",$cookie,@constant_values);
+}
+
+sub compare {
+    my $self = shift;
+    my $value = shift;
+    return "$self" cmp $value;
+}
+
+# accessors
+sub name {
+    my $self = shift;
+    my $name = shift;
+    $self->{'name'} = $name if defined $name;
+    return $self->{'name'};
+}
+
+sub value {
+    my $self = shift;
+    my $value = shift;
+    $self->{'value'} = $value if defined $value;
+    return wantarray ? @{$self->{'value'}} : $self->{'value'}->[0]
+}
+
+sub domain {
+    my $self = shift;
+    my $domain = shift;
+    $self->{'domain'} = $domain if defined $domain;
+    return $self->{'domain'};
+}
+
+sub secure {
+    my $self = shift;
+    my $secure = shift;
+    $self->{'secure'} = $secure if defined $secure;
+    return $self->{'secure'};
+}
+
+sub expires {
+    my $self = shift;
+    my $expires = shift;
+    $self->{'expires'} = CGI::expires($expires,'cookie') if defined $expires;
+    return $self->{'expires'};
+}
+
+sub path {
+    my $self = shift;
+    my $path = shift;
+    $self->{'path'} = $path if defined $path;
+    return $self->{'path'};
+}
+
+1;
+
+=head1 NAME
+
+CGI::Cookie - Interface to Netscape Cookies
+
+=head1 SYNOPSIS
+
+    use CGI qw/:standard/;
+    use CGI::Cookie;
+
+    # Create new cookies and send them
+    $cookie1 = new CGI::Cookie(-name=>'ID',-value=>123456);
+    $cookie2 = new CGI::Cookie(-name=>'preferences',
+                               -value=>{ font => Helvetica,
+                                         size => 12 } 
+                               );
+    print header(-cookie=>[$cookie1,$cookie2]);
+
+    # fetch existing cookies
+    %cookies = fetch CGI::Cookie;
+    $id = $cookies{'ID'}->value;
+
+    # create cookies returned from an external source
+    %cookies = parse CGI::Cookie($ENV{COOKIE});
+
+=head1 DESCRIPTION
+
+CGI::Cookie is an interface to Netscape (HTTP/1.1) cookies, an
+innovation that allows Web servers to store persistent information on
+the browser's side of the connection.  Although CGI::Cookie is
+intended to be used in conjunction with CGI.pm (and is in fact used by
+it internally), you can use this module independently.
+
+For full information on cookies see 
+
+	http://www.ics.uci.edu/pub/ietf/http/rfc2109.txt
+
+=head1 USING CGI::Cookie
+
+CGI::Cookie is object oriented.  Each cookie object has a name and a
+value.  The name is any scalar value.  The value is any scalar or
+array value (associative arrays are also allowed).  Cookies also have
+several optional attributes, including:
+
+=over 4
+
+=item B<1. expiration date>
+
+The expiration date tells the browser how long to hang on to the
+cookie.  If the cookie specifies an expiration date in the future, the
+browser will store the cookie information in a disk file and return it
+to the server every time the user reconnects (until the expiration
+date is reached).  If the cookie species an expiration date in the
+past, the browser will remove the cookie from the disk file.  If the
+expiration date is not specified, the cookie will persist only until
+the user quits the browser.
+
+=item B<2. domain>
+
+This is a partial or complete domain name for which the cookie is 
+valid.  The browser will return the cookie to any host that matches
+the partial domain name.  For example, if you specify a domain name
+of ".capricorn.com", then Netscape will return the cookie to
+Web servers running on any of the machines "www.capricorn.com", 
+"ftp.capricorn.com", "feckless.capricorn.com", etc.  Domain names
+must contain at least two periods to prevent attempts to match
+on top level domains like ".edu".  If no domain is specified, then
+the browser will only return the cookie to servers on the host the
+cookie originated from.
+
+=item B<3. path>
+
+If you provide a cookie path attribute, the browser will check it
+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, path is set to "/", which
+causes the cookie to be sent to any CGI script on your site.
+
+=item B<4. secure flag>
+
+If the "secure" attribute is set, the cookie will only be sent to your
+script if the CGI request is occurring on a secure channel, such as SSL.
+
+=back
+
+=head2 Creating New Cookies
+
+	$c = new CGI::Cookie(-name    =>  'foo',
+                             -value   =>  'bar',
+                             -expires =>  '+3M',
+                             -domain  =>  '.capricorn.com',
+                             -path    =>  '/cgi-bin/database'
+                             -secure  =>  1
+	                    );
+
+Create cookies from scratch with the B<new> method.  The B<-name> and
+B<-value> parameters are required.  The name must be a scalar value.
+The value can be a scalar, an array reference, or a hash reference.
+(At some point in the future cookies will support one of the Perl
+object serialization protocols for full generality).
+
+B<-expires> accepts any of the relative or absolute date formats
+recognized by CGI.pm, for example "+3M" for three months in the
+future.  See CGI.pm's documentation for details.
+
+B<-domain> points to a domain name or to a fully qualified host name.
+If not specified, the cookie will be returned only to the Web server
+that created it.
+
+B<-path> points to a partial URL on the current server.  The cookie
+will be returned to all URLs beginning with the specified path.  If
+not specified, it defaults to '/', which returns the cookie to all
+pages at your site.
+
+B<-secure> if set to a true value instructs the browser to return the
+cookie only when a cryptographic protocol is in use.
+
+=head2 Sending the Cookie to the Browser
+
+Within a CGI script you can send a cookie to the browser by creating
+one or more Set-Cookie: fields in the HTTP header.  Here is a typical
+sequence:
+
+  my $c = new CGI::Cookie(-name    =>  'foo',
+                          -value   =>  ['bar','baz'],
+                          -expires =>  '+3M');
+
+  print "Set-Cookie: $c\n";
+  print "Content-Type: text/html\n\n";
+
+To send more than one cookie, create several Set-Cookie: fields.
+Alternatively, you may concatenate the cookies together with "; " and
+send them in one field.
+
+If you are using CGI.pm, you send cookies by providing a -cookie
+argument to the header() method:
+
+  print header(-cookie=>$c);
+
+Mod_perl users can set cookies using the request object's header_out()
+method:
+
+  $r->header_out('Set-Cookie',$c);
+
+Internally, Cookie overloads the "" operator to call its as_string()
+method when incorporated into the HTTP header.  as_string() turns the
+Cookie's internal representation into an RFC-compliant text
+representation.  You may call as_string() yourself if you prefer:
+
+  print "Set-Cookie: ",$c->as_string,"\n";
+
+=head2 Recovering Previous Cookies
+
+	%cookies = fetch CGI::Cookie;
+
+B<fetch> returns an associative array consisting of all cookies
+returned by the browser.  The keys of the array are the cookie names.  You
+can iterate through the cookies this way:
+
+	%cookies = fetch CGI::Cookie;
+	foreach (keys %cookies) {
+	   do_something($cookies{$_});
+        }
+
+In a scalar context, fetch() returns a hash reference, which may be more
+efficient if you are manipulating multiple cookies.
+    
+CGI.pm uses the URL escaping methods to save and restore reserved characters
+in its cookies.  If you are trying to retrieve a cookie set by a foreign server,
+this escaping method may trip you up.  Use raw_fetch() instead, which has the
+same semantics as fetch(), but performs no unescaping.
+
+You may also retrieve cookies that were stored in some external
+form using the parse() class method:
+
+       $COOKIES = `cat /usr/tmp/Cookie_stash`;
+       %cookies = parse CGI::Cookie($COOKIES);
+
+=head2 Manipulating Cookies
+
+Cookie objects have a series of accessor methods to get and set cookie
+attributes.  Each accessor has a similar syntax.  Called without
+arguments, the accessor returns the current value of the attribute.
+Called with an argument, the accessor changes the attribute and
+returns its new value.
+
+=over 4
+
+=item B<name()>
+
+Get or set the cookie's name.  Example:
+
+	$name = $c->name;
+	$new_name = $c->name('fred');
+
+=item B<value()>
+
+Get or set the cookie's value.  Example:
+
+	$value = $c->value;
+	@new_value = $c->value(['a','b','c','d']);
+
+B<value()> is context sensitive.  In an array context it will return
+the current value of the cookie as an array.  In a scalar context it
+will return the B<first> value of a multivalued cookie.
+
+=item B<domain()>
+
+Get or set the cookie's domain.
+
+=item B<path()>
+
+Get or set the cookie's path.
+
+=item B<expires()>
+
+Get or set the cookie's expiration time.
+
+=back
+
+
+=head1 AUTHOR INFORMATION
+
+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
+listing the modifications you have made.
+
+Address bug reports and comments to:
+lstein@genome.wi.mit.edu
+
+=head1 BUGS
+
+This section intentionally left blank.
+
+=head1 SEE ALSO
+
+L<CGI::Carp>, L<CGI>
+ 
+=cut
diff --git a/lib/CGI/Push.pm b/lib/CGI/Push.pm
index 4390d0383e..eeec3f8110 100644
--- a/lib/CGI/Push.pm
+++ b/lib/CGI/Push.pm
@@ -17,20 +17,23 @@ package CGI::Push;
 #   http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
 #   ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
 
-$CGI::Push::VERSION='1.00';
+$CGI::Push::VERSION='1.01';
 use CGI;
 @ISA = ('CGI');
 
-# add do_push() to exported tags
-push(@{$CGI::EXPORT_TAGS{':standard'}},'do_push');
+$CGI::DefaultClass = 'CGI::Push';
+$CGI::Push::AutoloadClass = 'CGI';
+
+# add do_push() and push_delay() to exported tags
+push(@{$CGI::EXPORT_TAGS{':standard'}},'do_push','push_delay');
 
 sub do_push {
-    my ($self,@p) = CGI::self_or_CGI(@_);
+    my ($self,@p) = CGI::self_or_default(@_);
 
     # unbuffer output
     $| = 1;
     srand;
-    my ($random) = rand()*1E16;
+    my ($random) = sprintf("%16.0f",rand()*1E16);
     my ($boundary) = "----------------------------------$random";
 
     my (@header);
@@ -39,6 +42,7 @@ sub do_push {
     $type = 'text/html' unless $type;
     $callback = \&simple_counter unless $callback && ref($callback) eq 'CODE';
     $delay = 1 unless defined($delay);
+    $self->push_delay($delay);
 
     my(@o);
     foreach (@other) { push(@o,split("=")); }
@@ -55,15 +59,18 @@ sub do_push {
     my @contents;
     while (1) {
 	last unless (@contents = &$callback($self,++$COUNTER)) && defined($contents[0]);
-	print "Content-type: ${type}$CGI::CRLF$CGI::CRLF";
+	print "Content-type: ${type}$CGI::CRLF$CGI::CRLF" 
+	    unless $type eq 'dynamic';
 	print @contents,"$CGI::CRLF";
 	print "${boundary}$CGI::CRLF";
-	do_sleep($delay) if $delay;
+	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",
-          &$last_page($self,++$COUNTER),
-          "$CGI::CRLF${boundary}$CGI::CRLF"
-	      if $last_page && ref($last_page) eq 'CODE';
 }
 
 sub simple_counter {
@@ -87,6 +94,12 @@ sub do_sleep {
     }
 }
 
+sub push_delay {
+   my ($self,$delay) = CGI::self_or_default(@_);
+   return defined($delay) ? $self->{'.delay'} = 
+	$delay : $self->{'.delay'};
+}
+
 1;
 
 =head1 NAME
@@ -176,6 +189,9 @@ redrawing loop and print out the final page (if any)
 	       "This page called $counter times";
     }
 
+You are of course free to refer to create and use global variables
+within your draw routine in order to achieve special effects.
+
 =item -last_page
 
 This optional parameter points to a reference to the subroutine
@@ -187,8 +203,12 @@ itself should have exactly the same calling conventions as the
 =item -type
 
 This optional parameter indicates the content type of each page.  It
-defaults to "text/html".  Currently, server push of heterogeneous
-document types is not supported.
+defaults to "text/html".  Normally the module assumes that each page
+is of a homogenous MIME type.  However if you provide either of the
+magic values "heterogeneous" or "dynamic" (the latter provided for the
+convenience of those who hate long parameter names), you can specify
+the MIME type -- and other header fields -- on a per-page basis.  See 
+"heterogeneous pages" for more details.
 
 =item -delay
 
@@ -204,6 +224,60 @@ CGI::header().
 
 =back
 
+=head2 Heterogeneous Pages
+
+Ordinarily all pages displayed by CGI::Push share a common MIME type.
+However by providing a value of "heterogeneous" or "dynamic" in the
+do_push() -type parameter, you can specify the MIME type of each page
+on a case-by-case basis.  
+
+If you use this option, you will be responsible for producing the
+HTTP header for each page.  Simply modify your draw routine to
+look like this:
+
+    sub my_draw_routine {
+        my($q,$counter) = @_;
+        return header('text/html'),   # note we're producing the header here
+	       start_html('testing'),
+               h1('testing'),
+	       "This page called $counter times";
+    }
+
+You can add any header fields that you like, but some (cookies and
+status fields included) may not be interpreted by the browser.  One
+interesting effect is to display a series of pages, then, after the
+last page, to redirect the browser to a new URL.  Because redirect() 
+does b<not> work, the easiest way is with a -refresh header field,
+as shown below:
+
+    sub my_draw_routine {
+        my($q,$counter) = @_;
+	return undef if $counter > 10;
+        return header('text/html'),   # note we're producing the header here
+	       start_html('testing'),
+               h1('testing'),
+	       "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; 
+    }
+
+=head2 Changing the Page Delay on the Fly
+
+If you would like to control the delay between pages on a page-by-page
+basis, call push_delay() from within your draw routine.  push_delay()
+takes a single numeric argument representing the number of seconds you
+wish to delay after the current page is displayed and before
+displaying the next one.  The delay may be fractional.  Without
+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)
diff --git a/lib/CGI/Switch.pm b/lib/CGI/Switch.pm
index 420fff7643..8afc6a6cb3 100644
--- a/lib/CGI/Switch.pm
+++ b/lib/CGI/Switch.pm
@@ -2,7 +2,7 @@ package CGI::Switch;
 use Carp;
 use strict;
 use vars qw($VERSION @Pref);
-$VERSION = '0.05';
+$VERSION = '0.06';
 @Pref = qw(CGI::Apache CGI); #default
 
 sub import {
@@ -33,13 +33,6 @@ sub new {
     Carp::croak "Couldn't load+construct any of @Pref\n";
 }
 
-# there's a trick in Lincoln's package that determines the calling
-# package.  The reason is to have a filehandle with the same name as
-# the filename.  To tell this trick that we are not the calling
-# package we have to follow this dirty convention. It's a questionable
-# trick imho, but for now I want to have something working
-sub isaCGI { 1 }
-
 1;
 __END__
 
@@ -73,6 +66,6 @@ perl(1), Apache(3), CGI(3), CGI::XA(3)
 
 =head1 AUTHOR
 
-Andreas König E<lt>a.koenig@mind.deE<gt>
+Andreas KE<ouml>nig E<lt>a.koenig@mind.deE<gt>
 
 =cut