Doit
view release on metacpan - search on metacpan
view release on metacpan or search on metacpan
lib/Doit/Fork.pm view on Meta::CPAN
my $self = bless { }, $class;
require IO::Pipe;
my $pipe_to_fork = IO::Pipe->new;
my $pipe_from_fork = IO::Pipe->new;
my $worker_pid = fork;
if (!defined $worker_pid) {
error "fork failed: $!";
} elsif ($worker_pid == 0) {
my $d = do {
local @ARGV = $dry_run ? '--dry-run' : ();
Doit->init;
};
$pipe_to_fork->reader;
$pipe_from_fork->writer;
$pipe_from_fork->autoflush(1);
Doit::RPC::PipeServer->new($d, $pipe_to_fork, $pipe_from_fork, debug => $debug)->run;
CORE::exit(0);
}
$pipe_to_fork->writer;
t/change_file_dryrun.t view on Meta::CPAN
use File::Temp 'tempdir';
use Test::More 'no_plan';
use Doit;
sub slurp ($) { open my $fh, shift or die $!; local $/; <$fh> }
my $tempdir = tempdir('doit_XXXXXXXX', TMPDIR => 1, CLEANUP => 1);
chdir $tempdir or die "Can't chdir to $tempdir: $!";
local @ARGV = ('--dry-run');
my $r = Doit->init;
my $changes;
eval { $r->change_file("blubber") };
like $@, qr{blubber does not exist};
eval { $r->change_file(".") };
like $@, qr{\. is not a file};
my @files = bsd_glob("$tmp_dir/*$tmp_suffix");
is_deeply \@files, [], "no temporary file left-overs with suffix $tmp_suffix in $tmp_dir";
}
plan 'no_plan';
my $doit = Doit->init;
$doit->add_component('file');
my $doit_dryrun = do {
local @ARGV = '--dry-run';
Doit->init;
};
ok $doit_dryrun->is_dry_run, 'created dry-run Doit object';
# Accidentally it's not required to call add_component('file') here,
# as the add_component calls affect the class, not the object.
my $tempdir = tempdir('doit_XXXXXXXX', TMPDIR => 1, CLEANUP => 1);
$doit->mkdir("$tempdir/another_tmp");
{
t/guarded.t view on Meta::CPAN
eval {
$d->guarded_step(
"will fail",
ensure => sub { $var == 1 },
using => sub { $var = 2 },
);
};
like $@, qr{ERROR:.* 'ensure' block for 'will fail' still fails after running the 'using' block};
}
local @ARGV = ('--dry-run');
$d = Doit->init;
{
my $var = 0;
my $called = 0;
$d->guarded_step(
"var to zero",
ensure => sub { $var == 1 },
using => sub { $var = 1; $called++ },
is $r->open2({quiet=>1}, $^X, '-e', '#nothing'), '', 'nothing returned; command is also quiet';
is $r->info_open2($^X, '-e', 'print 42'), 42, 'info_open2 behaves as open2 in non-dry-run mode';
ok !eval { $r->info_open2($^X, '-e', 'exit 1'); 1 };
like $@, qr{open2 command '.* -e exit 1' failed: Command exited with exit code 1 at .* line \d+}, 'verbose error message with failed info_open2 command';
}
{
local @ARGV = ('--dry-run');
my $dry_run = Doit->init;
is $dry_run->open2({instr=>"input"}, $^X, '-e', 'print scalar <STDIN>'), undef, 'no output in dry-run mode';
is $dry_run->open2({instr=>"input",info=>1}, $^X, '-e', 'print scalar <STDIN>'), "input", 'info=>1: there is output in dry-run mode';
is $dry_run->info_open2({instr=>"input"}, $^X, '-e', 'print scalar <STDIN>'), "input", 'info_open2 behaves like info=>1';
}
} # TODO
__END__
is $r->open3({quiet=>1}, $^X, '-e', '#nothing'), '', 'nothing returned; command is also quiet';
is $r->info_open3($^X, '-e', 'print 42'), 42, 'info_open3 behaves as open3 in non-dry-run mode';
ok !eval { $r->info_open3($^X, '-e', 'exit 1'); 1 };
like $@, qr{open3 command '.* -e exit 1' failed: Command exited with exit code 1 at .* line \d+}, 'verbose error message with failed info_open3 command';
}
{
local @ARGV = ('--dry-run');
my $dry_run = Doit->init;
is $dry_run->open3({instr=>"input"}, $^X, '-e', 'print scalar <STDIN>'), undef, 'no output in dry-run mode';
is $dry_run->open3({instr=>"input",info=>1}, $^X, '-e', 'print scalar <STDIN>'), "input", 'info=>1: there is output in dry-run mode';
is $dry_run->info_open3({instr=>"input"}, $^X, '-e', 'print scalar <STDIN>'), "input", 'info_open3 behaves like info=>1';
}
} # TODO
__END__
}
{
my %status;
is $r->qx({statusref => \%status}, $^X, '-e', 'print STDOUT "some output\n"; exit 1'), "some output\n";
is $status{exitcode}, 1, 'status reference filled, exit code as expected (failure)';
}
}
{
local @ARGV = ('--dry-run');
my $dry_run = Doit->init;
is $dry_run->qx($^X, '-e', 'print 42'), undef, 'no output in dry-run mode';
is $dry_run->qx({info=>1}, $^X, '-e', 'print 42'), 42, 'info=>1: there is output in dry-run mode';
is $dry_run->info_qx($^X, '-e', 'print 42'), 42, 'info_qx behaves like info=>1';
}
__END__
if !eval { require BSD::Resource; 1 };
skip "coredumps disabled", $no_tests
if BSD::Resource::getrlimit(BSD::Resource::RLIMIT_CORE()) < 4096; # minimum of 4k needed on linux to actually do coredumps
eval { $r->system($^X, '-e', 'kill ABRT => $$') };
like $@, qr{^Command died with signal 6, with coredump}, 'error message with coredump';
is $@->{signalnum}, 6, 'expected signalnum';
is $@->{coredump}, 'with', 'expected coredump value ("with")';
}
{
local @ARGV = ('--dry-run');
my $tempdir = tempdir('doit_XXXXXXXX', TMPDIR => 1, CLEANUP => 1);
my $dry_run = Doit->init;
{
my $no_create_file = "$tempdir/should_never_happen";
is $dry_run->system($^X, '-e', 'open my $fh, ">", $ARGV[0] or die $!', $no_create_file), 1, 'returns 1 in dry-run mode';
ok ! -e $no_create_file, 'dry-run mode, no file was created';
}
{
view all matches for this distributionview release on metacpan - search on metacpan
( run in 0.646 second using v1.00-cache-2.02-grep-82fe00e-cpan-da92000dfeb )