view release on metacpan or  search on metacpan

t/file.t  view on Meta::CPAN

    eval { $doit->file_atomic_write };
    like $@, qr{file parameter is missing}i, "too few params";
}

{
    eval { $doit->file_atomic_write("$tempdir/1st") };
    like $@, qr{code parameter is missing}i, "too few params";
    ok !-e "$tempdir/1st", "file was not created";
}

{
    eval { $doit->file_atomic_write("$tempdir/1st", "not a sub") };
    like $@, qr{code parameter should be an anonymous subroutine or subroutine reference}i, "wrong type";
    ok !-e "$tempdir/1st", "file was not created";
}

{
    eval { $doit->file_atomic_write("$tempdir/1st", sub { }, does_not_exist => 1) };
    like $@, qr{unhandled option}i, "unhandled option error";
    ok !-e "$tempdir/1st", "file was not created";
}

{
    eval { $doit->file_atomic_write("$tempdir/1st", sub { die "something failed" }) };
    like $@, qr{something failed}i, "exception in code";
    ok !-e "$tempdir/1st", "file was not created";
    no_leftover_tmp $tempdir;
}

{   # This should be the first test case creating the new file
    $doit->create_file_if_nonexisting("$tempdir/stat_reference");

    is $doit->file_atomic_write("$tempdir/1st", sub {
				    my $fh = shift;
				    binmode $fh, ':encoding(utf-8)';
				    print $fh "\x{20ac}uro\n";
				}), 1;

    ok -s "$tempdir/1st", 'Created file exists and is non-empty';
    is slurp_utf8("$tempdir/1st"), "\x{20ac}uro\n", 'expected content';

    my(@stat_reference)    = stat("$tempdir/stat_reference");
    my(@stat_atomic_write) = stat("$tempdir/1st");
    is $stat_atomic_write[4], $stat_reference[4], 'expected owner on initial creation';
    is $stat_atomic_write[5], $stat_reference[5], 'expected group on initial creation';
    is(($stat_atomic_write[2] & 07777), ($stat_reference[2] & 07777), 'expected mode on initial creation');

    no_leftover_tmp $tempdir;
}

SKIP: {   # Test with setgid bit
    skip "No gid or setgid support under Windows", 1 if $^O eq 'MSWin32';

    my @gids = split / /, $(;
    my $test_gid = $gids[-1];
    $doit->mkdir("$tempdir/setgid");
    $doit->chown(undef, $test_gid, "$tempdir/setgid");
    if ($^O =~ /bsd/ || $^O eq 'darwin') {
	# no not for setgid on BSD like systems
    } else {
	$doit->chmod(((stat "$tempdir/setgid")[2] & 07777) | 02000, "$tempdir/setgid");
    }

    $doit->create_file_if_nonexisting("$tempdir/setgid/stat_reference");

    is $doit->file_atomic_write("$tempdir/setgid/file", sub {
				    my $fh = shift;
				    print $fh "test setgid\n";
				}, tmpdir => $tempdir), 1; # use a non-setgid directory for tmpfile

    ok -s "$tempdir/setgid/file", 'Created file exists and is non-empty';
    is slurp("$tempdir/setgid/file"), "test setgid\n", 'expected content';

    my(@stat_reference)    = stat("$tempdir/setgid/stat_reference");
    my(@stat_atomic_write) = stat("$tempdir/setgid/file");
    is $stat_atomic_write[4], $stat_reference[4], 'expected owner on initial creation';
    is $stat_atomic_write[5], $stat_reference[5], 'expected group on initial creation';
    is(($stat_atomic_write[2] & 07777), ($stat_reference[2] & 07777), 'expected mode on initial creation');

    no_leftover_tmp $tempdir;
}

{
    my @stat;

    is $doit->file_atomic_write("$tempdir/my_mode", sub {
				    my $fh = shift;
				    print $fh "my special mode\n";
				}, mode => 0400), 1;

    ok -s "$tempdir/my_mode", 'Created file exists and is non-empty';
    is slurp("$tempdir/my_mode"), "my special mode\n", 'expected content';

    @stat = stat("$tempdir/my_mode");
    is(($stat[2] & 07777), ($^O eq 'MSWin32' ? 0444 : 0400), 'mode option on newly created file');

    is $doit->file_atomic_write("$tempdir/my_mode", sub {
				    my $fh = shift;
				    print $fh "changing my mode\n";
				}, mode => 0600), 1;

    is slurp("$tempdir/my_mode"), "changing my mode\n", 'content was changed';

    @stat = stat("$tempdir/my_mode");
    is(($stat[2] & 07777), ($^O eq 'MSWin32' ? 0666 : 0600), 'mode option on existing file');

    no_leftover_tmp $tempdir;
}

{
    $doit->chmod(0600, "$tempdir/1st");
    my $mode_before = (stat("$tempdir/1st"))[2];

    is $doit->file_atomic_write("$tempdir/1st", sub {
				    my $fh = shift;
				    print $fh "changed content\n";
				}), 1;
    is slurp("$tempdir/1st"), "changed content\n", 'content of existent file changed';
    my $mode_after = (stat("$tempdir/1st"))[2];
    is $mode_after, $mode_before, 'mode was preserved';
    no_leftover_tmp $tempdir;
}

{
    is $doit->file_atomic_write("$tempdir/1st", sub {
				    my($fh, $filename) = @_;
				    $doit->system($^X, '-e', 'open my $ofh, ">", shift or die $!; print $ofh "external program writing the contents\n"; close $ofh or die $!', $filename);
				}), 1;
    is slurp("$tempdir/1st"), "external program writing the contents\n", 'filename parameter was used';
    no_leftover_tmp $tempdir;
}

for my $opt_def (
		 [tmpsuffix => '.another_suffix'],
		 [tmpdir => "$tempdir/another_tmp"],
		) {
    my $opt_spec = "@$opt_def";
    is $doit->file_atomic_write("$tempdir/1st",
				sub {
				    my $fh = shift;
				    print $fh $opt_spec;
				}, @$opt_def), 1;
    is slurp("$tempdir/1st"), $opt_spec, "atomic write with opts: $opt_spec";
    if ($opt_def->[0] eq 'tmpsuffix') {
	no_leftover_tmp $tempdir, $opt_def->[1];
    } else {
	no_leftover_tmp $tempdir;
    }
}

{ # check change
    is $doit->file_atomic_write("$tempdir/checked",
				sub {
				    my $fh = shift;
				    print $fh "checked change\n";
				}, check_change => 1), 1, "checked change (non-existing file before)";

    is $doit->file_atomic_write("$tempdir/checked",
				sub {
				    my $fh = shift;
				    print $fh "checked change\n";
				}, check_change => 1), 0, 'no change detected';

    is slurp("$tempdir/checked"), "checked change\n";

    is $doit->file_atomic_write("$tempdir/checked",
				sub {
				    my $fh = shift;
				    print $fh "now there's a change\n";
				}, check_change => 1), 1, 'change on existing file';