tPSGI/t/watch.t

#!/usr/bin/env perl
use 5.040;
use warnings FATAL => 'all';
use re '/aasx';

use Test2::V0;

use File::Path qw{make_path remove_tree};
use File::Temp qw{tempdir};
use Test::MockModule;

use FindBin::libs;

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'
);

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) or die "Cannot close: $!";

    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) or die "Cannot close: $!";

    $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) or die "Cannot close: $!";
    $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)                 or die "Cannot close: $!";

    my @fired;

    # One reference, registered five times: that is the case being tested.
    my $cb = sub { push( @fired, $_[1] ) };    ## no critic (ProhibitSingleUseLexicalSubs)

    # 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) or die "Cannot close: $!";
    $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)                 or die "Cannot close: $!";

    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) or die "Cannot close: $!";
    $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)                              or die "Cannot close: $!";
    $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) or die "Cannot close: $!";

    my @fired;
    $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)                          or die "Cannot close: $!";
    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) or die "Cannot close: $!";
    $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)                 or die "Cannot close: $!";

    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) or die "Cannot close: $!";

    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) or die "Cannot close: $!";

    TPSGI::Startup::watch_for_changes($libdir);

    my $restarted = 0;
    my $mock      = Test::MockModule->new('TPSGI');
    $mock->redefine( signal_restart_parent => sub { $restarted++ } );

    open( $fh, '>>', "$libdir/Fake.pm" ) or die $!;
    print {$fh} "# poke\n";
    close($fh) or die "Cannot close: $!";

    $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)              or die "Cannot close: $!";
    $tpsgi->add_watch( $data, sub { } );
    open( $fh, '>>', $data ) or die $!;
    print {$fh} "poke\n";
    close($fh) or die "Cannot close: $!";

    $tpsgi->handle_changes();
    ok( !$restarted, "but a .pm watched by an app does not" );

    TPSGI::Startup::remove_watch($data);
    $tpsgi->{autoreload} = 0;
};

done_testing();