From: Rafael Kitover <rkitover@cpan.org>
Date: Wed, 7 Apr 2010 17:49:16 +0000 (+0000)
Subject: added cgi_file_pattern option
X-Git-Tag: 0.030~7
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Controller-WrapCGI.git;a=commitdiff_plain;h=9e040aebffbc0138554c21c3122dbd86b919d246

added cgi_file_pattern option
---

diff --git a/Changes b/Changes
index 65c51f6..7d47fcc 100644
--- a/Changes
+++ b/Changes
@@ -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
diff --git a/lib/Catalyst/Controller/CGIBin.pm b/lib/Catalyst/Controller/CGIBin.pm
index 52bb1a2..4e6aefa 100644
--- a/lib/Catalyst/Controller/CGIBin.pm
+++ b/lib/Catalyst/Controller/CGIBin.pm
@@ -22,10 +22,6 @@ use namespace::clean -except => 'meta';
 
 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 controller:
 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 @@ the path to the CGI file.
 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 @@ sub register_actions {
 
     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 @@ under the same terms as Perl itself.
 =cut
 
 1; # End of Catalyst::Controller::CGIBin
-
-# vim: expandtab shiftwidth=4 ts=4 tw=80:
+# vim:et sw=4 sts=4 tw=0:
diff --git a/t/cgibin.t b/t/cgibin.t
index ce36f1b..e1798ec 100644
--- a/t/cgibin.t
+++ b/t/cgibin.t
@@ -49,6 +49,10 @@ $response = request POST '/my-bin/exit.pl', [
 
 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'
diff --git a/t/lib/TestCGIBin.pm b/t/lib/TestCGIBin.pm
index bfe8eaf..e9caa54 100644
--- a/t/lib/TestCGIBin.pm
+++ b/t/lib/TestCGIBin.pm
@@ -3,6 +3,12 @@ package TestCGIBin;
 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;
diff --git a/t/lib/TestCGIBin/root/cgi-bin/ignored.cgi b/t/lib/TestCGIBin/root/cgi-bin/ignored.cgi
new file mode 100755
index 0000000..6e8f5f1
--- /dev/null
+++ b/t/lib/TestCGIBin/root/cgi-bin/ignored.cgi
@@ -0,0 +1,9 @@
+#!/usr/bin/perl 
+
+use strict;
+use warnings;
+
+use CGI ':standard';
+
+print header;
+print "THIS CGI SHOULD NOT RUN\n";