/[pub]/suikawiki/script/lib/SuikaWiki/Output/CGICarp.pm
Suika

Contents of /suikawiki/script/lib/SuikaWiki/Output/CGICarp.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.2.1 - (hide annotations) (download)
Thu Oct 9 09:47:22 2003 UTC (21 years, 9 months ago) by wakaba
Branch: branch-suikawiki-1
Changes since 1.1: +135 -0 lines
New

1 wakaba 1.1.2.1
2     =head1 NAME
3    
4     SuikaWiki::Output::CGICarp --- SuikaWiki : CGI::Carp modification to
5     return 500 status code
6    
7     =head1 DESCRIPTION
8    
9     At the time of writing, latest version of CGI::Carp (1.26)
10     does not output error dying message with 500 (Internal Server Error)
11     HTTP status code unless it is working on mod_perl.
12    
13     This module overrides some of CGI::Carp functions to return 500 status
14     code. Users of this module should take attention whether later revision
15     of CGI::Carp provides improved version of CGI outputing methods.
16    
17     This module is part of SuikaWiki.
18    
19     =cut
20    
21     package SuikaWiki::Output::CGICarp;
22     require CGI::Carp; # 1.26
23     use strict;
24     our $VERSION = do{my @r=(q$Revision: 1.2 $=~/\d+/g);sprintf "%d."."%02d" x $#r,@r};
25     our $CUSTOM_REASON_TEXT = 'Internal CGI Script Error';
26     our $CUSTOM_STATUS_CODE = 500;
27    
28     =head1 OPTIONS
29    
30     =over 4
31    
32     =item $SuikaWiki::Output::CGICarp::CUSTOM_REASON_TEXT (Default : Internal CGI Script Error)
33    
34     Short description of error status. This string should contains only
35     printable ASCII characters (including SPACE) for interoperability
36     and line break characters (CR and LF) MUST NOT be used.
37    
38     =item $SuikaWiki::Output::CGICarp::CUSTOM_STATUS_CODE (Default : 500)
39    
40     Three digit status code defined by HTTP specifications.
41    
42     =back
43    
44     =cut
45    
46     package CGI::Carp;
47     our $CUSTOM_MSG;
48     sub fatalsToBrowser {
49     my($msg) = @_;
50     $msg=~s/&/&/g;
51     $msg=~s/>/>/g;
52     $msg=~s/</&lt;/g;
53     $msg=~s/\"/&quot;/g;
54     my($wm) = $main::ENV{SERVER_ADMIN} ?
55     qq[the webmaster &lt;<a href="mailto:$main::ENV{SERVER_ADMIN}">$main::ENV{SERVER_ADMIN}</a>&gt;] :
56     "this site's webmaster";
57     my ($outer_message) = <<END;
58     For help, please send mail to $wm, giving this error message
59     and the time and date of the error.
60     END
61     ;
62     my $mod_perl = exists $main::ENV{MOD_PERL};
63     unless ($mod_perl) {
64     print STDOUT "Status: @{[$SuikaWiki::Output::CGICarp::CUSTOM_STATUS_CODE+0]} $SuikaWiki::Output::CGICarp::CUSTOM_REASON_TEXT\n";
65     print STDOUT "Content-type: text/html; charset=iso-8859-1\n\n";
66     }
67    
68     warningsToBrowser(1); # emit warnings before dying
69    
70     if ($CUSTOM_MSG) {
71     if (ref($CUSTOM_MSG) eq 'CODE') {
72     &$CUSTOM_MSG($msg); # nicer to perl 5.003 users
73     return;
74     } else {
75     $outer_message = $CUSTOM_MSG;
76     }
77     }
78    
79     my $mess = <<END;
80     <h1>Software error:</h1>
81     <pre>$msg</pre>
82     <p>
83     $outer_message
84     </p>
85     END
86     ;
87    
88     if ($mod_perl) {
89     require mod_perl;
90     if ($mod_perl::VERSION >= 1.99) {
91     $mod_perl = 2;
92     require Apache::RequestRec;
93     require Apache::RequestIO;
94     require Apache::RequestUtil;
95     require APR::Pool;
96     require ModPerl::Util;
97     require Apache::Response;
98     }
99     my $r = Apache->request;
100     # If bytes have already been sent, then
101     # we print the message out directly.
102     # Otherwise we make a custom error
103     # handler to produce the doc for us.
104     if ($r->bytes_sent) {
105     $r->print($mess);
106     $mod_perl == 2 ? ModPerl::Util::exit(0) : $r->exit;
107     } else {
108     # MSIE won't display a custom 500 response unless it is >512 bytes!
109     if ($main::ENV{HTTP_USER_AGENT} =~ /MSIE/) {
110     $mess = "<!-- " . (' ' x 513) . " -->\n$mess";
111     }
112     $r->custom_response($SuikaWiki::Output::CGICarp::CUSTOM_STATUS_CODE+0,$mess);
113     }
114     } else {
115     print STDOUT $mess;
116     }
117     }
118    
119     =head1 EXAMPLE
120    
121     use CGI::Carp qw/fatalsToBrowser/;
122     require SuikaWiki::Output::CGICarp;
123    
124     die 'Something wrong';
125    
126     =head1 LICENSE
127    
128     Copyright 2003 Wakaba <w@suika.fam.cx>
129    
130     This program is free software; you can redistribute it and/or
131     modify it under the same terms as Perl itself.
132    
133     =cut
134    
135     1; # $Date:$

admin@suikawiki.org
ViewVC Help
Powered by ViewVC 1.1.24