From: Rafael Kitover <rkitover@cpan.org>
Date: Sun, 26 Apr 2009 19:48:24 +0000 (+0000)
Subject: C::C::CGIBin - added test for __DATA__ (failing for some reaosn)
X-Git-Tag: 0.030~47
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Controller-WrapCGI.git;a=commitdiff_plain;h=fbaba9ddb929f1437ddaec1f24019f38beb99c75

C::C::CGIBin - added test for __DATA__ (failing for some reaosn)
---

diff --git a/lib/Catalyst/Controller/CGIBin.pm b/lib/Catalyst/Controller/CGIBin.pm
index 30f44ee..773d52e 100644
--- a/lib/Catalyst/Controller/CGIBin.pm
+++ b/lib/Catalyst/Controller/CGIBin.pm
@@ -24,11 +24,11 @@ Catalyst::Controller::CGIBin - Serve CGIs from root/cgi-bin
 
 =head1 VERSION
 
-Version 0.006
+Version 0.007
 
 =cut
 
-our $VERSION = '0.006';
+our $VERSION = '0.007';
 
 =head1 SYNOPSIS
 
@@ -64,12 +64,6 @@ for every invocation. If this is something you need, let me know.
 
 CGI paths are converted into action names using cgi_action (below.)
 
-A path such as C<root/cgi-bin/hlagh/bar.cgi> will get the private path
-C<foo/CGI_hlagh_bar_cgi>, for controller Foo, with the C</>s converted to C<_>s
-and prepended with C<CGI_>, as well as all non-word characters converted to
-C<_>s. This is because L<Catalyst> action names can't have non-word characters
-in them.
-
 Inherits from L<Catalyst::Controller::WrapCGI>, see the documentation for that
 module for configuration information.
 
@@ -141,12 +135,21 @@ Takes a path to a CGI from C<root/cgi-bin> such as C<foo/bar.cgi> and returns
 the action name it is registered as. See L</DESCRIPTION> for a discussion on how
 CGI actions are named.
 
+A path such as C<root/cgi-bin/hlagh/bar.cgi> will get the private path
+C<foo/CGI_hlagh__bar_cgi>, for controller Foo, with the C</>s converted to C<__>
+and prepended with C<CGI_>, as well as all non-word characters converted to
+C<_>s. This is because L<Catalyst> action names can't have non-word characters
+in them.
+
+This means that C<foo/bar.cgi> and C<foo__bar.cgi> for example will both map to
+the action C<CGI_foo__bar_cgi> so B<DON'T DO THAT>.
+
 =cut
 
 sub cgi_action {
     my ($self, $cgi) = @_;
 
-    my $action_name = 'CGI_' . join '_' => split '/' => $cgi;
+    my $action_name = 'CGI_' . join '__' => split '/' => $cgi;
     $action_name    =~ s/\W/_/g;
 
     $action_name
@@ -200,12 +203,15 @@ sub is_perl_cgi {
 Takes the path to a Perl CGI and returns a coderef suitable for passing to
 cgi_to_response (from L<Catalyst::Controller::WrapCGI>.)
 
-C<$action_name> is the generated name for the action representing the CGI file.
+C<$action_name> is the generated name for the action representing the CGI file
+from C<cgi_action>.
 
 This is similar to how L<ModPerl::Registry> works, but will only work for
 well-written CGIs. Otherwise, you may have to override this method to do
 something more involved (see L<ModPerl::PerlRun>.)
 
+Scripts with C<__DATA__> sections now work too.
+
 =cut
 
 sub wrap_perl_cgi {
@@ -213,7 +219,7 @@ sub wrap_perl_cgi {
 
     my $code = slurp $cgi;
 
-    $code =~ s/^__DATA__\r?\n(.*)//ms;
+    $code =~ s/^__DATA__(?:\r?\n|\r\n?)(.*)//ms;
     my $data = $1;
 
     my $coderef = do {
diff --git a/lib/Catalyst/Controller/WrapCGI.pm b/lib/Catalyst/Controller/WrapCGI.pm
index c2d4cdb..5a05241 100644
--- a/lib/Catalyst/Controller/WrapCGI.pm
+++ b/lib/Catalyst/Controller/WrapCGI.pm
@@ -15,11 +15,11 @@ Catalyst::Controller::WrapCGI - Run CGIs in Catalyst
 
 =head1 VERSION
 
-Version 0.0028
+Version 0.0029
 
 =cut
 
-our $VERSION = '0.0028';
+our $VERSION = '0.0029';
 
 =head1 SYNOPSIS
 
diff --git a/t/cgibin.t b/t/cgibin.t
index 0a89f26..0ec5e96 100644
--- a/t/cgibin.t
+++ b/t/cgibin.t
@@ -6,7 +6,7 @@ use warnings;
 use FindBin '$Bin';
 use lib "$Bin/lib";
 
-use Test::More tests => 6;
+use Test::More tests => 7;
 
 use Catalyst::Test 'TestCGIBin';
 use HTTP::Request::Common;
@@ -50,6 +50,10 @@ $response = request POST '/cgihandler/mtfnpy', [
 is($response->content, 'foo:bar bar:baz',
     'POST to Perl CGI File through a forward via cgi_action');
 
+$response = request '/cgi-bin/path/testdata.pl';
+is($response->content, "testing\n",
+    'scripts with __DATA__ sections work');
+
 SKIP: {
     skip "Can't run shell scripts on non-*nix", 1
         if $^O eq 'MSWin32' || $^O eq 'VMS';
diff --git a/t/lib/TestCGIBin/Controller/CGIHandler.pm b/t/lib/TestCGIBin/Controller/CGIHandler.pm
index 0e18ee6..3a7409f 100644
--- a/t/lib/TestCGIBin/Controller/CGIHandler.pm
+++ b/t/lib/TestCGIBin/Controller/CGIHandler.pm
@@ -10,7 +10,7 @@ sub cgi_path {
 # try out a forward
 sub dongs : Local Args(0) {
     my ($self, $c) = @_;
-    $c->forward('/cgihandler/CGI_path_test_pl');
+    $c->forward('/cgihandler/CGI_path__test_pl');
 }
 
 # try resolved forward
diff --git a/t/lib/TestCGIBin/root/cgi-bin/path/testdata.pl b/t/lib/TestCGIBin/root/cgi-bin/path/testdata.pl
new file mode 100755
index 0000000..35fbebc
--- /dev/null
+++ b/t/lib/TestCGIBin/root/cgi-bin/path/testdata.pl
@@ -0,0 +1,12 @@
+#!/usr/bin/perl 
+
+use strict;
+use warnings;
+
+use CGI ':standard';
+
+print header;
+print do { local $/; <DATA> };
+
+__DATA__
+testing