Hello,
I like the auto-restart feature that is in the Catalyst HTTP::Restarter
server. I wanted to use the restarting trick with a project based on
HTTP::Server::Simple, so I looked to see how tied this functionality was to
Catalyst. Here's what I found:
Catalyst::Engine::HTTP::Restarter::Watcher is not functionally tied to
Catalyst at all. It just shares a namespace.
Catalyst::Engine::HTTP::Restarter depends on no functionality from Catalyst
but was still coupled with it through a base-class relationship which could
be easily avoided.
The attached patch moves these to modules into the HTTP::Server::Restarter
namespace, and makes slight alternations to the other Catalyst files so
that the functionality remains the same, as well as the dependencies.
The patch provides significantly improved documentation for some related
functions as well.
Thank you for your consideration.
Mark
Sat Jul 21 22:40:44 EDT 2007 Mark Stosberg <[EMAIL PROTECTED]>
* refactor HTTP::Server::Restarter out as stand-alone module.
Sat Jul 21 17:46:28 EDT 2007 Mark Stosberg <[EMAIL PROTECTED]>
* add documentation to Catalyst::Engine::HTTP::Restarter
diff -rN -u old-catalyst_vs_cgiapp/lib/Catalyst/Engine/HTTP/Restarter/Watcher.pm new-catalyst_vs_cgiapp/lib/Catalyst/Engine/HTTP/Restarter/Watcher.pm
--- old-catalyst_vs_cgiapp/lib/Catalyst/Engine/HTTP/Restarter/Watcher.pm 2007-07-21 22:43:56.000000000 -0400
+++ new-catalyst_vs_cgiapp/lib/Catalyst/Engine/HTTP/Restarter/Watcher.pm 1969-12-31 19:00:00.000000000 -0500
@@ -1,200 +0,0 @@
-package Catalyst::Engine::HTTP::Restarter::Watcher;
-
-use strict;
-use warnings;
-use base 'Class::Accessor::Fast';
-use File::Find;
-use File::Modified;
-use File::Spec;
-use Time::HiRes qw/sleep/;
-
-__PACKAGE__->mk_accessors(
- qw/delay
- directory
- modified
- regex
- watch_list/
-);
-
-sub new {
- my ( $class, %args ) = @_;
-
- my $self = {%args};
-
- bless $self, $class;
-
- $self->_init;
-
- return $self;
-}
-
-sub _init {
- my $self = shift;
-
- my $watch_list = $self->_index_directory;
- $self->watch_list($watch_list);
-
- $self->modified(
- File::Modified->new(
- method => 'mtime',
- files => [ keys %{$watch_list} ],
- )
- );
-}
-
-sub watch {
- my $self = shift;
-
- my @changes;
- my @changed_files;
-
- my $delay = ( defined $self->delay ) ? $self->delay : 1;
-
- sleep $delay if $delay > 0;
-
- eval { @changes = $self->modified->changed };
- if ($@) {
-
- # File::Modified will die if a file is deleted.
- my ($deleted_file) = $@ =~ /stat '(.+)'/;
- push @changed_files, $deleted_file || 'unknown file';
- }
-
- if (@changes) {
-
- # update all mtime information
- $self->modified->update;
-
- # check if any files were changed
- @changed_files = grep { -f $_ } @changes;
-
- # Check if only directories were changed. This means
- # a new file was created.
- unless (@changed_files) {
-
- # re-index to find new files
- my $new_watch = $self->_index_directory;
-
- # look through the new list for new files
- my $old_watch = $self->watch_list;
- @changed_files = grep { !defined $old_watch->{$_} }
- keys %{$new_watch};
-
- return unless @changed_files;
- }
-
- # Test modified pm's
- for my $file (@changed_files) {
- next unless $file =~ /\.pm$/;
- if ( my $error = $self->_test($file) ) {
- print STDERR qq/File "$file" modified, not restarting\n\n/;
- print STDERR '*' x 80, "\n";
- print STDERR $error;
- print STDERR '*' x 80, "\n";
- return;
- }
- }
- }
-
- return @changed_files;
-}
-
-sub _index_directory {
- my $self = shift;
-
- my $dir = $self->directory || die "No directory specified";
- my $regex = $self->regex || '\.pm$';
- my %list;
-
- finddepth(
- {
- wanted => sub {
- my $file = File::Spec->rel2abs($File::Find::name);
- return unless $file =~ /$regex/;
- return unless -f $file;
- $file =~ s{/script/..}{};
- $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;
- },
- no_chdir => 1
- },
- $dir
- );
- return \%list;
-}
-
-sub _test {
- my ( $self, $file ) = @_;
-
- delete $INC{$file};
- local $SIG{__WARN__} = sub { };
-
- open my $olderr, '>&STDERR';
- open STDERR, '>', File::Spec->devnull;
- eval "require '$file'";
- open STDERR, '>&', $olderr;
-
- return ($@) ? $@ : 0;
-}
-
-1;
-__END__
-
-=head1 NAME
-
-Catalyst::Engine::HTTP::Restarter::Watcher - Watch for changed application
-files
-
-=head1 SYNOPSIS
-
- my $watcher = Catalyst::Engine::HTTP::Restarter::Watcher->new(
- directory => '/path/to/MyApp',
- regex => '\.yml$|\.yaml$|\.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.
-
-=head1 SEE ALSO
-
-L<Catalyst>, L<Catalyst::Engine::HTTP::Restarter>, L<File::Modified>
-
-=head1 AUTHORS
-
-Sebastian Riedel, <[EMAIL PROTECTED]>
-
-Andy Grundman, <[EMAIL PROTECTED]>
-
-=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
diff -rN -u old-catalyst_vs_cgiapp/lib/Catalyst/Engine/HTTP/Restarter.pm new-catalyst_vs_cgiapp/lib/Catalyst/Engine/HTTP/Restarter.pm
--- old-catalyst_vs_cgiapp/lib/Catalyst/Engine/HTTP/Restarter.pm 2007-07-21 22:43:56.000000000 -0400
+++ new-catalyst_vs_cgiapp/lib/Catalyst/Engine/HTTP/Restarter.pm 2007-07-21 22:43:56.000000000 -0400
@@ -1,73 +1,7 @@
package Catalyst::Engine::HTTP::Restarter;
-
-use strict;
-use warnings;
use base 'Catalyst::Engine::HTTP';
-use Catalyst::Engine::HTTP::Restarter::Watcher;
-use NEXT;
-
-sub run {
- my ( $self, $class, $port, $host, $options ) = @_;
-
- $options ||= {};
-
- # Setup restarter
- unless ( my $restarter = fork ) {
-
- # Prepare
- close STDIN;
- close STDOUT;
-
- my $watcher = Catalyst::Engine::HTTP::Restarter::Watcher->new(
- directory => (
- $options->{restart_directory} ||
- File::Spec->catdir( $FindBin::Bin, '..' )
- ),
- regex => $options->{restart_regex},
- delay => $options->{restart_delay},
- );
-
- $host ||= '127.0.0.1';
- while (1) {
-
- # poll for changed files
- my @changed_files = $watcher->watch();
-
- # check if our parent process has died
- exit if $^O ne 'MSWin32' and getppid == 1;
-
- # Restart if any files have changed
- if (@changed_files) {
- my $files = join ', ', @changed_files;
- print STDERR qq/File(s) "$files" modified, restarting\n\n/;
-
- require IO::Socket::INET;
- require HTTP::Headers;
- require HTTP::Request;
-
- my $client = IO::Socket::INET->new(
- PeerAddr => $host,
- PeerPort => $port
- )
- or die "Can't create client socket (is server running?): ",
- $!;
-
- # build the Kill request
- my $req =
- HTTP::Request->new( 'RESTART', '/',
- HTTP::Headers->new( 'Connection' => 'close' ) );
- $req->protocol('HTTP/1.0');
-
- $client->send( $req->as_string )
- or die "Can't send restart instruction: ", $!;
- $client->close();
- exit;
- }
- }
- }
- return $self->NEXT::run( $class, $port, $host, $options );
-}
+# Functionality is now accessed through the superclass.
1;
__END__
diff -rN -u old-catalyst_vs_cgiapp/lib/Catalyst/Engine/HTTP.pm new-catalyst_vs_cgiapp/lib/Catalyst/Engine/HTTP.pm
--- old-catalyst_vs_cgiapp/lib/Catalyst/Engine/HTTP.pm 2007-07-21 22:43:56.000000000 -0400
+++ new-catalyst_vs_cgiapp/lib/Catalyst/Engine/HTTP.pm 2007-07-21 22:43:56.000000000 -0400
@@ -12,10 +12,6 @@
use IO::Socket::INET ();
use IO::Select ();
-# For PAR
-require Catalyst::Engine::HTTP::Restarter;
-require Catalyst::Engine::HTTP::Restarter::Watcher;
-
use constant CHUNKSIZE => 64 * 1024;
use constant DEBUG => $ENV{CATALYST_HTTP_DEBUG} || 0;
@@ -183,6 +179,19 @@
$self->{options} = $options;
+ # For PAR
+ require HTTP::Server::Restarter;
+ require HTTP::Server::Restarter::Watcher;
+ if ($options->{restart}) {
+ HTTP::Server::Restarter->monitor(
+ host => $host,
+ port => $port,
+ restart_regex => $options->{restart_regex},
+ restart_delay => $options->{restart_delay},
+ restart_directory => $options->{restart_directory},
+ );
+ }
+
if ($options->{background}) {
my $child = fork;
die "Can't fork: $!" unless defined($child);
diff -rN -u old-catalyst_vs_cgiapp/lib/HTTP/Server/Restarter/Watcher.pm new-catalyst_vs_cgiapp/lib/HTTP/Server/Restarter/Watcher.pm
--- old-catalyst_vs_cgiapp/lib/HTTP/Server/Restarter/Watcher.pm 1969-12-31 19:00:00.000000000 -0500
+++ new-catalyst_vs_cgiapp/lib/HTTP/Server/Restarter/Watcher.pm 2007-07-21 22:43:56.000000000 -0400
@@ -0,0 +1,200 @@
+package HTTP::Server::Restarter::Watcher;
+
+use strict;
+use warnings;
+use base 'Class::Accessor::Fast';
+use File::Find;
+use File::Modified;
+use File::Spec;
+use Time::HiRes qw/sleep/;
+
+__PACKAGE__->mk_accessors(
+ qw/delay
+ directory
+ modified
+ regex
+ watch_list/
+);
+
+sub new {
+ my ( $class, %args ) = @_;
+
+ my $self = {%args};
+
+ bless $self, $class;
+
+ $self->_init;
+
+ return $self;
+}
+
+sub _init {
+ my $self = shift;
+
+ my $watch_list = $self->_index_directory;
+ $self->watch_list($watch_list);
+
+ $self->modified(
+ File::Modified->new(
+ method => 'mtime',
+ files => [ keys %{$watch_list} ],
+ )
+ );
+}
+
+sub watch {
+ my $self = shift;
+
+ my @changes;
+ my @changed_files;
+
+ my $delay = ( defined $self->delay ) ? $self->delay : 1;
+
+ sleep $delay if $delay > 0;
+
+ eval { @changes = $self->modified->changed };
+ if ($@) {
+
+ # File::Modified will die if a file is deleted.
+ my ($deleted_file) = $@ =~ /stat '(.+)'/;
+ push @changed_files, $deleted_file || 'unknown file';
+ }
+
+ if (@changes) {
+
+ # update all mtime information
+ $self->modified->update;
+
+ # check if any files were changed
+ @changed_files = grep { -f $_ } @changes;
+
+ # Check if only directories were changed. This means
+ # a new file was created.
+ unless (@changed_files) {
+
+ # re-index to find new files
+ my $new_watch = $self->_index_directory;
+
+ # look through the new list for new files
+ my $old_watch = $self->watch_list;
+ @changed_files = grep { !defined $old_watch->{$_} }
+ keys %{$new_watch};
+
+ return unless @changed_files;
+ }
+
+ # Test modified pm's
+ for my $file (@changed_files) {
+ next unless $file =~ /\.pm$/;
+ if ( my $error = $self->_test($file) ) {
+ print STDERR qq/File "$file" modified, not restarting\n\n/;
+ print STDERR '*' x 80, "\n";
+ print STDERR $error;
+ print STDERR '*' x 80, "\n";
+ return;
+ }
+ }
+ }
+
+ return @changed_files;
+}
+
+sub _index_directory {
+ my $self = shift;
+
+ my $dir = $self->directory || die "No directory specified";
+ my $regex = $self->regex || '\.pm$';
+ my %list;
+
+ finddepth(
+ {
+ wanted => sub {
+ my $file = File::Spec->rel2abs($File::Find::name);
+ return unless $file =~ /$regex/;
+ return unless -f $file;
+ $file =~ s{/script/..}{};
+ $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;
+ },
+ no_chdir => 1
+ },
+ $dir
+ );
+ return \%list;
+}
+
+sub _test {
+ my ( $self, $file ) = @_;
+
+ delete $INC{$file};
+ local $SIG{__WARN__} = sub { };
+
+ open my $olderr, '>&STDERR';
+ open STDERR, '>', File::Spec->devnull;
+ eval "require '$file'";
+ open STDERR, '>&', $olderr;
+
+ return ($@) ? $@ : 0;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+HTTP::Server::Restarter::Watcher - Watch for changed application
+files
+
+=head1 SYNOPSIS
+
+ my $watcher = HTTP::Server::Restarter::Watcher->new(
+ directory => '/path/to/MyApp',
+ regex => '\.yml$|\.yaml$|\.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.
+
+=head1 SEE ALSO
+
+L<Catalyst>, L<HTTP::Server::Restarter>, L<File::Modified>
+
+=head1 AUTHORS
+
+Sebastian Riedel, <[EMAIL PROTECTED]>
+
+Andy Grundman, <[EMAIL PROTECTED]>
+
+=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
diff -rN -u old-catalyst_vs_cgiapp/lib/HTTP/Server/Restarter.pm new-catalyst_vs_cgiapp/lib/HTTP/Server/Restarter.pm
--- old-catalyst_vs_cgiapp/lib/HTTP/Server/Restarter.pm 1969-12-31 19:00:00.000000000 -0500
+++ new-catalyst_vs_cgiapp/lib/HTTP/Server/Restarter.pm 2007-07-21 22:43:56.000000000 -0400
@@ -0,0 +1,133 @@
+package HTTP::Server::Restarter;
+use FindBin;
+
+use strict;
+use warnings;
+
+sub monitor {
+ my $class = shift;
+ my %options = @_;
+
+ # Setup restarter
+ unless ( my $restarter = fork ) {
+
+ # Prepare
+ close STDIN;
+ close STDOUT;
+
+ $options{restart_delay} ||= 1;
+ $options{restart_regex} ||= '\.yml$|\.yaml$|\.pm$';
+
+ use HTTP::Server::Restarter::Watcher;
+ my $watcher = HTTP::Server::Restarter::Watcher->new(
+ directory => (
+ $options{restart_directory} ||
+ File::Spec->catdir( $FindBin::Bin, '..' )
+ ),
+ regex => $options{restart_regex},
+ delay => $options{restart_delay},
+ );
+
+ while (1) {
+
+ # poll for changed files
+ my @changed_files = $watcher->watch();
+
+ # check if our parent process has died
+ exit if $^O ne 'MSWin32' and getppid == 1;
+
+ # Restart if any files have changed
+ if (@changed_files) {
+ my $files = join ', ', @changed_files;
+ print STDERR qq/File(s) "$files" modified, restarting\n\n/;
+
+ require IO::Socket::INET;
+ require HTTP::Headers;
+ require HTTP::Request;
+
+ $options{host} ||= '127.0.0.1';
+ $options{port} ||= 3000;
+ my $client = IO::Socket::INET->new(
+ PeerAddr => $options{host},
+ PeerPort => $options{port},
+ )
+ or die "Can't create client socket (is server running?): ",
+ $!;
+
+ # build the Kill request
+ my $req =
+ HTTP::Request->new( 'RESTART', '/',
+ HTTP::Headers->new( 'Connection' => 'close' ) );
+ $req->protocol('HTTP/1.0');
+
+ $client->send( $req->as_string )
+ or die "Can't send restart instruction: ", $!;
+ $client->close();
+ exit;
+ }
+ }
+ }
+
+ return 1;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+HTTP::Server::Restarter - monitor web apps and send server restart requests
+
+=head1 SYNOPSIS
+
+ HTTP::Server::Restarter->monitor;
+
+=head2 monitor()
+
+ HTTP::Server::Restarter->monitor(
+ host => '127.0.0.1',
+ port => 3000,
+ restart_regex => '\.yml$|\.yaml$|\.pm$',
+ restart_delay => 1,
+ restart_directory => '../',
+ );
+
+
+Continously monitors directories for changes according to C<%options>. If any
+changes are found, a special C<RESTART> HTTP request is sent to the host and
+port specified. The web server must be configured to respond such requests, as
+L<Catalyst::Engine::HTTP> is.
+
+All arguments are optional, with defaults shown above.
+
+ host : host of web server to send RESTART requests to
+ port : port of web server to send RESTART requests to
+ restart_directory : directory to monitor for changes
+ restart_regex : regex of file patterns to monitor within restart_directory
+ restart_delay : Seconds to sleep between checks
+
+=head1 SEE ALSO
+
+L<Catalyst>, L<Catalyst::Engine::HTTP>, L<Catalyst::Engine::CGI>,
+L<Catalyst::Engine>.
+
+=head1 AUTHORS
+
+Sebastian Riedel, <[EMAIL PROTECTED]>
+
+Dan Kubb, <[EMAIL PROTECTED]>
+
+Andy Grundman, <[EMAIL PROTECTED]>
+
+Mark Stosberg, <[EMAIL PROTECTED]>
+
+=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
_______________________________________________
List: [email protected]
Listinfo: http://lists.rawmode.org/mailman/listinfo/catalyst
Searchable archive: http://www.mail-archive.com/[email protected]/
Dev site: http://dev.catalyst.perl.org/
