[Catalyst-commits] r12509 - in trunk/Catalyst-Controller-WrapCGI: .
lib/Catalyst/Controller lib/CatalystX t
t/lib/TestCGIBin/root/cgi-bin
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Sun Jan 3 11:41:05 GMT 2010
Author: caelum
Date: 2010-01-03 11:41:05 +0000 (Sun, 03 Jan 2010)
New Revision: 12509
Added:
trunk/Catalyst-Controller-WrapCGI/t/lib/TestCGIBin/root/cgi-bin/exit_nonzero.sh
Modified:
trunk/Catalyst-Controller-WrapCGI/Changes
trunk/Catalyst-Controller-WrapCGI/Makefile.PL
trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/CGIBin.pm
trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/WrapCGI.pm
trunk/Catalyst-Controller-WrapCGI/lib/CatalystX/GlobalContext.pm
trunk/Catalyst-Controller-WrapCGI/t/cgibin.t
Log:
switch to CGI::Compile, check exit status of non-Perl CGIs, release
Modified: trunk/Catalyst-Controller-WrapCGI/Changes
===================================================================
--- trunk/Catalyst-Controller-WrapCGI/Changes 2010-01-02 14:27:45 UTC (rev 12508)
+++ trunk/Catalyst-Controller-WrapCGI/Changes 2010-01-03 11:41:05 UTC (rev 12509)
@@ -1,5 +1,9 @@
Revision history for Catalyst-Controller-WrapCGI
+0.026 2010-01-03 11:37:15
+ - convert to CGI::Compile
+ - check exit status of non-Perl CGIs
+
0.025 2009-12-26 16:43:50
- fix %SIG localization in CGIBin
Modified: trunk/Catalyst-Controller-WrapCGI/Makefile.PL
===================================================================
--- trunk/Catalyst-Controller-WrapCGI/Makefile.PL 2010-01-02 14:27:45 UTC (rev 12508)
+++ trunk/Catalyst-Controller-WrapCGI/Makefile.PL 2010-01-03 11:41:05 UTC (rev 12509)
@@ -6,11 +6,10 @@
requires 'Catalyst' => '5.80015';
requires 'HTTP::Request::AsCGI' => '0.8';;
-#requires 'CGI::Compile' => '0.06';
+requires 'CGI::Compile' => '0.07';
requires 'File::pushd';
requires 'File::Find::Rule';
requires 'List::MoreUtils';
-requires 'File::Slurp';
requires 'URI' => '1.37';
requires 'parent';
requires 'namespace::clean';
Modified: trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/CGIBin.pm
===================================================================
--- trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/CGIBin.pm 2010-01-02 14:27:45 UTC (rev 12508)
+++ trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/CGIBin.pm 2010-01-03 11:41:05 UTC (rev 12509)
@@ -5,7 +5,6 @@
extends 'Catalyst::Controller::WrapCGI';
-use File::Slurp 'slurp';
use File::Find::Rule ();
use Catalyst::Exception ();
use File::Spec::Functions qw/splitdir abs2rel/;
@@ -15,7 +14,7 @@
use IO::File ();
use File::Temp 'tempfile';
use File::pushd;
-#use CGI::Compile;
+use CGI::Compile;
use namespace::clean -except => 'meta';
@@ -25,11 +24,11 @@
=head1 VERSION
-Version 0.025
+Version 0.026
=cut
-our $VERSION = '0.025';
+our $VERSION = '0.026';
=head1 SYNOPSIS
@@ -231,7 +230,7 @@
C<< $self->wrap_perl_cgi($path, $action_name) >>
Takes the path to a Perl CGI and returns a coderef suitable for passing to
-cgi_to_response (from L<Catalyst::Controller::WrapCGI>.)
+cgi_to_response (from L<Catalyst::Controller::WrapCGI>) using L<CGI::Compile>.
C<$action_name> is the generated name for the action representing the CGI file
from C<cgi_action>.
@@ -248,71 +247,10 @@
sub wrap_perl_cgi {
my ($self, $cgi, $action_name) = @_;
- my $code = slurp $cgi;
- my $dir = File::Basename::dirname($cgi);
-
- $code =~ s/^__DATA__\n(.*)//ms;
- my $data = $1;
-
- my $orig_exit = \*CORE::GLOBAL::exit;
- my %orig_sig = %SIG;
-
- my $coderef = do {
- no warnings;
- # catch exit() and turn it into (effectively) a return
- # we *must* eval STRING because the code needs to be compiled with the
- # overridden CORE::GLOBAL::exit in view
- #
- # set $0 to the name of the cgi file in case it's used there
- my $source = '
- my $cgi_exited = "EXIT\n";
- BEGIN { *CORE::GLOBAL::exit = sub (;$) {
- die [ $cgi_exited, $_[0] || 0 ];
- } }
- package Catalyst::Controller::CGIBin::_CGIs_::'.$action_name.';
- sub {'."\n"
- . 'local *DATA;'."\n"
- . q{open DATA, '<', \$data;}."\n"
- . qq{local \$0 = '$cgi';}."\n"
- . "my \$_dir = File::pushd::pushd '$dir';"."\n"
- . "CGI::initialize_globals() "."\n"
- . " if defined &CGI::initialize_globals;"."\n"
- . q/my $rv = eval {/."\n"
- . 'local *SIG = +{ %SIG };'."\n"
- . "#line 1 $cgi"."\n"
- . $code."\n"
- . q/};/
- . q{
- return $rv unless $@;
- die $@ if $@ and not (
- ref($@) eq 'ARRAY' and
- $@->[0] eq $cgi_exited
- );
- die "exited nonzero: $@->[1]" if $@->[1] != 0;
- return $rv;
- }
- . '}';
- eval $source;
- };
-
- # clean up
- *CORE::GLOBAL::exit = $orig_exit;
- %SIG = %orig_sig;
-
- die "Could not compile $cgi to coderef: $@" if $@;
-
- return $coderef;
+ return CGI::Compile->compile($cgi,
+ "Catalyst::Controller::CGIBin::_CGIs_::$action_name");
}
-# Once CGI::Compile is updated, we can use this:
-
-#sub wrap_perl_cgi {
-# my ($self, $cgi, $action_name) = @_;
-#
-# return CGI::Compile->compile($cgi,
-# "Catalyst::Controller::CGIBin::_CGIs_::$action_name");
-#}
-
=head2 wrap_nonperl_cgi
C<< $self->wrap_nonperl_cgi($path, $action_name) >>
@@ -321,7 +259,7 @@
C<$action_name> is the generated name for the action representing the CGI file.
-By default returns:
+By default returns something like:
sub { system $path }
@@ -330,7 +268,24 @@
sub wrap_nonperl_cgi {
my ($self, $cgi, $action_name) = @_;
- sub { system $cgi }
+ return sub {
+ system $cgi;
+
+ if ($? == -1) {
+ die "failed to execute CGI '$cgi': $!";
+ }
+ elsif ($? & 127) {
+ die sprintf "CGI '$cgi' died with signal %d, %s coredump",
+ ($? & 127), ($? & 128) ? 'with' : 'without';
+ }
+ else {
+ my $exit_code = $? >> 8;
+
+ return 0 if $exit_code == 0;
+
+ die "CGI '$cgi' exited non-zero with: $exit_code";
+ }
+ };
}
__PACKAGE__->meta->make_immutable;
Modified: trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/WrapCGI.pm
===================================================================
--- trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/WrapCGI.pm 2010-01-02 14:27:45 UTC (rev 12508)
+++ trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/WrapCGI.pm 2010-01-03 11:41:05 UTC (rev 12509)
@@ -21,11 +21,11 @@
=head1 VERSION
-Version 0.025
+Version 0.026
=cut
-our $VERSION = '0.025';
+our $VERSION = '0.026';
=head1 SYNOPSIS
@@ -394,6 +394,8 @@
Hans Dieter Pearcey C<< <hdp at cpan.org> >>
+Some code stolen from Tatsuhiko Miyagawa's L<CGI::Compile>.
+
=head1 COPYRIGHT & LICENSE
Copyright (c) 2008-2009 L<Catalyst::Controller::WrapCGI/AUTHOR> and
Modified: trunk/Catalyst-Controller-WrapCGI/lib/CatalystX/GlobalContext.pm
===================================================================
--- trunk/Catalyst-Controller-WrapCGI/lib/CatalystX/GlobalContext.pm 2010-01-02 14:27:45 UTC (rev 12508)
+++ trunk/Catalyst-Controller-WrapCGI/lib/CatalystX/GlobalContext.pm 2010-01-03 11:41:05 UTC (rev 12509)
@@ -15,11 +15,11 @@
=head1 VERSION
-Version 0.025
+Version 0.026
=cut
-our $VERSION = '0.025';
+our $VERSION = '0.026';
=head1 SYNOPSIS
Modified: trunk/Catalyst-Controller-WrapCGI/t/cgibin.t
===================================================================
--- trunk/Catalyst-Controller-WrapCGI/t/cgibin.t 2010-01-02 14:27:45 UTC (rev 12508)
+++ trunk/Catalyst-Controller-WrapCGI/t/cgibin.t 2010-01-03 11:41:05 UTC (rev 12509)
@@ -71,8 +71,12 @@
# for some reason the +x is not preserved in the dist
system "chmod +x $Bin/lib/TestCGIBin/root/cgi-bin/test.sh";
+ system "chmod +x $Bin/lib/TestCGIBin/root/cgi-bin/exit_nonzero.sh";
is(get('/my-bin/test.sh'), "Hello!\n", 'Non-Perl CGI File');
+
+ $response = request GET '/my-bin/exit_nonzero.sh';
+ is $response->code, 500, 'Non-Perl CGI with non-zero exit dies';
}
done_testing;
Added: trunk/Catalyst-Controller-WrapCGI/t/lib/TestCGIBin/root/cgi-bin/exit_nonzero.sh
===================================================================
--- trunk/Catalyst-Controller-WrapCGI/t/lib/TestCGIBin/root/cgi-bin/exit_nonzero.sh (rev 0)
+++ trunk/Catalyst-Controller-WrapCGI/t/lib/TestCGIBin/root/cgi-bin/exit_nonzero.sh 2010-01-03 11:41:05 UTC (rev 12509)
@@ -0,0 +1,7 @@
+#!/bin/sh
+
+printf '%s\r\n' 'Content-Type: text/html; charset=ISO-8859-1'
+
+echo "Hello!"
+
+exit 1;
Property changes on: trunk/Catalyst-Controller-WrapCGI/t/lib/TestCGIBin/root/cgi-bin/exit_nonzero.sh
___________________________________________________________________
Name: svn:executable
+ *
More information about the Catalyst-commits
mailing list