|
@@ -33,7 +33,9 @@ use URL::Encode();
|
|
|
use File::Touch;
|
|
use File::Touch;
|
|
|
use File::Path;
|
|
use File::Path;
|
|
|
use File::Copy;
|
|
use File::Copy;
|
|
|
|
|
+use File::Find;
|
|
|
use Cwd qw{abs_path};
|
|
use Cwd qw{abs_path};
|
|
|
|
|
+
|
|
|
use File::Basename qw{dirname basename};
|
|
use File::Basename qw{dirname basename};
|
|
|
use Log::Dispatch;
|
|
use Log::Dispatch;
|
|
|
use Log::Dispatch::Screen;
|
|
use Log::Dispatch::Screen;
|
|
@@ -224,9 +226,6 @@ sub new {
|
|
|
my @routes;
|
|
my @routes;
|
|
|
my %aliases;
|
|
my %aliases;
|
|
|
|
|
|
|
|
- # Setup inotify watchers to know if we need to reload the application after this request.
|
|
|
|
|
- $self->_watch_for_changes("$options{tpsgi_dir}/lib");
|
|
|
|
|
-
|
|
|
|
|
# XXX TODO make these routes able to be fully qualified namespaces (::)!
|
|
# XXX TODO make these routes able to be fully qualified namespaces (::)!
|
|
|
no strict 'refs';
|
|
no strict 'refs';
|
|
|
foreach my $route ( @{ $self->{routers} } ) {
|
|
foreach my $route ( @{ $self->{routers} } ) {
|
|
@@ -242,8 +241,6 @@ sub new {
|
|
|
my $libdir = dirname("$options{tpsgi_dir}/$route");
|
|
my $libdir = dirname("$options{tpsgi_dir}/$route");
|
|
|
push( @INC, $libdir );
|
|
push( @INC, $libdir );
|
|
|
|
|
|
|
|
- $self->_watch_for_changes($libdir);
|
|
|
|
|
-
|
|
|
|
|
local $@;
|
|
local $@;
|
|
|
$self->DEBUG("require $options{tpsgi_dir}/$route");
|
|
$self->DEBUG("require $options{tpsgi_dir}/$route");
|
|
|
my $success = eval { require "$options{tpsgi_dir}/$route"; 1; };
|
|
my $success = eval { require "$options{tpsgi_dir}/$route"; 1; };
|
|
@@ -1260,24 +1257,34 @@ sub invalidate_render {
|
|
|
unlink "$file";
|
|
unlink "$file";
|
|
|
}
|
|
}
|
|
|
|
|
|
|
|
-sub _watch_for_changes {
|
|
|
|
|
- my ($self, @dirs) = @_;
|
|
|
|
|
|
|
+my @wds;
|
|
|
|
|
+my $inotify;
|
|
|
|
|
+sub watch_for_changes {
|
|
|
|
|
+ my (@dirs) = @_;
|
|
|
|
|
+
|
|
|
|
|
+ # No point watching again if we already are watching
|
|
|
|
|
+ return if @wds;
|
|
|
|
|
|
|
|
- $self->{wds} //= [];
|
|
|
|
|
|
|
+ $inotify //= Linux::Perl::inotify->new(flags => [qw{NONBLOCK}]);
|
|
|
|
|
+ my @to_watch =_readdir( @dirs );
|
|
|
|
|
|
|
|
- $self->{inf} //= Linux::Perl::inotify->new(flags => [qw{NONBLOCK}]);
|
|
|
|
|
- foreach my $directory (@dirs) {
|
|
|
|
|
- # Recursive scan for directories and setting up inotifies
|
|
|
|
|
- push(@dirs, _readdir( $directory ));
|
|
|
|
|
- $self->INFO( "Watching $directory for changes\n" );
|
|
|
|
|
- push(@{$self->{wds}}, $self->{inf}->add( path => $directory, events => [qw{CREATE MODIFY}] ));
|
|
|
|
|
|
|
+ foreach my $f2watch (@to_watch) {
|
|
|
|
|
+ print "Watching $f2watch for changes\n";
|
|
|
|
|
+ push(@wds, $inotify->add( path => $f2watch, events => [qw{CREATE MODIFY DELETE MOVE}] ));
|
|
|
}
|
|
}
|
|
|
}
|
|
}
|
|
|
|
|
|
|
|
|
|
+=head2 restart_if_changes
|
|
|
|
|
+
|
|
|
|
|
+Restart tPSGI if any of the relevant libdir files change.
|
|
|
|
|
+Powers the autorestart feature.
|
|
|
|
|
+
|
|
|
|
|
+=cut
|
|
|
|
|
+
|
|
|
sub restart_if_changes {
|
|
sub restart_if_changes {
|
|
|
my $self = shift;
|
|
my $self = shift;
|
|
|
|
|
|
|
|
- my @result = $self->{inf}->read();
|
|
|
|
|
|
|
+ my @result = $inotify->read();
|
|
|
my $had_changes = 0;
|
|
my $had_changes = 0;
|
|
|
|
|
|
|
|
foreach my $res (@result) {
|
|
foreach my $res (@result) {
|
|
@@ -1286,18 +1293,25 @@ sub restart_if_changes {
|
|
|
last;
|
|
last;
|
|
|
}
|
|
}
|
|
|
}
|
|
}
|
|
|
|
|
+ return 0 unless $had_changes ;
|
|
|
|
|
|
|
|
|
|
+ # We don't have to clean up the wds, that is handled in the destructor for Inotify
|
|
|
$self->INFO("Relevant Change in libdirs detected, reloading\n");
|
|
$self->INFO("Relevant Change in libdirs detected, reloading\n");
|
|
|
- foreach my $wd (@{$self->{wds}}) { $self->{inf}->remove($wd) }
|
|
|
|
|
$self->signal_restart_parent();
|
|
$self->signal_restart_parent();
|
|
|
return 0;
|
|
return 0;
|
|
|
}
|
|
}
|
|
|
|
|
|
|
|
sub _readdir {
|
|
sub _readdir {
|
|
|
- my $dir = shift;
|
|
|
|
|
- opendir(my $dh, $dir);
|
|
|
|
|
- my @dirs = map { "$dir/$_" } grep { -d "$dir/$_" && !m/^\.+$/ } readdir($dh);
|
|
|
|
|
- closedir($dh);
|
|
|
|
|
|
|
+ my @dirs = @_;
|
|
|
|
|
+ File::Find::find( {
|
|
|
|
|
+ wanted => sub {
|
|
|
|
|
+ my $object = $_;
|
|
|
|
|
+ push(@dirs, $object) if (-f $object && $object =~ m/\.pm$/);
|
|
|
|
|
+ },
|
|
|
|
|
+ no_chdir => 1,
|
|
|
|
|
+ bydepth => 1,
|
|
|
|
|
+ },
|
|
|
|
|
+ @dirs);
|
|
|
return @dirs;
|
|
return @dirs;
|
|
|
}
|
|
}
|
|
|
|
|
|