Browse Source

Let applications watch arbitrary files, with callbacks

The inotify watchlist was only ever good for one thing: noticing that a
.pm in a libdir changed and bouncing the server.  Applications have the
same problem for their own data - a static render is stale the moment the
thing it was generated from changes - but no way to say so.

TPSGI::Startup grows a proper watch registry keyed by watch descriptor,
so add_watch() can take a callback alongside the path.  Registration is
idempotent per path and per callback, which matters because new() runs on
every request and routers therefore re-register their watches constantly.

Routers declare these next to their routes:

    our %watches = ( 'data/posts.json' => sub {
        my ($tpsgi, $change) = @_;
        $tpsgi->invalidate_renders('html');
    });

...or call $tpsgi->add_watch($path, $callback) at runtime.

restart_if_changes() becomes handle_changes(), which dispatches callbacks
as well as reloading, and now runs on every dynamic request rather than
only under autoreload - render invalidation shouldn't need autoreload
turned on, and it means the inotify queue actually gets drained instead
of overflowing.  Only watches flagged restart => 1 can trigger a reload,
so an app watching a .pm data file no longer bounces the server.
Callbacks are run under eval so a broken one warns rather than 500s, and
watches destroyed by the usual write-tempfile-then-rename dance are
re-established afterwards.

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01YPYk4had36DWNcJ64fzEvA
George Baugh 1 month ago
parent
commit
9052fc2644
5 changed files with 718 additions and 37 deletions
  1. 5 0
      Makefile.PL
  2. 51 0
      Readme.md
  3. 173 33
      lib/TPSGI.pm
  4. 254 4
      lib/TPSGI/Startup.pm
  5. 235 0
      t/watch.t

+ 5 - 0
Makefile.PL

@@ -42,10 +42,15 @@ WriteMakefile(
         "Plack" => "0",
         "Plack::MIME" => "0",
         "POSIX" => "0",
+        "Scalar::Util" => "0",
         "Starman" => "0",
         "Sys::Hostname" => "0",
         "URL::Encode" => "0",
         "UUID" => "0",
     },
+    TEST_REQUIRES => {
+        "File::Temp" => "0",
+        "Test2::V0"  => "0",
+    },
     test => {TESTS => 't/*.t'}
 );

+ 51 - 0
Readme.md

@@ -79,6 +79,57 @@ Router callbacks are passed the TPSGI object and the raw query, which means you
         return [200, \%headers, ["Hello world"]]
     }
 
+## Watching files for changes
+
+tPSGI already watches your library directories with inotify so that it can reload itself when your
+code changes.  Your application can put arbitrary files and directories onto that same watchlist,
+along with a callback to run when they change.  The usual reason to want this is throwing away a
+static render because the thing it was generated from changed underneath it.
+
+Routing modules declare these the same way they declare routes:
+
+```
+our %watches = (
+    # A bare coderef is the common case: run this when the path changes.
+    'data/posts.json' => sub {
+        my ($tpsgi, $change) = @_;
+        $tpsgi->invalidate_renders('html');
+    },
+
+    # Or spell it out if you want to be picky about which events you care about.
+    'www/assets' => {
+        callback => \&asset_changed,
+        events   => [qw{CREATE MOVE}],
+    },
+);
+```
+
+...or register them at runtime with `$tpsgi->add_watch($path, $callback, %options)`, and drop them
+again with `$tpsgi->remove_watch($path)`.
+
+Callbacks are passed the TPSGI object and a hashref describing what happened:
+
+    sub asset_changed {
+        my ($tpsgi, $change) = @_;
+
+        $change->{path};    # full path of the thing which changed
+        $change->{watched}; # the path the watch was registered against
+        $change->{events};  # arrayref of event names, e.g. ['MODIFY']
+
+        $tpsgi->invalidate_render($change->{path}, 'html');
+    }
+
+A few things worth knowing:
+
+* Watches are shared by every worker, so whichever worker notices a change first consumes it for all
+  of them.  Declare your watches in your routing module (which every worker loads) rather than from
+  inside a single route, and make the callbacks safe to run in any worker.
+* Nothing sits in a select loop over the inotify descriptor, so changes are noticed when the next
+  request comes in.  Prompt, but not instant.
+* Watching the containing directory is more robust than watching a single file.  Watches on files
+  which get replaced wholesale (write a tempfile, rename over the target) are re-established
+  afterwards, but a file which is deleted and not recreated takes its watch with it.
+
 ## Custom Authentication handling
 
 The (optional) Authentication handler can be passed, and look like so:

