[Catalyst-commits] r9811 - Catalyst-Devel/1.00/branches/improved-restarter/lib/Catalyst

autarch at dev.catalyst.perl.org autarch at dev.catalyst.perl.org
Fri Apr 24 02:02:19 GMT 2009


Author: autarch
Date: 2009-04-24 03:02:19 +0100 (Fri, 24 Apr 2009)
New Revision: 9811

Added:
   Catalyst-Devel/1.00/branches/improved-restarter/lib/Catalyst/Restarter.pm
   Catalyst-Devel/1.00/branches/improved-restarter/lib/Catalyst/Watcher.pm
Modified:
   Catalyst-Devel/1.00/branches/improved-restarter/lib/Catalyst/Devel.pm
   Catalyst-Devel/1.00/branches/improved-restarter/lib/Catalyst/Helper.pm
Log:
Revamped how the restarter stuff works so it's totally separate from
the Catalyst Engine modules.

This is _much_ simpler, and there's no need to test for
reloadability. If it fails to reload, the server dies, but it keeps
watching for changes, and will keep trying to reload as you change
things.

Modified: Catalyst-Devel/1.00/branches/improved-restarter/lib/Catalyst/Devel.pm
===================================================================
--- Catalyst-Devel/1.00/branches/improved-restarter/lib/Catalyst/Devel.pm	2009-04-24 01:54:03 UTC (rev 9810)
+++ Catalyst-Devel/1.00/branches/improved-restarter/lib/Catalyst/Devel.pm	2009-04-24 02:02:19 UTC (rev 9811)
@@ -4,7 +4,7 @@
 use warnings;
 
 our $VERSION             = '1.10';
-our $CATALYST_SCRIPT_GEN = 32;
+our $CATALYST_SCRIPT_GEN = 33;
 
 =head1 NAME
 

Modified: Catalyst-Devel/1.00/branches/improved-restarter/lib/Catalyst/Helper.pm
===================================================================
--- Catalyst-Devel/1.00/branches/improved-restarter/lib/Catalyst/Helper.pm	2009-04-24 01:54:03 UTC (rev 9810)
+++ Catalyst-Devel/1.00/branches/improved-restarter/lib/Catalyst/Helper.pm	2009-04-24 02:02:19 UTC (rev 9811)
@@ -969,12 +969,12 @@
 my $port              = $ENV{[% appenv %]_PORT} || $ENV{CATALYST_PORT} || 3000;
 my $keepalive         = 0;
 my $restart           = $ENV{[% appenv %]_RELOAD} || $ENV{CATALYST_RELOAD} || 0;
-my $restart_delay     = 1;
-my $restart_regex     = '(?:/|^)(?!\.#).+(?:\.yml$|\.yaml$|\.conf|\.pm)$';
-my $restart_directory = undef;
-my $follow_symlinks   = 0;
-my $background        = 0;
 
+my $check_interval;
+my $file_regex;
+my $watch_directory;
+my $follow_symlinks;
+
 my @argv = @ARGV;
 
 GetOptions(
@@ -985,38 +985,59 @@
     'port=s'              => \$port,
     'keepalive|k'         => \$keepalive,
     'restart|r'           => \$restart,
-    'restartdelay|rd=s'   => \$restart_delay,
-    'restartregex|rr=s'   => \$restart_regex,
-    'restartdirectory=s@' => \$restart_directory,
+    'restartdelay|rd=s'   => \$check_interval,
+    'restartregex|rr=s'   => \$file_regex,
+    'restartdirectory=s@' => \$watch_directory,
     'followsymlinks'      => \$follow_symlinks,
-    'background'          => \$background,
 );
 
 pod2usage(1) if $help;
 
-if ( $restart && $ENV{CATALYST_ENGINE} eq 'HTTP' ) {
-    $ENV{CATALYST_ENGINE} = 'HTTP::Restarter';
-}
 if ( $debug ) {
     $ENV{CATALYST_DEBUG} = 1;
 }
 
-# This is require instead of use so that the above environment
-# variables can be set at runtime.
-require [% name %];
+# If we load this here, then in the case of a restarter, it does not
+# need to be reloaded for each restart.
+require Catalyst;
 
-[% name %]->run( $port, $host, {
-    argv              => \@argv,
-    'fork'            => $fork,
-    keepalive         => $keepalive,
-    restart           => $restart,
-    restart_delay     => $restart_delay,
-    restart_regex     => qr/$restart_regex/,
-    restart_directory => $restart_directory,
-    follow_symlinks   => $follow_symlinks,
-    background        => $background,
-} );
+my $runner = sub {
+    # This is require instead of use so that the above environment
+    # variables can be set at runtime.
+    require [% name %];
 
+    [% name %]->run(
+        $port, $host,
+        {
+            argv      => \@argv,
+            'fork'    => $fork,
+            keepalive => $keepalive,
+        }
+    );
+};
+
+if ( $restart ) {
+    require Catalyst::Restarter;
+
+    my %args;
+    $args{watch_directory} = $watch_directory
+        if defined $watch_directory;
+    $args{check_interval} = $check_interval
+        if defined $check_interval;
+    $args{file_regex} = qr/$file_regex/
+        if defined $file_regex;
+
+    my $restarter = Catalyst::Restarter->new(
+        %args,
+        restart_sub => $runner,
+    );
+
+    $restarter->run_and_watch;
+}
+else {
+    $runner->();
+}
+
 1;
 
 =head1 NAME

