[FIX] Re: UTF-8 failures (surprise!)

[p5sagit/p5-mst-13.2.git] / lib / CGI / Carp.pm

diff --git a/lib/CGI/Carp.pm b/lib/CGI/Carp.pm
index 317fdf8..ce9b407 100644 (file)
--- a/lib/CGI/Carp.pm
+++ b/lib/CGI/Carp.pm
@@ -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,14 +161,47 @@ 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
 fatalsToBrowser(), which you should never call yourself!
 
+=head1 OVERRIDING THE NAME OF THE PROGRAM
+
+CGI::Carp includes the name of the program that generated the error or
+warning in the messages written to the log and the browser window.
+Sometimes, Perl can get confused about what the actual name of the
+executed program was.  In these cases, you can override the program
+name that CGI::Carp will use for all messages.
+
+The quick way to do that is to tell CGI::Carp the name of the program
+in its use statement.  You can do that by adding
+"name=cgi_carp_log_name" to your "use" statement.  For example:
+
+    use CGI::Carp qw(name=cgi_carp_log_name);
+
+.  If you want to change the program name partway through the program,
+you can use the C<set_progname()> function instead.  It is not
+exported by default, you must import it explicitly by saying
+
+    use CGI::Carp qw(set_progname);
+
+Once you've done that, you can change the logged name of the program
+at any time by calling
+
+    set_progname(new_program_name);
+
+You can set the program back to the default by calling
+
+    set_progname(undef);
+
+Note that this override doesn't happen until after the program has
+compiled, so any compile-time errors will still show up with the
+non-overridden program name
+  
 =head1 CHANGE LOG
 
 1.05 carpout() added and minor corrections by Marc Hedlund
@@ -199,9 +232,16 @@ 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.
+
+1.24 Patch from Scott Gifford (sgifford@suspectclass.com): Add support
+     for overriding program name.
+
 =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.
@@ -212,27 +252,41 @@ Address bug reports and comments to: lstein@cshl.org
 
 Carp, CGI::Base, CGI::BasePlus, CGI::Request, CGI::MiniSvr, CGI::Form,
 CGI::Response
+    if (defined($CGI::Carp::PROGNAME)) 
+    {
+      $file = $CGI::Carp::PROGNAME;
+    }
 
 =cut
 
 require 5.000;
 use Exporter;
-use Carp;
+#use Carp;
+BEGIN { require Carp; }
 use File::Spec;
 
 @ISA = qw(Exporter);
 @EXPORT = qw(confess croak carp);
-@EXPORT_OK = qw(carpout fatalsToBrowser warningsToBrowser wrap set_message cluck);
+@EXPORT_OK = qw(carpout fatalsToBrowser warningsToBrowser wrap set_message set_progname cluck ^name=);
 
 $main::SIG{__WARN__}=\&CGI::Carp::warn;
-$main::SIG{__DIE__}=\&CGI::Carp::die;
-$CGI::Carp::VERSION = '1.21';
+*CORE::GLOBAL::die = \&CGI::Carp::die;
+$CGI::Carp::VERSION = '1.24';
 $CGI::Carp::CUSTOM_MSG = undef;
 
 # fancy import routine detects and handles 'errorWrap' specially.
 sub import {
     my $pkg = shift;
     my(%routines);
+    my(@name);
+  
+    if (@name=grep(/^name=/,@_))
+      {
+        my($n) = (split(/=/,$name[0]))[1];
+        set_progname($n);
+        @_=grep(!/^name=/,@_);
+      }
+
     grep($routines{$_}++,@_,@EXPORT);
     $WRAP++ if $routines{'fatalsToBrowser'} || $routines{'wrap'};
     $WARN++ if $routines{'warningsToBrowser'};
@@ -257,14 +311,24 @@ sub stamp {
     my $time = scalar(localtime);
     my $frame = 0;
     my ($id,$pack,$file,$dev,$dirs);
-    do {
-       $id = $file;
-       ($pack,$file) = caller($frame++);
-    } until !$file;
+    if (defined($CGI::Carp::PROGNAME)) {
+        $id = $CGI::Carp::PROGNAME;
+    } else {
+        do {
+         $id = $file;
+         ($pack,$file) = caller($frame++);
+        } until !$file;
+    }
     ($dev,$dirs,$id) = File::Spec->splitpath($id);
     return "[$time] $id: ";
 }
 
+sub set_progname {
+    $CGI::Carp::PROGNAME = shift;
+    return $CGI::Carp::PROGNAME;
+}
+
+
 sub warn {
     my $message = shift;
     my($file,$line,$id) = id(1);
@@ -289,7 +353,10 @@ sub _warn {
     }
 }
 
-sub ineval { $^S }
+sub ineval { 
+  (exists $ENV{MOD_PERL} ? 0 : $^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.
@@ -317,18 +384,10 @@ sub set_message {
     return $CGI::Carp::CUSTOM_MSG;
 }
 
-# Avoid generating "subroutine redefined" warnings with the following
-# hack:
-{
-    local $^W=0;
-    eval <<EOF;
-sub confess { CGI::Carp::die Carp::longmess \@_; }
-sub croak   { CGI::Carp::die Carp::shortmess \@_; }
-sub carp    { CGI::Carp::warn Carp::shortmess \@_; }
-sub cluck   { CGI::Carp::warn Carp::longmess \@_; }
-EOF
-    ;
-}
+sub confess { CGI::Carp::die Carp::longmess @_; }
+sub croak   { CGI::Carp::die Carp::shortmess @_; }
+sub carp    { CGI::Carp::warn Carp::shortmess @_; }
+sub cluck   { CGI::Carp::warn Carp::longmess @_; }
 
 # We have to be ready to accept a filehandle as a reference
 # or a string.
@@ -378,10 +437,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
     ;