package Catalyst::Controller::CGIBin;
use Moose;
+use Moose::Util::TypeConstraints;
use mro 'c3';
extends 'Catalyst::Controller::WrapCGI';
use File::Find::Rule ();
-use Catalyst::Exception ();
use File::Spec::Functions qw/splitdir abs2rel/;
use IPC::Open3;
use Symbol 'gensym';
use File::Temp 'tempfile';
use File::pushd;
use CGI::Compile;
-
+
use namespace::clean -except => 'meta';
=head1 NAME
=cut
-our $VERSION = '0.028';
+our $VERSION = '0.031';
=head1 SYNOPSIS
=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_file_pattern => (is => 'rw', default => sub { ['*'] });
+{ my $stringified = subtype as 'Str';
+ coerce $stringified,
+ from 'Object',
+ via { "$_" };
+
+ has cgi_root_path => (is => 'ro', coerce => 1, isa => $stringified, default => 'cgi-bin' );
+ has cgi_chain_root => (is => 'ro', isa => 'Str');
+ has cgi_dir => (is => 'ro', coerce => 1, isa => $stringified, default => 'cgi-bin');
+ has cgi_file_pattern => (is => 'rw', default => sub { ['*'] });
+
+}
sub register_actions {
my ($self, $app) = @_;
- my $cgi_bin = File::Spec->file_name_is_absolute($self->cgi_dir) ?
- $self->cgi_dir
- : $app->path_to('root', $self->cgi_dir);
+ my $cgi_bin;
+ if( File::Spec->file_name_is_absolute($self->cgi_dir) ) {
+ $cgi_bin = $self->cgi_dir;
+ } elsif( File::Spec->file_name_is_absolute( $app->config->{root} ) ) {
+ $cgi_bin = File::Spec->catdir( $app->config->{root}, $self->cgi_dir );
+ } else {
+ $cgi_bin = $app->path_to( $app->config->{root}, $self->cgi_dir);
+ }
my $namespace = $self->action_namespace($app);
$self->next::method($app, @_);
# Tell Static::Simple to ignore cgi_dir
- if ($cgi_bin =~ /^@{[ $app->path_to('root') ]}/) {
+ if ($cgi_bin =~ /^\Q@{[ $app->path_to('root') ]}\E/) {
my $rel = File::Spec->abs2rel($cgi_bin, $app->path_to('root'));
if (!any { $_ eq $rel }
sub is_perl_cgi {
my ($self, $cgi) = @_;
+ if ($^O eq 'MSWin32') {
+ # the fork code fails on Win32
+ eval { $self->wrap_perl_cgi($cgi, '__DUMMY__') };
+ my $success = $@ ? 0 : 1;
+ require Class::Unload;
+ Class::Unload->unload($self->cgi_package('__DUMMY__'));
+ return $success;
+ }
+
my (undef, $tempfile) = tempfile;
my $pid = fork;
sub wrap_perl_cgi {
my ($self, $cgi, $action_name) = @_;
- return CGI::Compile->compile($cgi,
- "Catalyst::Controller::CGIBin::_CGIs_::$action_name");
+ return CGI::Compile->compile($cgi, $self->cgi_package($action_name));
+}
+
+=head2 cgi_package
+
+C<< $self->cgi_package($action_name) >>
+
+Returns the package name a Perl CGI is compiled into for a given
+C<$action_name>.
+
+=cut
+
+sub cgi_package {
+ my ($self, $action_name) = @_;
+
+ return "Catalyst::Controller::CGIBin::_CGIs_::$action_name";
}
=head2 wrap_nonperl_cgi