Added: Catalyst-Devel/1.00/branches/improved-restarter/lib/Catalyst/Restarter.pm
===================================================================
--- Catalyst-Devel/1.00/branches/improved-restarter/lib/Catalyst/Restarter.pm	                        (rev 0)
+++ Catalyst-Devel/1.00/branches/improved-restarter/lib/Catalyst/Restarter.pm	2009-04-24 02:02:19 UTC (rev 9811)
@@ -0,0 +1,93 @@
+package Catalyst::Restarter;
+
+use Moose;
+
+use Catalyst::Watcher;
+use File::Spec;
+use FindBin;
+use namespace::clean -except => 'meta';
+
+has restart_sub => (
+    is       => 'ro',
+    isa      => 'CodeRef',
+    required => 1,
+);
+
+has _watcher => (
+    is  => 'rw',
+    isa => 'Catalyst::Watcher',
+);
+
+has _child => (
+    is  => 'rw',
+    isa => 'Int',
+);
+
+sub BUILD {
+    my $self = shift;
+    my $p    = shift;
+
+    delete $p->{restart_sub};
+
+    # We could make this lazily, but this lets us check that we
+    # received valid arguments for the watcher up front.
+    $self->_watcher( Catalyst::Watcher->new( %{$p} ) );
+}
+
+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;
+
+    if ( my $pid = fork ) {
+        $self->_child($pid);
+    }
+    else {
+        $self->restart_sub->();
+    }
+}
+
+sub _restart_on_changes {
+    my $self = shift;
+
+    my $watcher = $self->_watcher;
+
+    while (1) {
+        my @files = $watcher->find_changed_files
+            or next;
+
+        print STDERR "Saw changes to the following files:\n";
+        print STDERR " - $_->{file} ($_->{status})\n" for @files;
+        print STDERR "\n";
+        print STDERR "Attempting to restart the server\n\n";
+
+        if ( $self->_child ) {
+            kill 2, $self->_child
+                or die "Cannot send INT to child (" . $self->_child . "): $!";
+        }
+
+        $self->_fork_and_start;
+
+        return unless $self->_child;
+    }
+}
+
+sub DEMOLISH {
+    my $self = shift;
+
+    if ( $self->_child ) {
+        kill 2, $self->_child;
+    }
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;


Property changes on: Catalyst-Devel/1.00/branches/improved-restarter/lib/Catalyst/Restarter.pm
___________________________________________________________________
Name: svn:keywords
   + Author Date Id Rev
Name: svn:eol-style
   + native

Added: Catalyst-Devel/1.00/branches/improved-restarter/lib/Catalyst/Watcher.pm
===================================================================
--- Catalyst-Devel/1.00/branches/improved-restarter/lib/Catalyst/Watcher.pm	                        (rev 0)
+++ Catalyst-Devel/1.00/branches/improved-restarter/lib/Catalyst/Watcher.pm	2009-04-24 02:02:19 UTC (rev 9811)
@@ -0,0 +1,214 @@
+package Catalyst::Watcher;
+
+use Moose;
+use Moose::Util::TypeConstraints;
+
+use File::Find;
+use File::Modified;
+use File::Spec;
+use Time::HiRes qw/sleep/;
+use namespace::clean -except => 'meta';
+
+has interval => (
+    is      => 'ro',
+    isa     => 'Int',
+    default => 1,
+);
+
+has regex => (
+    is      => 'ro',
+    isa     => 'RegexpRef',
+    default => sub { qr/(?:\/|^)(?!\.\#).+(?:\.yml$|\.yaml$|\.conf|\.pm)$/ },
+);
+
+my $dir = subtype
+       as 'Str'
+    => where { -d $_ }
+    => message { "$_ is not a valid directory" };
+
+my $array_of_dirs = subtype
+       as 'ArrayRef[Str]',
+    => where { map { -d } @{$_} }
+    => message { "@{$_} is not a list of valid directories" };
+
+coerce $array_of_dirs
+    => from $dir
+    => via { [ $_ ] };
+
+has directory => (
+    is      => 'ro',
+    isa     => $array_of_dirs,
+    default => sub { [ File::Spec->rel2abs( File::Spec->catdir( $FindBin::Bin, '..' ) ) ] },
+    coerce  => 1,
+);
+
+has follow_symlinks => (
+    is      => 'ro',
+    isa     => 'Bool',
+    default => 0,
+);
+
+has _watched_files => (
+    is         => 'ro',
+    isa        => 'HashRef[Str]',
+    lazy_build => 1,
+    clearer    => '_clear_watched_files',
+);
+
+has _modified => (
+    is         => 'rw',
+    isa        => 'File::Modified',
+    lazy_build => 1,
+);
+
+sub _build__watched_files {
+    my $self = shift;
+
+    my $regex = $self->regex;
+
+    my %list;
+    finddepth(
+        {
+            wanted => sub {
+                my $file = File::Spec->rel2abs($File::Find::name);
+                return unless $file =~ /$regex/;
+                return unless -f $file;
+
+                $list{$file} = 1;
+
+                # also watch the directory for changes
+                my $cur_dir = File::Spec->rel2abs($File::Find::dir);
+                $cur_dir =~ s{/script/..}{};
+                $list{$cur_dir} = 1;
+            },
+            follow_fast => $self->follow_symlinks ? 1 : 0,
+            no_chdir    => 1
+        },
+        @{ $self->directory }
+    );
+
+    return \%list;
+}
+
+sub _build__modified {
+    my $self = shift;
+
+    return File::Modified->new(
+        method => 'mtime',
+        files  => [ keys %{ $self->_watched_files } ],
+    );
+}
+
+sub find_changed_files {
+    my $self = shift;
+
+    my @changes;
+    my @changed_files;
+
+    sleep $self->interval if $self->interval > 0;
+
+    eval { @changes = $self->_modified->changed };
+    if ($@) {
+        # File::Modified will die if a file is deleted.
+        my ($deleted_file) = $@ =~ /stat '(.+)'/;
+        push @changed_files,
+            {
+            file => $deleted_file || 'unknown file',
+            status => 'deleted',
+            };
+    }
+
+    if (@changes) {
+        $self->_modified->update;
+
+        @changed_files = map { { file => $_, status => 'modified' } }
+            grep { -f $_ } @changes;
+
+        # We also need to check to see if a new directory was created
+        unless (@changed_files) {
+            my $old_watch = $self->_watched_files;
+
+            $self->_clear_watched_files;
+
+            my $new_watch = $self->_watched_files;
+
+            @changed_files
+                = map { { file => $_, status => 'added' } }
+                grep { !defined $old_watch->{$_} }
+                keys %{$new_watch};
+
+            return unless @changed_files;
+        }
+    }
+
+    return @changed_files;
+}
+
+__PACKAGE__->meta->make_immutable;
+
+1;
+
+__END__
+
+=head1 NAME
+
+Catalyst::Watcher - Watch for changed application files
+
+=head1 SYNOPSIS
+
+    my $watcher = Catalyst::Engine::HTTP::Restarter::Watcher->new(
+        directory => '/path/to/MyApp',
+        regex     => '\.yml$|\.yaml$|\.conf|\.pm$',
+        delay     => 1,
+    );
+    
+    while (1) {
+        my @changed_files = $watcher->watch();
+    }
+
+=head1 DESCRIPTION
+
+This class monitors a directory of files for changes made to any file
+matching a regular expression.  It correctly handles new files added to the
+application as well as files that are deleted.
+
+=head1 METHODS
+
+=head2 new ( directory => $path [, regex => $regex, delay => $delay ] )
+
+Creates a new Watcher object.
+
+=head2 watch
+
+Returns a list of files that have been added, deleted, or changed since the
+last time watch was called.
+
+=head2 DETECT_PACKAGE_COMPILATION
+
+Returns true if L<B::Hooks::OP::Check::StashChange> is installed and
+can be used to detect when files are compiled. This is used internally
+to make the L<Moose> metaclass of any class being reloaded immutable.
+
+If L<B::Hooks::OP::Check::StashChange> is not installed, then the
+restarter makes all application components immutable. This covers the
+simple case, but is less useful if you're using Moose in components
+outside Catalyst's namespaces, but inside your application directory.
+
+=head1 SEE ALSO
+
+L<Catalyst>, L<Catalyst::Engine::HTTP::Restarter>, L<File::Modified>
+
+=head1 AUTHORS
+
+Catalyst Contributors, see Catalyst.pm
+
+=head1 THANKS
+
+Many parts are ripped out of C<HTTP::Server::Simple> by Jesse Vincent.
+
+=head1 COPYRIGHT
+
+This program is free software, you can redistribute it and/or modify it under
+the same terms as Perl itself.
+
+=cut


Property changes on: Catalyst-Devel/1.00/branches/improved-restarter/lib/Catalyst/Watcher.pm
___________________________________________________________________
Name: svn:keywords
   + Author Date Id Rev
Name: svn:eol-style
   + native




More information about the Catalyst-commits mailing list