view release on metacpan or  search on metacpan

t/optional_http-server-restart.t  view on Meta::CPAN

    "$appdir/lib/TestApp.pm",
    "$appdir/lib/TestApp/Controller/Foo.pm",
    "$appdir/lib/TestApp/Controller/Root.pm",
);

# change some files and make sure the server restarts itself
NON_ERROR_RESTART:
for ( 1 .. 5 ) {
    SKIP : {
        my $index = rand @files;
        open my $pm, '>>', $files[$index]
            or die "Unable to open $files[$index] for writing: $!";
        print $pm "\n";
        close $pm;

        if ( ! look_for_restart() ) {
            skip "Server did not restart, no sense in checking further", 1;
        }

        my $response = get("http://localhost:$port/");
        like( $response, qr/Welcome to the  world of Catalyst/,
              'Non-error restart, request OK' );
    }
}

# add errors to the file and make sure server does die
DIES_ON_ERROR:
for ( 1 .. 5 ) {
    SKIP : {
        my $index = rand @files;
        open my $pm, '>>', $files[$index]
            or die "Unable to open $files[$index] for writing: $!";
        print $pm "bleh";
        close $pm;

        if ( ! look_for_death() ) {
            skip "Server restarted, no sense in checking further", 2;
        }

        copy_test_app();

        if ( ! look_for_restart() ) {
            skip "Server did not restart, no sense in checking further", 1;
        }

        my $response = get("http://localhost:$port/");
        like( $response, qr/Welcome to the  world of Catalyst/,
              'Non-error restart after death, request OK' );
    }
}

# multiple restart directories

# we need different options so we have to rebuild most
# of the testing environment

kill 9, $pid or die "Cannot send kill signal to $pid: $!";
close $server or die "Cannot close handle to server process: $!";
wait;

# pick next port because the last one might still be blocked from
# previous server. This might fail if this port is unavailable
# but picking the first one has the same problem so this is acceptable

$port += 1;

copy_test_app();

@files = (
  "$appdir/lib/TestApp/Controller/Subdir1/Foo.pm",
  "$appdir/lib/TestApp/Controller/Subdir2/Foo.pm",
);

( $pid, $server ) = start_server($port);

MULTI_DIR_RESTART:
for ( 1 .. 5 ) {
    SKIP : {
        my $index = rand @files;
        open my $pm, '>>', $files[$index]
          or die "Unable to open $files[$index] for writing: $!";
        print $pm "\n";
        close $pm;

        if ( ! look_for_restart() ) {
            skip "Server did not restart, no sense in checking further", 1;
        }

        my $response = get("http://localhost:$port/");
        like( $response, qr/Welcome to the  world of Catalyst/,
              'Non-error restart with multiple watched dirs' );
    }
}

kill 9, $pid;
close $server;
wait;

sub copy_test_app {
    local $File::Copy::Recursive::RMTrgFil = 1;
    dircopy( 't/lib/TestApp', "$appdir/lib/TestApp" );
}

sub start_server {
    my $port = shift;

    my $server;
    my $pid = open3(
        undef, $server, undef,
        $^X,   "-I$helper_lib",
        "$appdir/script/testapp_server.pl", '--port',
        $port,                                                     '--restart'
    ) or die "Unable to spawn standalone HTTP server: $!";

    # switch to non-blocking reads so we can fail gracefully instead
    # of just hanging forever
    $server->blocking(0);

    my $waited = 0;

    diag('Waiting for server to start...');