Upgrade to CGI.pm 2.81.
Jarkko Hietaniemi [Fri, 12 Apr 2002 02:06:04 +0000 (02:06 +0000)]
p4raw-id: //depot/perl@15872

lib/CGI.pm
lib/CGI/Carp.pm
lib/CGI/t/html.t

index 78bc931..a53fbb5 100644 (file)
@@ -18,8 +18,8 @@ use Carp 'croak';
 # The most recent version and complete docs are available at:
 #   http://stein.cshl.org/WWW/software/CGI/
 
-$CGI::revision = '$Id: CGI.pm,v 1.58 2002/01/12 02:44:56 lstein Exp $';
-$CGI::VERSION='2.80';
+$CGI::revision = '$Id: CGI.pm,v 1.62 2002/04/10 19:36:01 lstein Exp $';
+$CGI::VERSION='2.81';
 
 # HARD-CODED LOCATION FOR FILE UPLOAD TEMPORARY FILES.
 # UNCOMMENT THIS ONLY IF YOU KNOW WHAT YOU'RE DOING.
@@ -220,8 +220,8 @@ sub import {
     my $self = shift;
 
 # This causes modules to clash.  
-#    undef %EXPORT_OK;
-#    undef %EXPORT;
+    undef %EXPORT_OK;
+    undef %EXPORT;
 
     $self->_setup_symbols(@_);
     my ($callpack, $callfile, $callline) = caller;
@@ -552,6 +552,7 @@ sub parse_params {
     my($param,$value);
     foreach (@pairs) {
        ($param,$value) = split('=',$_,2);
+       next unless defined $param;
        next if $NO_UNDEF_PARAMS and not defined $value;
        $value = '' unless defined $value;
        $param = unescape($param);
@@ -677,6 +678,10 @@ sub _reset_globals { initialize_globals(); }
 sub _setup_symbols {
     my $self = shift;
     my $compile = 0;
+
+    # to avoid reexporting unwanted variables
+    undef %EXPORT;
+
     foreach (@_) {
        $HEADERS_ONCE++,         next if /^[:-]unique_headers$/;
        $NPH++,                  next if /^[:-]nph$/;
@@ -1331,7 +1336,7 @@ sub start_html {
         $target,$meta,$head,$style,$dtd,$lang,$encoding,@other) = 
        rearrange([TITLE,AUTHOR,BASE,XBASE,SCRIPT,NOSCRIPT,TARGET,META,HEAD,STYLE,DTD,LANG,ENCODING],@p);
 
-    $encoding = 'utf-8' unless defined $encoding;
+    $encoding = 'iso-8859-1' unless defined $encoding;
 
     # strangely enough, the title needs to be escaped as HTML
     # while the author needs to be escaped as a URL
@@ -1354,7 +1359,7 @@ sub start_html {
     push @result,qq(<?xml version="1.0" encoding="$encoding"?>) if $xml_dtd; 
 
     if (ref($dtd) && ref($dtd) eq 'ARRAY') {
-        push(@result,qq(<!DOCTYPE html\n\tPUBLIC "$dtd->[0]"\n\tSYSTEM "$dtd->[1]">));
+        push(@result,qq(<!DOCTYPE html\n\tPUBLIC "$dtd->[0]"\n\t "$dtd->[1]">));
     } else {
         push(@result,qq(<!DOCTYPE html\n\tPUBLIC "$dtd">));
     }
@@ -1418,7 +1423,7 @@ sub _style {
        foreach $src (@$src)
        {
          push(@result,$XHTML ? qq(<link rel="stylesheet" type="$type" href="$src" />)
-                             : qq(<link rel="stylesheet" type="$type" href="$src">/)) if $src;
+                             : qq(<link rel="stylesheet" type="$type" href="$src">)) if $src;
        }
      }
      else
@@ -1612,7 +1617,7 @@ sub _textfield {
     # and WebTV -- not sure it won't break stuff
     my($value) = $current ne '' ? qq(value="$current") : '';
     return $XHTML ? qq(<input type="$tag" name="$name" $value$s$m$other />) 
-                  : qq/<input type="$tag" name="$name" $value$s$m$other>/;
+                  : qq(<input type="$tag" name="$name" $value$s$m$other>);
 }
 END_OF_FUNC
 
@@ -1727,7 +1732,7 @@ sub button {
     $script = qq/ onclick="$script"/ if $script;
     my($other) = @other ? " @other" : '';
     return $XHTML ? qq(<input type="button"$name$val$script$other />)
-                  : qq/<input type="button"$name$val$script$other>/;
+                  : qq(<input type="button"$name$val$script$other>);
 }
 END_OF_FUNC
 
@@ -1757,7 +1762,7 @@ sub submit {
     $val = qq/ value="$value"/ if defined($value);
     my($other) = @other ? " @other" : '';
     return $XHTML ? qq(<input type="submit"$name$val$other />)
-                  : qq/<input type="submit"$name$val$other>/;
+                  : qq(<input type="submit"$name$val$other>);
 }
 END_OF_FUNC
 
@@ -1777,7 +1782,7 @@ sub reset {
     my($value) = defined($label) ? qq/ value="$label"/ : '';
     my($other) = @other ? " @other" : '';
     return $XHTML ? qq(<input type="reset"$value$other />)
-                  : qq/<input type="reset"$value$other>/;
+                  : qq(<input type="reset"$value$other>);
 }
 END_OF_FUNC
 
@@ -4423,7 +4428,7 @@ English.  For example:
     print $q->start_html(-lang=>'fr-CA');
 
 The B<-encoding> argument can be used to specify the character set for
-XHTML.  It defaults to UTF-8 if not specified.
+XHTML.  It defaults to iso-8859-1 if not specified.
 
 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
@@ -6684,9 +6689,7 @@ warnings when programs are run with the B<-w> switch.
 
 =head1 SEE ALSO
 
-L<CGI::Carp>, L<URI::URL>, L<CGI::Request>, L<CGI::MiniSvr>,
-L<CGI::Base>, L<CGI::Form>, L<CGI::Push>, L<CGI::Fast>,
-L<CGI::Pretty>
+L<CGI::Carp>, L<CGI::Fast>, L<CGI::Pretty>
 
 =cut
 
index dbb78c8..bc3d1c3 100644 (file)
@@ -134,7 +134,7 @@ of the error message that caused the script to die.  Example:
        sub handle_errors {
           my $msg = shift;
           print "<h1>Oh gosh</h1>";
-          print "Got an error: $msg";
+          print "<p>Got an error: $msg</p>";
       }
       set_message(\&handle_errors);
     }
@@ -161,9 +161,9 @@ warnings from being sent to the browser while you are printing some
 content where HTML comments are not allowed:
 
     warningsToBrowser(0);    # disable warnings
-    print "<SCRIPT type=javascript><!--\n";
+    print "<script type=\"text/javascript\"><!--\n";
     print_some_javascript_code();
-    print "//--></SCRIPT>\n";
+    print "//--></script>\n";
     warningsToBrowser(1);    # re-enable warnings
 
 Note: In this respect warningsToBrowser() differs fundamentally from
@@ -199,9 +199,13 @@ fatalsToBrowser(), which you should never call yourself!
      warningsToBrowser().  Replaced <CODE> tags with <PRE> in
      fatalsToBrowser() output.
 
+1.23 ineval() now checks both $^S and inspects the message for the "eval" pattern
+     (hack alert!) in order to accomodate various combinations of Perl and
+     mod_perl.
+
 =head1 AUTHORS
 
-Copyright 1995-1998, Lincoln D. Stein.  All rights reserved.  
+Copyright 1995-2002, 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.
@@ -227,7 +231,7 @@ use File::Spec;
 
 $main::SIG{__WARN__}=\&CGI::Carp::warn;
 $main::SIG{__DIE__}=\&CGI::Carp::die;
-$CGI::Carp::VERSION = '1.22';
+$CGI::Carp::VERSION = '1.23';
 $CGI::Carp::CUSTOM_MSG = undef;
 
 # fancy import routine detects and handles 'errorWrap' specially.
@@ -290,7 +294,7 @@ sub _warn {
     }
 }
 
-sub ineval { $^S }
+sub ineval { $^S || _longmess() =~ /eval [\{\']/m }
 
 # The mod_perl package Apache::Registry loads CGI programs by calling
 # eval.  These evals don't count when looking at the stack backtrace.
@@ -371,10 +375,11 @@ END
     }
     
     my $mess = <<END;
-<H1>Software error:</H1>
-<PRE>$msg</PRE>
-<P>
+<h1>Software error:</h1>
+<pre>$msg</pre>
+<p>
 $outer_message
+</p>
 END
     ;
 
index 1070a18..b101e4d 100755 (executable)
@@ -63,26 +63,26 @@ test(10,header(-type=>'image/gif') eq "Content-Type: image/gif${CRLF}${CRLF}","h
 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) =~ 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"?>
+<?xml version="1.0" encoding="iso-8859-1"?>
 <!DOCTYPE html
        PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
-       SYSTEM "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+        "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
 <html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"><head><title>Untitled Document</title>
 </head><body>
 END
     ;
-test(14,start_html(-dtd=>"-//IETF//DTD HTML 3.2//FR") ."\n" eq <<END,"start_html()");
+test(14,start_html(-dtd=>"-//IETF//DTD HTML 3.2//FR",-lang=>'fr') ."\n" eq <<END,"start_html()");
 <!DOCTYPE html
        PUBLIC "-//IETF//DTD HTML 3.2//FR">
-<html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"><head><title>Untitled Document</title>
+<html xmlns="http://www.w3.org/1999/xhtml" lang="fr"><head><title>Untitled Document</title>
 </head><body>
 END
     ;
 test(15,start_html(-Title=>'The world of foo') ."\n" eq <<END,"start_html()");
-<?xml version="1.0" encoding="utf-8"?>
+<?xml version="1.0" encoding="iso-8859-1"?>
 <!DOCTYPE html
        PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
-       SYSTEM "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+        "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
 <html xmlns="http://www.w3.org/1999/xhtml" lang="en-US"><head><title>The world of foo</title>
 </head><body>
 END