From: Jarkko Hietaniemi Date: Tue, 2 Feb 1999 16:38:55 +0000 (+0000) Subject: CGI.pm updated to 2.46 (the CGI docs fixes redone X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=71f3e297ff71d9b213ccf3230601eae8b4e9b685;p=p5sagit%2Fp5-mst-13.2.git CGI.pm updated to 2.46 (the CGI docs fixes redone where applicable). p4raw-id: //depot/cfgperl@2787 --- diff --git a/eg/cgi/file_upload.cgi b/eg/cgi/file_upload.cgi index f6bbbe0..38f8547 100644 --- a/eg/cgi/file_upload.cgi +++ b/eg/cgi/file_upload.cgi @@ -1,5 +1,6 @@ #!/usr/local/bin/perl -w +use strict 'refs'; use lib '..'; use CGI qw(:standard); use CGI::Carp qw/fatalsToBrowser/; @@ -18,7 +19,7 @@ print h1("File Upload Example"), will count the number of lines, words, and characters in the file.'; -@types = ('count lines','count words','count characters'); +my @types = ('count lines','count words','count characters'); # Start a multipart form. print start_multipart_form(), @@ -31,9 +32,10 @@ print start_multipart_form(), endform; # Process the form if there is a file name entered -if ($file = param('filename')) { - $tmpfile=tmpFileName($file); - $mimetype = uploadInfo($file)->{'Content-Type'} || ''; +if (my $file = param('filename')) { + my %stats; + my $tmpfile=tmpFileName($file); + my $mimetype = uploadInfo($file)->{'Content-Type'} || ''; print hr(), h2($file), h3($tmpfile), diff --git a/eg/cgi/index.html b/eg/cgi/index.html index 75e2d30..4125b28 100644 --- a/eg/cgi/index.html +++ b/eg/cgi/index.html @@ -54,7 +54,8 @@
  • Look at its source code -The Following Scripts only Work with Netscape 2.0 & Internet Explorer only! +The Following Scripts Work with Netscape Navigator 2.0 and higher, +or Internet Explorer 3.0 and higher

    Prompt for a file to upload and process it

    -You can pass a value of 'true' to dump() in order to get it to -print the results out as plain text, suitable for incorporating -into a 
     section.
-
-As a shortcut, as of version 1.56 you can interpolate the entire CGI
-object into a string and it will be replaced with the a nice HTML dump
-shown above:
+As a shortcut, you can interpolate the entire CGI object into a string
+and it will be replaced with the a nice HTML dump shown above:
 
     $query=new CGI;
     print "
    Current Values
     $query\n";
@@ -5609,24 +5729,25 @@ through this interface.  The methods are as follows:
 
 =over 4
 
-=item B
+=item B
+
+Return a list of MIME types that the remote browser accepts. If you
+give this method a single argument corresponding to a MIME type, as in
+$query->Accept('text/html'), it will return a floating point value
+corresponding to the browser's preference for this type from 0.0
+(don't want) to 1.0.  Glob types (e.g. text/*) in the browser's accept
+list are handled correctly.
 
-Return a list of MIME types that the remote browser
-accepts. If you give this method a single argument
-corresponding to a MIME type, as in
-$query->accept('text/html'), it will return a
-floating point value corresponding to the browser's
-preference for this type from 0.0 (don't want) to 1.0.
-Glob types (e.g. text/*) in the browser's accept list
-are handled correctly.
+Note that the capitalization changed between version 2.43 and 2.44 in
+order to avoid conflict with Perl's accept() function.
 
 =item B
 
 Returns the HTTP_COOKIE variable, an HTTP extension implemented by
-Netscape browsers version 1.1 and higher.  Cookies have a special
-format, and this method call just returns the raw form (?cookie
-dough).  See cookie() for ways of setting and retrieving cooked
-cookies.
+Netscape browsers version 1.1 and higher, and all versions of Internet
+Explorer.  Cookies have a special format, and this method call just
+returns the raw form (?cookie dough).  See cookie() for ways of
+setting and retrieving cooked cookies.
 
 Called with no parameters, raw_cookie() returns the packed cookie
 structure.  You can separate it into individual cookies by splitting
@@ -5708,10 +5829,9 @@ verification, if this script is protected.
 
 =item B
 
-Attempt to obtain the remote user's name, using a variety
-of different techniques.  This only works with older browsers
-such as Mosaic.  Netscape does not reliably report the user
-name!
+Attempt to obtain the remote user's name, using a variety of different
+techniques.  This only works with older browsers such as Mosaic.
+Newer browsers do not report the user name for privacy reasons!
 
 =item B
 
@@ -5935,14 +6055,17 @@ of CGI.pm without rewriting your old scripts from scratch.
 
 =head1 AUTHOR INFORMATION
 
-Copyright 1995-1997, 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.
+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@genome.wi.mit.edu
+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 CREDITS
 
@@ -5962,7 +6085,7 @@ Thanks very much to:
 
 =item Joergen Haegg (jh@axis.se)
 
-=item Laurent Delfosse (delfosse@csgrad1.cs.wvu.edu)
+=item Laurent Delfosse (delfosse@delfosse.com)
 
 =item Richard Resnick (applepi1@aol.com)
 
@@ -6054,7 +6177,7 @@ for suggestions and bug fixes.
 				  -rows=>10,
 				  -columns=>50);
  
-	   print "
    ",$query->reset;
+	   print "
    ",$query->Reset;
 	   print $query->submit('Action','Shout');
 	   print $query->submit('Action','Scream');
 	   print $query->endform;
@@ -6095,8 +6218,8 @@ warnings when programs are run with the B<-w> switch.
 =head1 SEE ALSO
 
 L, L, L, L,
-L, L, L, L,
-L, L
+L, L, L, L,
+L
 
 =cut
 
diff --git a/lib/CGI/Carp.pm b/lib/CGI/Carp.pm
index e20f754..dfae1a6 100644
--- a/lib/CGI/Carp.pm
+++ b/lib/CGI/Carp.pm
@@ -14,6 +14,12 @@ B - CGI routines for writing to the HTTPD (or other) error log
     warn "I'm confused";
     die  "I'm dying.\n";
 
+    use CGI::Carp qw(cluck);
+    cluck "I wouldn't do that if I were you";
+
+    use CGI::Carp qw(fatalsToBrowser);
+    die "Fatal error messages are now sent to browser";
+
 =head1 DESCRIPTION
 
 CGI scripts have a nasty habit of leaving warning messages in the error
@@ -155,11 +161,21 @@ set_message() from within a BEGIN{} block.
 1.10 Patch from Chris Dean (ctdean@cogit.com) to allow 
      module to run correctly under mod_perl.
 
+1.11 Changed order of > and < escapes.
+
+1.12 Changed die() on line 217 to CORE::die to avoid B<-w> warning.
+
+1.13 Added cluck() to make the module orthogonal with Carp.
+    More mod_perl related fixes.
+
 =head1 AUTHORS
 
-Lincoln D. Stein .  Feel free to redistribute
-this under the Perl Artistic License.
+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
 
 =head1 SEE ALSO
 
@@ -174,11 +190,11 @@ use Carp;
 
 @ISA = qw(Exporter);
 @EXPORT = qw(confess croak carp);
-@EXPORT_OK = qw(carpout fatalsToBrowser wrap set_message);
+@EXPORT_OK = qw(carpout fatalsToBrowser wrap set_message cluck);
 
 $main::SIG{__WARN__}=\&CGI::Carp::warn;
 $main::SIG{__DIE__}=\&CGI::Carp::die;
-$CGI::Carp::VERSION = '1.101';
+$CGI::Carp::VERSION = '1.13';
 $CGI::Carp::CUSTOM_MSG = undef;
 
 # fancy import routine detects and handles 'errorWrap' specially.
@@ -194,7 +210,6 @@ sub import {
 }
 
 # These are the originals
-# XXX Why not just use CORE::die etc., instead of these two?  GSAR
 sub realwarn { CORE::warn(@_); }
 sub realdie { CORE::die(@_); }
 
@@ -230,8 +245,7 @@ sub warn {
 # 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\//);
+    my $mod_perl = exists $ENV{MOD_PERL};
     $message =~ s,eval[^\n]+Apache/Registry\.pm.*,,s if $mod_perl;
     return( $message );    
 }
@@ -240,7 +254,7 @@ sub die {
     my $message = shift;
     my $time = scalar(localtime);
     my($file,$line,$id) = id(1);
-    $message .= " at $file line $line.\n" unless $message=~/\n$/;
+    $message .= " at $file line $line." unless $message=~/\n$/;
     &fatalsToBrowser($message) if $WRAP && _longmess() !~ /eval [{\']/m;
     my $stamp = stamp;
     $message=~s/^/$stamp/gm;
@@ -258,8 +272,9 @@ sub set_message {
     local $^W=0;
     eval <&STDERR");
     open(STDERR, ">&$no") or 
@@ -279,9 +294,9 @@ sub carpout {
 # headers
 sub fatalsToBrowser {
     my($msg) = @_;
+    $msg=~s/&/&/g;
     $msg=~s/>/>/g;
     $msg=~s/$ENV{SERVER_ADMIN})] :
@@ -291,7 +306,9 @@ 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";
+    my $mod_perl = exists $ENV{MOD_PERL};
+    print STDOUT "Content-type: text/html\n\n" 
+	unless $mod_perl;
 
     if ($CUSTOM_MSG) {
 	if (ref($CUSTOM_MSG) eq 'CODE') {
@@ -302,13 +319,30 @@ END
 	}
     }
     
-    print STDOUT <Software error:
 $msg
 
    
-$outer_message;
+$outer_message
 END
     ;
+
+    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
+	# handler to produce the doc for us.
+	if ($r->bytes_sent) {
+	    $r->print($mess);
+	    $r->exit;
+	} else {
+	    $r->status(500);
+	    $r->custom_response(500,$mess);
+	}
+    } else {
+	print STDOUT $mess;
+    }
 }
 
 # Cut and paste from CGI.pm so that we don't have the overhead of
diff --git a/lib/CGI/Cookie.pm b/lib/CGI/Cookie.pm
index c32891a..204d67b 100644
--- a/lib/CGI/Cookie.pm
+++ b/lib/CGI/Cookie.pm
@@ -69,7 +69,9 @@ sub parse {
 	my($key,$value) = split("=");
 	my(@values) = map CGI::unescape($_),split('&',$value);
 	$key = CGI::unescape($key);
-	$results{$key} = $self->new(-name=>$key,-value=>\@values);
+	# 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;
@@ -399,13 +401,12 @@ Get or set the cookie's expiration time.
 
 =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.
+Copyright 1997-1998, Lincoln D. Stein.  All rights reserved.  
 
-Address bug reports and comments to:
-lstein@genome.wi.mit.edu
+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
 
 =head1 BUGS
 
diff --git a/lib/CGI/Fast.pm b/lib/CGI/Fast.pm
index 03b5407..a39fe05 100644
--- a/lib/CGI/Fast.pm
+++ b/lib/CGI/Fast.pm
@@ -16,7 +16,7 @@ package CGI::Fast;
 # 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::Fast::VERSION='1.00a';
+$CGI::Fast::VERSION='1.01';
 
 use CGI;
 use FCGI;
@@ -34,9 +34,11 @@ sub save_request {
 # New is slightly different in that it calls FCGI's
 # accept() method.
 sub new {
-    return undef unless FCGI::accept() >= 0;
-    my($self,@param) = @_;
-    return $CGI::Q = $self->SUPER::new(@param);
+     my ($self, $initializer, @param) = @_;
+     unless (defined $initializer) {
+         return undef unless FCGI::accept() >= 0;
+     }
+     return $CGI::Q = $self->SUPER::new($initializer, @param);
 }
 
 1;
@@ -154,13 +156,12 @@ I haven't tested this very much.
 
 =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.
+Copyright 1996-1998, Lincoln D. Stein.  All rights reserved.  
 
-Address bug reports and comments to:
-lstein@genome.wi.mit.edu
+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
 
 =head1 BUGS
 
diff --git a/lib/CGI/Push.pm b/lib/CGI/Push.pm
index 60a4617..e4a66ae 100644
--- a/lib/CGI/Push.pm
+++ b/lib/CGI/Push.pm
@@ -14,8 +14,7 @@ package CGI::Push;
 # 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/
+#   http://stein.cshl.org/WWW/software/CGI/
 
 $CGI::Push::VERSION='1.01';
 use CGI;
@@ -204,7 +203,7 @@ itself should have exactly the same calling conventions as the
 
 This optional parameter indicates the content type of each page.  It
 defaults to "text/html".  Normally the module assumes that each page
-is of a homogeneous MIME type.  However if you provide either of the
+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 
@@ -287,19 +286,14 @@ Recognition of NPH scripts happens automatically with WebSTAR and
 Microsoft IIS.  Users of other servers should see their documentation
 for help.
 
-=head1 CAVEATS
-
-This is a new module.  It hasn't been extensively tested.
-
 =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.
+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@genome.wi.mit.edu
+Address bug reports and comments to: lstein@cshl.org
 
 =head1 BUGS