[Catalyst-commits] r13144 - in trunk/Catalyst-Controller-WrapCGI: . lib/Catalyst/Controller t t/lib t/lib/TestCGIBin/root/cgi-bin

[caelum at dev.catalyst.perl.org]

Author: caelum
Date: 2010-04-07 18:49:16 +0100 (Wed, 07 Apr 2010)
New Revision: 13144

Added:
   trunk/Catalyst-Controller-WrapCGI/t/lib/TestCGIBin/root/cgi-bin/ignored.cgi
Modified:
   trunk/Catalyst-Controller-WrapCGI/Changes
   trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/CGIBin.pm
   trunk/Catalyst-Controller-WrapCGI/t/cgibin.t
   trunk/Catalyst-Controller-WrapCGI/t/lib/TestCGIBin.pm
Log:
added cgi_file_pattern option

Modified: trunk/Catalyst-Controller-WrapCGI/Changes
===================================================================
--- trunk/Catalyst-Controller-WrapCGI/Changes	2010-04-07 16:26:24 UTC (rev 13143)
+++ trunk/Catalyst-Controller-WrapCGI/Changes	2010-04-07 17:49:16 UTC (rev 13144)
@@ -1,6 +1,6 @@
 Revision history for Catalyst-Controller-WrapCGI
 
-    - added cgi_chain_root option for CGIBin
+    - added cgi_chain_root and cgi_file_pattern options for CGIBin
 
 0.027  2010-02-19 04:34:50
     - fix tests for Perl < 5.8.9

Modified: trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/CGIBin.pm
===================================================================
--- trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/CGIBin.pm	2010-04-07 16:26:24 UTC (rev 13143)
+++ trunk/Catalyst-Controller-WrapCGI/lib/Catalyst/Controller/CGIBin.pm	2010-04-07 17:49:16 UTC (rev 13144)
@@ -22,10 +22,6 @@
 
 Catalyst::Controller::CGIBin - Serve CGIs from root/cgi-bin
 
-=head1 VERSION
-
-Version 0.027
-
 =cut
 
 our $VERSION = '0.027';
@@ -41,9 +37,12 @@
 In your .conf:
 
     <Controller::Foo>
-        cgi_root_path  cgi-bin
-        cgi_dir        cgi-bin
-        cgi_chain_root /optional/private/path/to/Chained/root
+        cgi_root_path    cgi-bin
+        cgi_dir          cgi-bin
+        cgi_chain_root   /optional/private/path/to/Chained/root
+        cgi_file_pattern *.cgi
+        # or regex
+        cgi_file_pattern /\.pl\z/
         <CGI>
             username_field username # used for REMOTE_USER env var
             pass_env PERL5LIB
@@ -88,11 +87,20 @@
 Path from which to read CGI files. Can be relative to C<$MYAPP_HOME/root> or
 absolute.  Defaults to C<$MYAPP_HOME/root/cgi-bin>.
 
+=head2 cgi_file_pattern
+
+By default all files in L</cgi_dir> will be loaded as CGIs, however, with this
+option you can specify either a glob or a regex to match the names of files you
+want to be loaded.
+
+Can be an array of globs/regexes as well.
+
 =cut
 
-has cgi_root_path  => (is => 'ro', isa => 'Str', default => 'cgi-bin');
-has cgi_chain_root => (is => 'ro', isa => 'Str');
-has cgi_dir        => (is => 'ro', isa => 'Str', default => 'cgi-bin');
+has cgi_root_path    => (is => 'ro', isa => 'Str', default => 'cgi-bin');
+has cgi_chain_root   => (is => 'ro', isa => 'Str');
+has cgi_dir          => (is => 'ro', isa => 'Str', default => 'cgi-bin');
+has cgi_file_pattern => (is => 'rw', default => sub { ['*'] });
 
 sub register_actions {
     my ($self, $app) = @_;
@@ -105,7 +113,16 @@
 
     my $class = ref $self || $self;
 
-    for my $file (File::Find::Rule->file->in($cgi_bin)) {
+    my $patterns = $self->cgi_file_pattern;
+    $patterns = [ $patterns ] if not ref $patterns;
+    for my $pat (@$patterns) {
+        if ($pat =~ m{^/(.*)/\z}) {
+            $pat = qr/$1/;
+        }
+    }
+    $self->cgi_file_pattern($patterns);
+
+    for my $file (File::Find::Rule->file->name(@$patterns)->in($cgi_bin)) {
         my $cgi_path = abs2rel($file, $cgi_bin);
 
         next if any { $_ eq '.svn' } splitdir $cgi_path;
@@ -365,5 +382,4 @@
 =cut
 
 1; # End of Catalyst::Controller::CGIBin
-
-# vim: expandtab shiftwidth=4 ts=4 tw=80:
+# vim:et sw=4 sts=4 tw=0:

Modified: trunk/Catalyst-Controller-WrapCGI/t/cgibin.t
===================================================================
--- trunk/Catalyst-Controller-WrapCGI/t/cgibin.t	2010-04-07 16:26:24 UTC (rev 13143)
+++ trunk/Catalyst-Controller-WrapCGI/t/cgibin.t	2010-04-07 17:49:16 UTC (rev 13144)
@@ -49,6 +49,10 @@
 
 is($response->code, 500, 'POST to Perl CGI with nonzero exit()');
 
+$response = request '/my-bin/ignored.cgi';
+
+is($response->code, 500, "file not matching 'cgi_file_pattern' is ignored");
+
 $response = request POST '/cgihandler/mtfnpy', [
     foo => 'bar',
     bar => 'baz'

Added: trunk/Catalyst-Controller-WrapCGI/t/lib/TestCGIBin/root/cgi-bin/ignored.cgi
===================================================================
--- trunk/Catalyst-Controller-WrapCGI/t/lib/TestCGIBin/root/cgi-bin/ignored.cgi	                        (rev 0)
+++ trunk/Catalyst-Controller-WrapCGI/t/lib/TestCGIBin/root/cgi-bin/ignored.cgi	2010-04-07 17:49:16 UTC (rev 13144)
@@ -0,0 +1,9 @@
+#!/usr/bin/perl 
+
+use strict;
+use warnings;
+
+use CGI ':standard';
+
+print header;
+print "THIS CGI SHOULD NOT RUN\n";


Property changes on: trunk/Catalyst-Controller-WrapCGI/t/lib/TestCGIBin/root/cgi-bin/ignored.cgi
___________________________________________________________________
Added: svn:executable
   + *

Modified: trunk/Catalyst-Controller-WrapCGI/t/lib/TestCGIBin.pm
===================================================================
--- trunk/Catalyst-Controller-WrapCGI/t/lib/TestCGIBin.pm	2010-04-07 16:26:24 UTC (rev 13143)
+++ trunk/Catalyst-Controller-WrapCGI/t/lib/TestCGIBin.pm	2010-04-07 17:49:16 UTC (rev 13144)
@@ -3,6 +3,12 @@
 use Catalyst::Runtime '5.70';
 use parent 'Catalyst';
 
+__PACKAGE__->config({
+    Controller::CGIHandler => {
+        cgi_file_pattern => ['*.sh', qr/\.pl\z/]
+    },
+});
+
 __PACKAGE__->setup(qw/Static::Simple/);
 
 1;