From: Rafael Kitover <rkitover@cpan.org>
Date: Sun, 22 May 2011 09:16:16 +0000 (-0400)
Subject: fixes for Win32
X-Git-Tag: 0.032~1
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Controller-WrapCGI.git;a=commitdiff_plain;h=fa86df5d730aee066e7952963c099f398ff04cfc

fixes for Win32
---

diff --git a/Changes b/Changes
index a993876..ee33b2a 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,7 @@
 Revision history for Catalyst-Controller-WrapCGI
 
+    - now works on Win32
+
 0.031  2011-05-20 23:28:23
     - fix CGIBin.pm bug hardcoding 'root' as the site root
 
diff --git a/Makefile.PL b/Makefile.PL
index 241cbeb..76cc7aa 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -19,6 +19,8 @@ requires 'Task::Weaken';
 requires 'LWP';
 requires 'Moose';
 
+requires 'Class::Unload' if $^O eq 'MSWin32';
+
 test_requires 'Test::More' => '0.92';
 test_requires 'Catalyst::Plugin::Static::Simple';
 test_requires 'CGI';
diff --git a/lib/Catalyst/Controller/CGIBin.pm b/lib/Catalyst/Controller/CGIBin.pm
index 8edab57..f9a42dc 100644
--- a/lib/Catalyst/Controller/CGIBin.pm
+++ b/lib/Catalyst/Controller/CGIBin.pm
@@ -186,7 +186,7 @@ sub register_actions {
     $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 }
@@ -250,6 +250,15 @@ L</wrap_perl_cgi>.
 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;
@@ -298,8 +307,22 @@ C<exit()>.
 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
diff --git a/t/lib/TestCGIBin/root/cgi-bin/sigs.pl b/t/lib/TestCGIBin/root/cgi-bin/sigs.pl
index d7e89c1..b1a98fc 100755
--- a/t/lib/TestCGIBin/root/cgi-bin/sigs.pl
+++ b/t/lib/TestCGIBin/root/cgi-bin/sigs.pl
@@ -5,8 +5,8 @@ use warnings;
 
 use CGI ':standard';
 
-BEGIN { $SIG{USR1} = 'IGNORE'; }
+BEGIN { $SIG{INT} = 'IGNORE'; }
 
-$SIG{USR1} = 'IGNORE';
+$SIG{INT} = 'IGNORE';
 
 print header;