[Catalyst-commits] r10201 - in Catalyst-Devel/1.00/trunk: .
lib/Catalyst lib/Catalyst/Restarter
autarch at dev.catalyst.perl.org
autarch at dev.catalyst.perl.org
Tue May 19 16:13:06 GMT 2009
Author: autarch
Date: 2009-05-19 16:13:06 +0000 (Tue, 19 May 2009)
New Revision: 10201
Added:
Catalyst-Devel/1.00/trunk/lib/Catalyst/Restarter/
Catalyst-Devel/1.00/trunk/lib/Catalyst/Restarter/Forking.pm
Catalyst-Devel/1.00/trunk/lib/Catalyst/Restarter/Win32.pm
Modified:
Catalyst-Devel/1.00/trunk/Makefile.PL
Catalyst-Devel/1.00/trunk/lib/Catalyst/Helper.pm
Catalyst-Devel/1.00/trunk/lib/Catalyst/Restarter.pm
Log:
It turns out the restarter didn't really work on Win32. This checkin
adds a hacktastic Win32-specific restarter that uses Proc::Background
(which uses Win32::Process) and actually works.
You won't get any of the benefits of the new restarter code on Win32,
since it reloads everything on every restart, but it does actually
seem to work, and it's not any worse than the old version.
Modified: Catalyst-Devel/1.00/trunk/Makefile.PL
===================================================================
--- Catalyst-Devel/1.00/trunk/Makefile.PL 2009-05-19 01:01:08 UTC (rev 10200)
+++ Catalyst-Devel/1.00/trunk/Makefile.PL 2009-05-19 16:13:06 UTC (rev 10201)
@@ -16,6 +16,13 @@
requires 'Path::Class' => '0.09';
requires 'Template' => '2.14';
+if ( $^O eq 'MSWin32' ) {
+ # Proc::Background needs tihs on Win32 but doesn't actually
+ # require it, if it's missing it just dies in the Makefile.PL.
+ requires 'Win32::Process' => '0.04';
+ requires 'Proc::Background';
+}
+
if (!$ENV{CATALYST_DEVEL_NO_510_CHECK}) {
use Symbol 'gensym';
use IPC::Open3;
Modified: Catalyst-Devel/1.00/trunk/lib/Catalyst/Helper.pm
===================================================================
--- Catalyst-Devel/1.00/trunk/lib/Catalyst/Helper.pm 2009-05-19 01:01:08 UTC (rev 10200)
+++ Catalyst-Devel/1.00/trunk/lib/Catalyst/Helper.pm 2009-05-19 16:13:06 UTC (rev 10201)
@@ -1031,11 +1031,13 @@
};
if ( $restart ) {
- require Catalyst::Restarter;
-
die "Cannot run in the background and also watch for changed files.\n"
if $background;
+ require Catalyst::Restarter;
+
+ my $subclass = Catalyst::Restarter->pick_subclass;
+
my %args;
$args{follow_symlinks} = 1
if $follow_symlinks;
@@ -1046,7 +1048,7 @@
$args{filter} = qr/$file_regex/
if defined $file_regex;
- my $restarter = Catalyst::Restarter->new(
+ my $restarter = $subclass->new(
%args,
start_sub => $runner,
);
Added: Catalyst-Devel/1.00/trunk/lib/Catalyst/Restarter/Forking.pm
===================================================================
--- Catalyst-Devel/1.00/trunk/lib/Catalyst/Restarter/Forking.pm (rev 0)
+++ Catalyst-Devel/1.00/trunk/lib/Catalyst/Restarter/Forking.pm 2009-05-19 16:13:06 UTC (rev 10201)
@@ -0,0 +1,39 @@
+package Catalyst::Restarter::Forking;
+
+use Moose;
+
+use threads;
+use Thread::Cancel;
+
+extends 'Catalyst::Restarter';
+
+has _child => (
+ is => 'rw',
+ isa => 'Int',
+);
+
+
+sub _fork_and_start {
+ my $self = shift;
+
+ if ( my $pid = fork ) {
+ $self->_child($pid);
+ }
+ else {
+ $self->start_sub->();
+ }
+}
+
+sub _kill_child {
+ my $self = shift;
+
+ return unless $self->_child;
+
+ return unless kill 0, $self->_child;
+
+ local $SIG{CHLD} = 'IGNORE';
+ die "Cannot send INT signal to ", $self->_child, ": $!"
+ unless kill 'INT', $self->_child;
+}
+
+1;
Property changes on: Catalyst-Devel/1.00/trunk/lib/Catalyst/Restarter/Forking.pm
___________________________________________________________________
Name: svn:keywords
+ Author Date Id Rev
Name: svn:eol-style
+ native
Added: Catalyst-Devel/1.00/trunk/lib/Catalyst/Restarter/Win32.pm
===================================================================
--- Catalyst-Devel/1.00/trunk/lib/Catalyst/Restarter/Win32.pm (rev 0)
+++ Catalyst-Devel/1.00/trunk/lib/Catalyst/Restarter/Win32.pm 2009-05-19 16:13:06 UTC (rev 10201)
@@ -0,0 +1,44 @@
+package Catalyst::Restarter::Win32;
+
+use Moose;
+use Proc::Background;
+
+extends 'Catalyst::Restarter';
+
+has _child => (
+ is => 'rw',
+ isa => 'Proc::Background',
+);
+
+
+sub run_and_watch {
+ my $self = shift;
+
+ $self->_fork_and_start;
+
+ return unless $self->_child;
+
+ $self->_restart_on_changes;
+}
+
+sub _fork_and_start {
+ my $self = shift;
+
+ # This is totally hack-tastic, and is probably much slower, but it
+ # does seem to work.
+ my @command = ( $^X, $0, grep { ! /^\-r/ } @ARGV );
+
+ my $child = Proc::Background->new(@command);
+
+ $self->_child($child);
+}
+
+sub _kill_child {
+ my $self = shift;
+
+ return unless $self->_child;
+
+ $self->_child->die;
+}
+
+1;
Property changes on: Catalyst-Devel/1.00/trunk/lib/Catalyst/Restarter/Win32.pm
___________________________________________________________________
Name: svn:keywords
+ Author Date Id Rev
Name: svn:eol-style
+ native
Modified: Catalyst-Devel/1.00/trunk/lib/Catalyst/Restarter.pm
===================================================================
--- Catalyst-Devel/1.00/trunk/lib/Catalyst/Restarter.pm 2009-05-19 01:01:08 UTC (rev 10200)
+++ Catalyst-Devel/1.00/trunk/lib/Catalyst/Restarter.pm 2009-05-19 16:13:06 UTC (rev 10201)
@@ -23,6 +23,25 @@
isa => 'Int',
);
+sub pick_subclass {
+ my $class = shift;
+
+ my $subclass;
+ $subclass =
+ defined $ENV{CATALYST_RESTARTER}
+ ? $ENV{CATALYST_RESTARTER}
+ : $^O eq 'MSWin32'
+ ? 'Win32'
+ : 'Forking';
+
+ $subclass = 'Catalyst::Restarter::' . $subclass;
+
+ eval "use $subclass";
+ die $@ if $@;
+
+ return $subclass;
+}
+
sub BUILD {
my $self = shift;
my $p = shift;
@@ -47,17 +66,6 @@
$self->_restart_on_changes;
}
-sub _fork_and_start {
- my $self = shift;
-
- if ( my $pid = fork ) {
- $self->_child($pid);
- }
- else {
- $self->start_sub->();
- }
-}
-
sub _restart_on_changes {
my $self = shift;
@@ -89,22 +97,6 @@
$self->_restart_on_changes;
}
-sub _kill_child {
- my $self = shift;
-
- return unless $self->_child;
-
- return unless kill 0, $self->_child;
-
- local $SIG{CHLD} = 'IGNORE';
- unless ( kill 'INT', $self->_child ) {
- # The kill 0 thing does not work on Windows, but the restarter
- # seems to work fine on Windows with this hack.
- return if $^O eq 'MSWin32';
- die "Cannot send INT signal to ", $self->_child, ": $!";
- }
-}
-
sub DEMOLISH {
my $self = shift;
More information about the Catalyst-commits
mailing list