view release on metacpan or  search on metacpan

t/plockf.t  view on Meta::CPAN

#!/usr/bin/perl -w
# -*- perl -*-

#
# Author: Slaven Rezic
#

use strict;
use FindBin;

BEGIN {
    if (!eval q{
	use Test::More;
	1;
    }) {
	print "1..0 # skip no Test::More module\n";
	exit;
    }
}

plan 'no_plan';

my $use_blib = 1;
my $plockf = "$FindBin::RealBin/../blib/script/plockf";
unless (-f $plockf) {
    # blib version not available, use ../bin source version
    $plockf = "$FindBin::RealBin/../bin/plockf";
    $use_blib = 0;
}

# Special handling for systems without shebang handling
my @full_script = $^O eq 'MSWin32' || !$use_blib ? ($^X, $plockf) : ($plockf);

my $lock_file = "$FindBin::RealBin/plockf.lck";
my $signal_file = "$FindBin::RealBin/plockf.signal";

{
    my @cmd = (@full_script, '-h');
    my($ret, undef, $stderr) = run(\@cmd);
    is $ret, 64, 'bad usage'; # hmmm, should it really fail if the user specifies --help?
    defined $stderr and like $stderr, qr{^usage: plockf };
}

{
    my @cmd = (@full_script);
    my($ret, undef, $stderr) = run(\@cmd);
    is $ret, 64, 'bad usage';
    defined $stderr and like $stderr, qr{Lock file is not specified};
    defined $stderr and like $stderr, qr{^usage: plockf }m;
}

{
    my @cmd = (@full_script, '-t', '-123', $lock_file, 'never_executed');
    my($ret, undef, $stderr) = run(\@cmd);
    is $ret, 64, 'bad usage';
    defined $stderr and like $stderr, qr{Timeout must be positive};
}

{
    my @cmd = (@full_script, $lock_file);
    my($ret, undef, $stderr) = run(\@cmd);
    is $ret, 64, 'bad usage';
    defined $stderr and like $stderr, qr{Command is not specified};
}

{
    my @cmd = (@full_script, $lock_file, $^X, '-e1');
    my($ret) = run(\@cmd);
    is $ret, 0;
    ok !-f $lock_file, 'lock file was not kept';
}

{
    my @cmd = (@full_script, '-k', $lock_file, $^X, '-e1');
    my($ret) = run(\@cmd);
    is $ret, 0;
    ok -f $lock_file, '-k works';
}

{
    my @cmd = (@full_script, $lock_file, $^X, '-e', 'exit 12');
    my($ret) = run(\@cmd);
    is $ret, 12, 'exit code of command propagated';
}

{
    my @cmd = (@full_script, $lock_file, $^X, '-e', 'kill 9 => $$');
    my($ret) = run(\@cmd);
    if ($^O eq 'MSWin32') {
	# signals are not reported in $? on Windows, so we
	# only know that it failed
	isnt $ret, 0, 'command was not successful, special Windows check';
    } else {
	is $ret, 70, 'command was killed, EX_SOFTWARE returned';
    }
    ok !-f $lock_file, 'cleanup of lock file works';
}

{
    my $t0 = time;
    my $pid = run_blocking_process(3);
    my @cmd = (@full_script, '-t', 0, $lock_file, $^X, '-e1');
    my($ret, undef, $stderr) = run(\@cmd);
    is $ret, 75, 'lock error on -t 0'
	or diag "Time since run_blocking_process: " . (time-$t0);
    defined $stderr and like $stderr, qr{^plockf: .*plockf.lck: already locked$};
    if ($^O ne 'MSWin32') { # SIGTERM is problematic on Windows: http://stackoverflow.com/a/33216565/2332415
	kill TERM => $pid;
    }
    waitpid $pid, 0;
    ok !-f $lock_file, 'cleanup of lock file works';
}

{
    my $t0 = time;
    my $pid = run_blocking_process(3);