+ 173 - 33
lib/TPSGI.pm

@@ -32,7 +32,7 @@ use URL::Encode();
 use File::Touch;
 use File::Path;
 use File::Copy;
-use Cwd            qw{abs_path};
+use Cwd qw{abs_path};
 
 use File::Basename qw{dirname basename};
 use Log::Dispatch;
@@ -94,8 +94,8 @@ sub log {
     state $log;
     return $log if $log;
 
-    my $LOGNAME= $self->{log_name};
-    my $LOGDIR = $self->{log_dir};
+    my $LOGNAME = $self->{log_name};
+    my $LOGDIR  = $self->{log_dir};
 
     File::Path::make_path($LOGDIR) unless -d $LOGDIR;
     File::Touch::touch($LOGNAME)   unless -f $LOGNAME;
@@ -232,6 +232,7 @@ sub new {
         my ($package) = basename($route) =~ m/(\S+)\.pm$/;
         my $r         = "$package\:\:routes";
         my $a         = "$package\:\:aliases";
+        my $w         = "$package\:\:watches";
 
         # It also should be a top-level namespace, not somewhere deep down. KISS.
         my $libdir = dirname("$options{tpsgi_dir}/$route");
@@ -253,6 +254,17 @@ sub new {
             }
             @aliases{ keys(%$pkg_aliases) } = values(%$pkg_aliases);
 
+            # Anything the router wants to watch, along with what to do when it changes.
+            # Registration is idempotent, which matters because new() runs per request.
+            my $pkg_watches = *$w{HASH};
+            foreach my $watched ( keys(%$pkg_watches) ) {
+                my $spec = $pkg_watches->{$watched};
+
+                # Copied rather than used directly, as we don't want to eat the router's own data.
+                my %args = ref $spec eq 'HASH' ? %$spec : ( callback => $spec );
+                $self->add_watch( $watched, delete $args{callback}, %args );
+            }
+
             # First-come first-served error template overrides
             $generic_handler = "$package\:\:generic_route";
             $generic_handler = undef unless exists &{$generic_handler};
@@ -371,6 +383,7 @@ sub serve {
             if ( !-d $target_dir ) {
                 File::Path::make_path( $target_dir, { user => $<, group => $self->{gid}, chmod => 0755 } ) or die "Could not make dir $target_dir";
             }
+
             # hardlink to save disk space
             link $path, $static_path;
 
@@ -582,7 +595,7 @@ sub _app {
 
     my $env = shift;
     $self->{filehandle} = $env->{'psgix.io'} // *STDOUT;
-    $self->{input} = $env->{'psgi.input'};
+    $self->{input}      = $env->{'psgi.input'};
 
     # Setup the unique ID for the request
     $env->{REQUEST_ID} = $self->request_id(1);
@@ -592,7 +605,7 @@ sub _app {
 
     # Various stuff important for logging requests
     my $domain = $env->{HTTP_X_FORWARDED_HOST} || $env->{HTTP_HOST} // eval { Sys::Hostname::hostname() };
-    my $path   = $env->{PATH_INFO} || '/';
+    my $path   = $env->{PATH_INFO}             || '/';
 
     # de-pooplicate the path
     $path =~ s|//|/|g;
@@ -776,6 +789,7 @@ sub route {
     # Build the query data for passing to a route.
     # GET, POST, URI captures, then explicit data overrides.
     my $query = {};
+
     # If we're running in CGI mode, leave everything as-is.
     $query = $self->extract_query( $path, $route, $env ) unless $route->{env};
 
@@ -814,11 +828,12 @@ sub route {
 
     # Setup the CGI vars they expect IF requested
     local %ENV = ( %ENV, CGI::Emulate::PSGI->emulate_environment($env) ) if $route->{env};
+
     # Emulate mod_unique_id
     $ENV{UNIQUE_ID} = UUID::uuid() if $route->{env};
 
-    # Make this a truly 'dynamic' application if requested.
-    $self->restart_if_changes() if $self->{autoreload};
+    # Run any watch callbacks, and make this a truly 'dynamic' application if requested.
+    $self->handle_changes();
 
     {
         my $output = $callback->( $self, $query );
@@ -874,7 +889,7 @@ sub extract_query {
     # Now that we've parsed the query and know where we want to go,
     # we should (optionally) murder everything the route does not explicitly want, and validate what it does
     my $parameters = $route->{parameters};
-    if (ref $parameters eq 'HASH' && %$parameters) {
+    if ( ref $parameters eq 'HASH' && %$parameters ) {
         my @known_params = keys(%$parameters);
         for my $param (@known_params) {
             die "Invalid route definition for $path: parameter $param must correspond to a validation CODEREF." unless ref $parameters->{$param} eq 'CODE';
@@ -888,7 +903,7 @@ sub extract_query {
         }
 
         # Without this logging will break.
-        push(@known_params, qw{tpsgi ip ua user referer route dispatcher});
+        push( @known_params, qw{tpsgi ip ua user referer route dispatcher} );
 
         # Smack down passing of unnecessary fields; this catches bugs
         foreach my $field ( keys(%$query) ) {
@@ -933,7 +948,7 @@ sub cgi {
 # XXX it also has an 'apache-ism' of just assigning the HTTP status line for you.
 # But sometimes you have to bite the bullet and do this to migrate stuff effectively.
 sub stream_raw_cgi {
-    my ($self, $cgi) = @_;
+    my ( $self, $cgi ) = @_;
 
     # Discard STDIN in favor of the HTTP body
     close(STDIN);
@@ -944,6 +959,7 @@ sub stream_raw_cgi {
     select $fh;
 
     do($cgi);
+
     # We may or may not actually get here.
     close($fh) if $fh;
     exit 0;
@@ -1171,7 +1187,7 @@ sub signal_restart_parent {
 }
 
 # Instruct tPSGI to reload.
-sub _restart_parent  {
+sub _restart_parent {
     my $parent = getppid;
     kill 'HUP', $parent;
 }
@@ -1198,8 +1214,8 @@ sub save_render {
     return unless $path && $extension;
 
     # If this is an index, let's make it so
-    if ($path =~ m|/$|) {
-        $path = $path.'index';
+    if ( $path =~ m|/$| ) {
+        $path = $path . 'index';
     }
 
     # Fixup the extension if needed.
@@ -1250,7 +1266,7 @@ sub invalidate_render {
 }
 
 sub _invalidate {
-    my ($self, $file) = @_;
+    my ( $self, $file ) = @_;
     $self->INFO("Delete $file");
     unlink "$file";
 }
@@ -1263,40 +1279,156 @@ Useful when it's not easy to figure out what to re-render due to including templ
 =cut
 
 sub invalidate_renders {
-    my ($self, $extension) = @_;
-    File::Find::find( {
-        wanted => sub {
-            my $object = $_;
-            $self->_invalidate($object) if (-f $object && $object =~ m/\.\Q$extension\E$/);
+    my ( $self, $extension ) = @_;
+    File::Find::find(
+        {
+            wanted => sub {
+                my $object = $_;
+                $self->_invalidate($object) if ( -f $object && $object =~ m/\.\Q$extension\E$/ );
+            },
+            no_chdir => 1,
+            bydepth  => 1,
         },
-        no_chdir => 1,
-        bydepth => 1,
-    },
-    "$self->{tpsgi_dir}/www/static/");
+        "$self->{tpsgi_dir}/www/static/"
+    );
 }
 
 sub watch_for_changes { return TPSGI::Startup::watch_for_changes(@_) }
 
-=head2 restart_if_changes
+=head2 add_watch($path, $callback, %options)
+
+Add an arbitrary file or directory to the inotify watchlist, along with a
+callback to run when it changes.  Returns the inotify watch descriptor.
+
+The callback is invoked as:
+
+    $callback->( $tpsgi, $change );
+
+...where $change is a HASH reference describing what happened:
+
+    path    => full path of the thing which changed
+    watched => the path the watch was registered against
+    events  => ARRAY reference of event names, e.g. [ 'MODIFY' ]
+    name    => entry within a watched directory, if the watch was on a directory
+    wd      => inotify watch descriptor
+    mask    => raw inotify event mask
+
+Which makes the common case - blowing away a static render because the thing it
+was generated from changed - look like:
 
-Restart tPSGI if any of the relevant libdir files change.
-Powers the autorestart feature.
+    $tpsgi->add_watch( "data/posts.json", sub {
+        my ( $tpsgi, $change ) = @_;
+        $tpsgi->invalidate_renders('html');
+    });
+
+%options are passed through to TPSGI::Startup::add_watch, so you may also pass
+'events' (defaults to CREATE, MODIFY, DELETE and MOVE) and 'key' (an explicit
+dedupe key for the callback).
+
+Some caveats worth knowing about:
+
+=over
+
+=item * Watches live in the inotify instance tarbaby sets up before forking, and
+are therefore shared by every worker.  Whichever worker notices a change first
+consumes it for all of them, so register the same callbacks in every worker
+(declare them in your router module, which every worker loads) and make sure
+they're safe to run in any worker.
+
+=item * Changes are only noticed when a request comes in, since nothing is
+sitting in a select loop over the inotify FD.  Renders are invalidated promptly
+in practice, but not instantly.
+
+=item * Watching a directory rather than a single file is more robust, as
+watching a file which is later replaced wholesale (the usual write-tempfile-then-
+rename dance) only survives because we re-establish the watch afterwards.  If
+the file is deleted and not immediately recreated, the watch is gone for good.
+
+=back
 
 =cut
 
-sub restart_if_changes {
+sub add_watch {
+    my ( $self, $path, $callback, %options ) = @_;
+
+    my $existing = TPSGI::Startup::is_watched($path);
+
+    # A watch we can't establish (the usual cause being a path which isn't there yet)
+    # shouldn't be fatal to the request which happened to be the one registering it.
+    local $@;
+    my $wd = eval {
+        TPSGI::Startup::add_watch(
+            %options,
+            path     => $path,
+            callback => $callback,
+        );
+    };
+    if ( !defined $wd ) {
+        my $why = $@;
+        $why =~ s/\n.*//s if $why;
+        $self->WARN("Could not watch $path for changes: $why");
+        return undef;
+    }
+
+    $self->DEBUG("Watching $path for changes") unless $existing;
+
+    return $wd;
+}
+
+=head2 remove_watch($path)
+
+Drop a path, and any callbacks registered against it, from the watchlist.
+
+=cut
+
+sub remove_watch {
+    my ( $self, $path ) = @_;
+    return TPSGI::Startup::remove_watch($path);
+}
+
+=head2 handle_changes
+
+Drain the inotify queue, running the callbacks registered for whatever changed,
+and restart tPSGI if any of the relevant libdir files changed (assuming
+autoreload is on).  Powers both the autorestart feature and app-registered
+watches.
+
+=cut
+
+sub handle_changes {
     my $self = shift;
 
-    my @result = $TPSGI::Startup::inotify->read();
+    my @changes = TPSGI::Startup::pending_changes();
+    return 0 unless @changes;
+
     my $had_changes = 0;
+    my @rewatch;
 
-    foreach my $res (@result) {
-        if ( $res->{name} =~ m/\.pm$/ ) {
-            $had_changes++;
-            last;
+    foreach my $change (@changes) {
+        my $watch = $change->{watch};
+
+        # A watch descriptor we know nothing about belongs to a worker which registered
+        # watches we didn't.  All we can sensibly do with those is the old behavior.
+        if ( !$watch ) {
+            $had_changes++ if $change->{path} =~ m/\.pm$/;
+            next;
         }
+
+        $had_changes++ if $watch->{restart} && $change->{path} =~ m/\.pm$/;
+
+        foreach my $cb ( @{ $watch->{callbacks} } ) {
+            local $@;
+            my $ok = eval { $cb->{code}->( $self, $change ); 1 };
+            $self->WARN("Watch callback for $change->{path} died: $@") unless $ok;
+        }
+
+        # The kernel drops watches on files which get replaced or deleted, so put them back.
+        push( @rewatch, $change->{wd} ) if grep { $_ eq 'IGNORED' } @{ $change->{events} };
     }
-    return 0 unless $had_changes;
+
+    TPSGI::Startup::rewatch($_) foreach @rewatch;
+
+    return 0 unless $had_changes && $self->{autoreload};
 
     # 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");
@@ -1304,4 +1436,12 @@ sub restart_if_changes {
     return 0;
 }
 
+=head2 restart_if_changes
+
+Deprecated alias for handle_changes().
+
+=cut
+
+sub restart_if_changes { goto &handle_changes }
+
 1;

+ 254 - 4
lib/TPSGI/Startup.pm

@@ -10,12 +10,31 @@ use warnings;
 use Cwd;
 use File::Basename qw{dirname};
 use File::Find;
+use Scalar::Util qw{refaddr};
 use Linux::Perl::inotify;
 use Config::Simple;
 
 our @wds;
 our $inotify;
 
+# wd => { path => ..., events => [...], restart => bool, callbacks => [ { key => ..., code => ... } ] }
+our %watches;
+
+# path => wd, so that we don't re-issue inotify_add_watch() needlessly.
+our %watched;
+
+# Whether watch_for_changes() has already set up the libdir watches.
+our $watching = 0;
+
+our @DEFAULT_EVENTS = qw{CREATE MODIFY DELETE MOVE};
+
+# Bit => name for every event we can actually be handed back by read().
+my %EVENT_NAMES = map { Linux::Perl::inotify->EVENT_NUMBER()->{$_} => $_ } qw{
+  ACCESS MODIFY ATTRIB CLOSE_WRITE CLOSE_NOWRITE OPEN
+  MOVED_FROM MOVED_TO CREATE DELETE DELETE_SELF MOVE_SELF
+  UNMOUNT Q_OVERFLOW IGNORED ISDIR
+};
+
 =head2 get_config()
 
 Read ~/.tpsgi.ini and return a merged options hash.
@@ -68,22 +87,253 @@ sub get_config {
 =head2 watch_for_changes(@dirs)
 
 Set up inotify watches on the given directories (and any .pm files within them).
-Idempotent: no-op if watches are already active.
+These watches are flagged as 'restart' watches, which is what powers the
+autoreload feature (see TPSGI::handle_changes).
+
+Idempotent: no-op if the libdir watches are already active.
 
 =cut
 
 sub watch_for_changes {
     my (@dirs) = @_;
 
-    return if @wds;
+    return if $watching;
+    $watching = 1;
 
-    $inotify //= Linux::Perl::inotify->new( flags => [qw{NONBLOCK}] );
     my @to_watch = _readdir(@dirs);
 
     foreach my $f2watch (@to_watch) {
         print "Watching $f2watch for changes\n";
-        push( @wds, $inotify->add( path => $f2watch, events => [qw{CREATE MODIFY DELETE MOVE}] ) );
+        push( @wds, add_watch( path => $f2watch, restart => 1 ) );
+    }
+
+    return @wds;
+}
+
+=head2 add_watch(%args)
+
+Add an arbitrary file or directory to the watchlist, optionally with a callback
+to run when it changes.  Returns the inotify watch descriptor.
+
+%args is:
+
+=over
+
+=item * C<path> - Required.  File or directory to watch.  When you watch a
+directory you will be told about changes to the entries within it (but not
+recursively); when you watch a file you are told about changes to that file.
+
+=item * C<callback> - Optional CODE reference, called as
+C<< $callback->($tpsgi, $change) >> by TPSGI::handle_changes() when the watched
+path changes.  See that method for the shape of $change.
+
+=item * C<key> - Optional string identifying the callback.  Registering the same
+key twice replaces the prior callback rather than stacking a second one.
+Defaults to the refaddr of the callback, which is what you want when you
+register the same named sub or package-level closure repeatedly (TPSGI::new()
+runs per request, so this happens constantly).
+
+=item * C<events> - Optional ARRAY reference of inotify events to watch for.
+Defaults to CREATE, MODIFY, DELETE and MOVE.  If the path is already watched,
+any events not already in its mask are added to it.
+
+=item * C<restart> - Optional boolean.  Marks this as a watch which should
+restart the server when a .pm within it changes, if autoreload is on.
+
+=back
+
+=cut
+
+sub add_watch {
+    my (%args) = @_;
+
+    my $path = $args{path};
+    die "add_watch: path is required" unless defined $path && length $path;
+    die "add_watch: callback must be a CODE reference" if defined $args{callback} && ref $args{callback} ne 'CODE';
+    die "add_watch: events must be an ARRAY reference" if defined $args{events}   && ref $args{events} ne 'ARRAY';
+
+    $inotify //= Linux::Perl::inotify->new( flags => [qw{NONBLOCK}] );
+
+    my $events = $args{events} || [@DEFAULT_EVENTS];
+    my $wd     = $watched{$path};
+
+    if ( !defined $wd ) {
+        $wd = $watched{$path} = $inotify->add( path => $path, events => $events );
+        $watches{$wd} = {
+            path      => $path,
+            events    => [@$events],
+            restart   => 0,
+            callbacks => [],
+        };
+    }
+    elsif ( $args{events} ) {
+
+        # inotify_add_watch() *replaces* the mask by default, so union it in instead.
+        my %have = map  { $_ => 1 } @{ $watches{$wd}{events} };
+        my @new  = grep { !$have{$_} } @$events;
+        if (@new) {
+            $inotify->add( path => $path, events => [ @new, 'MASK_ADD' ] );
+            push( @{ $watches{$wd}{events} }, @new );
+        }
+    }
+
+    my $watch = $watches{$wd};
+    $watch->{restart} ||= $args{restart} ? 1 : 0;
+
+    if ( $args{callback} ) {
+        my $key      = defined $args{key} ? $args{key} : refaddr( $args{callback} );
+        my $existing = _find_callback( $watch, $key );
+        if ($existing) {
+            $existing->{code} = $args{callback};
+        }
+        else {
+            push( @{ $watch->{callbacks} }, { key => $key, code => $args{callback} } );
+        }
+    }
+
+    return $wd;
+}
+
+# Callbacks are kept in an array so that they fire in registration order.
+sub _find_callback {
+    my ( $watch, $key ) = @_;
+    foreach my $cb ( @{ $watch->{callbacks} } ) {
+        return $cb if $cb->{key} eq $key;
+    }
+    return undef;
+}
+
+=head2 is_watched($path)
+
+Whether the passed path is already on the watchlist.
+
+=cut
+
+sub is_watched {
+    my ($path) = @_;
+    return defined $path && exists $watched{$path};
+}
+
+=head2 remove_watch($path)
+
+Drop a path (and any callbacks registered against it) from the watchlist.
+
+=cut
+
+sub remove_watch {
+    my ($path) = @_;
+
+    my $wd = delete $watched{$path};
+    return 0 unless defined $wd;
+
+    delete $watches{$wd};
+    @wds = grep { $_ != $wd } @wds;
+
+    # The watch may already be gone (deleted file), so don't blow up over it.
+    eval { $inotify->remove($wd) };
+
+    return 1;
+}
+
+=head2 rewatch($wd)
+
+Re-establish a watch which the kernel dropped out from under us.
+
+Anything which writes a file "atomically" (write a tempfile, rename over the
+target) destroys the watch on the old inode, so watches on individual files are
+one-shot unless we put them back.  Returns the new watch descriptor, or undef
+when the path is simply gone now.
+
+=cut
+
+sub rewatch {
+    my ($wd) = @_;
+
+    my $watch = delete $watches{$wd};
+    return undef unless $watch;
+
+    delete $watched{ $watch->{path} };
+    my $was_libdir = grep { $_ == $wd } @wds;
+    @wds = grep { $_ != $wd } @wds;
+
+    # Nothing to re-watch if it didn't come back.
+    return undef unless -e $watch->{path};
+
+    my $new_wd = eval {
+        add_watch(
+            path    => $watch->{path},
+            events  => $watch->{events},
+            restart => $watch->{restart},
+        );
+    };
+    return undef unless defined $new_wd;
+
+    push( @{ $watches{$new_wd}{callbacks} }, @{ $watch->{callbacks} } );
+    push( @wds,                              $new_wd ) if $was_libdir;
+
+    return $new_wd;
+}
+
+=head2 event_names($mask)
+
+Turn an inotify event mask into an ARRAY reference of event names.
+
+=cut
+
+sub event_names {
+    my ($mask) = @_;
+    return [ map { $EVENT_NAMES{$_} } grep { $mask & $_ } sort { $a <=> $b } keys(%EVENT_NAMES) ];
+}
+
+=head2 pending_changes()
+
+Drain the inotify queue and return the changes as a list of HASH references:
+
+    {
+        path    => full path of the thing which changed,
+        watched => the path we registered the watch against,
+        events  => [ 'MODIFY', ... ],
+        watch   => the watch entry this came from (undef if unknown to us),
+        wd      => inotify watch descriptor,
+        mask    => raw inotify mask,
+        cookie  => raw inotify cookie,
+        name    => raw inotify name (entry within a watched directory, if any),
     }
+
+Note that the inotify instance is shared between all the workers forked off of
+tarbaby, so whichever worker reads first consumes the event for everyone.  This
+is why the callbacks you register need to be registered identically in every
+worker (declare them in your router module, which every worker loads) and need
+to be safe to run in any of them.
+
+=cut
+
+sub pending_changes {
+    return () unless $inotify;
+
+    my @changes;
+    foreach my $event ( $inotify->read() ) {
+        my $watch   = $watches{ $event->{wd} };
+        my $watched = $watch ? $watch->{path} : '';
+        $watched =~ s|/+$||;
+
+        # Directory watches tell us the entry which changed, file watches don't.
+        my $path = $watched;
+        $path = length($watched) ? "$watched/$event->{name}" : $event->{name} if $event->{name};
+
+        push(
+            @changes,
+            {
+                %$event,
+                path    => $path,
+                watched => $watched,
+                events  => event_names( $event->{mask} ),
+                watch   => $watch,
+            }
+        );
+    }
+
+    return @changes;
 }
 
 sub _readdir {

+ 235 - 0
t/watch.t

@@ -0,0 +1,235 @@
+use strict;
+use warnings;
+
+use Test2::V0;
+
+use Cwd            qw{abs_path};
+use File::Path     qw{make_path remove_tree};
+use File::Temp     qw{tempdir};
+use File::Basename qw{dirname};
+
+use lib dirname( abs_path(__FILE__) ) . '/../lib';
+
+use TPSGI::Startup;
+use TPSGI;
+
+my $tmp = tempdir( CLEANUP => 1 );
+
+# A TPSGI object which is only good for logging & watching, as new() insists on
+# being run as the configured user with a full config.
+my $tpsgi = bless(
+    {
+        ip         => '127.0.0.1',
+        user       => 'test',
+        verbose    => 0,
+        autoreload => 0,
+        loggers    => [],
+        log_dir    => "$tmp/log",
+        log_name   => "$tmp/log/tpsgi.log",
+        callbacks  => [],
+    },
+    'TPSGI'
+);
+
+# Give the kernel a moment to queue events, then drain.
+sub changes {
+    select( undef, undef, undef, 0.1 );
+    return TPSGI::Startup::pending_changes();
+}
+
+subtest 'watching a file with a callback' => sub {
+    my $file = "$tmp/subject.txt";
+    open( my $fh, '>', $file ) or die $!;
+    print $fh "initial\n";
+    close $fh;
+
+    my @fired;
+    my $wd = $tpsgi->add_watch( $file, sub { my ( $t, $change ) = @_; push( @fired, $change ) } );
+    ok( defined $wd,                       "add_watch returns a watch descriptor" );
+    ok( TPSGI::Startup::is_watched($file), "path is now watched" );
+
+    open( $fh, '>>', $file ) or die $!;
+    print $fh "more\n";
+    close $fh;
+
+    $tpsgi->handle_changes();
+
+    is( scalar(@fired),  1,     "callback fired once for one modification" );
+    is( $fired[0]{path}, $file, "callback got the path which changed" );
+    ok( ( grep { $_ eq 'MODIFY' } @{ $fired[0]{events} } ), "callback got decoded event names" );
+
+    TPSGI::Startup::remove_watch($file);
+    ok( !TPSGI::Startup::is_watched($file), "remove_watch drops the path" );
+
+    @fired = ();
+    open( $fh, '>>', $file ) or die $!;
+    print $fh "even more\n";
+    close $fh;
+    $tpsgi->handle_changes();
+    is( scalar(@fired), 0, "removed watches no longer fire" );
+};
+
+subtest 'registering the same callback repeatedly is idempotent' => sub {
+    my $file = "$tmp/idempotent.txt";
+    open( my $fh, '>', $file ) or die $!;
+    close $fh;
+
+    my @fired;
+    my $cb = sub { push( @fired, $_[1] ) };
+
+    # new() runs per request, so routers re-register their watches constantly.
+    $tpsgi->add_watch( $file, $cb ) for 1 .. 5;
+
+    my $wd = $TPSGI::Startup::watched{$file};
+    is( scalar( @{ $TPSGI::Startup::watches{$wd}{callbacks} } ), 1, "callback registered exactly once" );
+
+    open( $fh, '>>', $file ) or die $!;
+    print $fh "poke\n";
+    close $fh;
+    $tpsgi->handle_changes();
+
+    is( scalar(@fired), 1, "and it only fires once" );
+
+    TPSGI::Startup::remove_watch($file);
+};
+
+subtest 'distinct callbacks on one path both fire, in order' => sub {
+    my $file = "$tmp/multi.txt";
+    open( my $fh, '>', $file ) or die $!;
+    close $fh;
+
+    my @fired;
+    $tpsgi->add_watch( $file, sub { push( @fired, 'first' ) } );
+    $tpsgi->add_watch( $file, sub { push( @fired, 'second' ) } );
+
+    open( $fh, '>>', $file ) or die $!;
+    print $fh "poke\n";
+    close $fh;
+    $tpsgi->handle_changes();
+
+    is( \@fired, [qw{first second}], "both callbacks fired in registration order" );
+
+    TPSGI::Startup::remove_watch($file);
+};
+
+subtest 'watching a directory reports the entries which changed' => sub {
+    my $dir = "$tmp/watched_dir";
+    make_path($dir);
+
+    my @fired;
+    $tpsgi->add_watch( $dir, sub { push( @fired, $_[1] ) } );
+
+    open( my $fh, '>', "$dir/created.txt" ) or die $!;
+    close $fh;
+    $tpsgi->handle_changes();
+
+    ok( scalar(@fired), "got at least one change for the directory" );
+    is( $fired[0]{path},    "$dir/created.txt", "change path is the full path of the entry" );
+    is( $fired[0]{watched}, $dir,               "change knows which watch it came from" );
+    is( $fired[0]{name},    'created.txt',      "and the raw inotify name" );
+
+    TPSGI::Startup::remove_watch($dir);
+};
+
+subtest 'watches survive a file being replaced wholesale' => sub {
+    my $file = "$tmp/renamed.txt";
+    open( my $fh, '>', $file ) or die $!;
+    print $fh "one\n";
+    close $fh;
+
+    my @fired;
+    my $original_wd = $tpsgi->add_watch( $file, sub { push( @fired, $_[1] ) } );
+
+    # The write-a-tempfile-then-rename-over-it dance, which kills the old watch.
+    open( $fh, '>', "$tmp/renamed.tmp" ) or die $!;
+    print $fh "two\n";
+    close $fh;
+    rename( "$tmp/renamed.tmp", $file ) or die $!;
+
+    $tpsgi->handle_changes();
+    ok( scalar(@fired), "got the change which clobbered the file" );
+
+    my $new_wd = $TPSGI::Startup::watched{$file};
+    ok( defined $new_wd, "path is still watched afterwards" );
+    is( scalar( @{ $TPSGI::Startup::watches{$new_wd}{callbacks} } ), 1, "callback survived the re-watch" );
+
+    @fired = ();
+    open( $fh, '>>', $file ) or die $!;
+    print $fh "three\n";
+    close $fh;
+    $tpsgi->handle_changes();
+    is( scalar(@fired), 1, "and still fires for changes to the new inode" );
+
+    TPSGI::Startup::remove_watch($file);
+};
+
+subtest 'a dying callback does not take out the request' => sub {
+    my $file = "$tmp/exploding.txt";
+    open( my $fh, '>', $file ) or die $!;
+    close $fh;
+
+    my @fired;
+    $tpsgi->add_watch( $file, sub { die "nope\n" },          key => 'boom' );
+    $tpsgi->add_watch( $file, sub { push( @fired, 'ran' ) }, key => 'fine' );
+
+    open( $fh, '>>', $file ) or die $!;
+    print $fh "poke\n";
+    close $fh;
+
+    ok( lives { $tpsgi->handle_changes() }, "handle_changes survives a dying callback" );
+    is( \@fired, ['ran'], "and still runs the other callbacks" );
+
+    TPSGI::Startup::remove_watch($file);
+};
+
+subtest 'watching something which is not there is not fatal' => sub {
+    my $wd;
+    ok(
+        lives {
+            $wd = $tpsgi->add_watch( "$tmp/does_not_exist", sub { } )
+        },
+        "add_watch on a missing path lives"
+    );
+    is( $wd, undef, "and reports failure" );
+    ok( !TPSGI::Startup::is_watched("$tmp/does_not_exist"), "nothing got registered" );
+};
+
+subtest 'libdir watches still drive autoreload' => sub {
+    my $libdir = "$tmp/lib";
+    make_path($libdir);
+    open( my $fh, '>', "$libdir/Fake.pm" ) or die $!;
+    print $fh "1;\n";
+    close $fh;
+
+    TPSGI::Startup::watch_for_changes($libdir);
+
+    my $restarted = 0;
+    no warnings qw{redefine once};
+    local *TPSGI::signal_restart_parent = sub { $restarted++ };
+    use warnings;
+
+    open( $fh, '>>', "$libdir/Fake.pm" ) or die $!;
+    print $fh "# poke\n";
+    close $fh;
+
+    local $tpsgi->{autoreload} = 1;
+    $tpsgi->handle_changes();
+    ok( $restarted, "a changed .pm in a libdir signals a restart" );
+
+    # And the app-facing watches don't get roped into that.
+    $restarted = 0;
+    my $data = "$tmp/data.pm";
+    open( $fh, '>', $data ) or die $!;
+    close $fh;
+    $tpsgi->add_watch( $data, sub { } );
+    open( $fh, '>>', $data ) or die $!;
+    print $fh "poke\n";
+    close $fh;
+
+    $tpsgi->handle_changes();
+    ok( !$restarted, "but a .pm watched by an app does not" );
+
+    TPSGI::Startup::remove_watch($data);
+};
+
+done_testing();