view release on metacpan or  search on metacpan

t/file.t  view on Meta::CPAN

my $tempdir = tempdir('doit_XXXXXXXX', TMPDIR => 1, CLEANUP => 1);
$doit->mkdir("$tempdir/another_tmp");

{
    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;

t/file.t  view on Meta::CPAN

				    }, tmpdir => $other_fs_dir, mode => 0400), 1;
	is slurp("$tempdir/my_fresh_mode"), "using mode and File::Copy::move (fresh)\n", "cross-mount move with fresh file";
	@stat = stat("$tempdir/my_fresh_mode");
	is(($stat[2] & 07777), ($^O eq 'MSWin32' ? 0444 : 0400), 'mode option on newly created file');

	is $doit->file_atomic_write("$tempdir/my_fresh_mode",
				    sub {
					my $fh = shift;
					print $fh "using mode and File::Copy::move (existing)\n";
				    }, tmpdir => $other_fs_dir, mode => 0600), 1;
	is slurp("$tempdir/my_fresh_mode"), "using mode and File::Copy::move (existing)\n", "cross-mount move with existing file";
	@stat = stat("$tempdir/my_fresh_mode");
	is(($stat[2] & 07777), ($^O eq 'MSWin32' ? 0666 : 0600), 'mode option on existing file');
    }

    { # dry-run check
	my $old_content = slurp("$tempdir/1st");
	is $doit_dryrun->file_atomic_write("$tempdir/1st", sub {
					       my $fh = shift;
					       print $fh "this is dry run mode\n";
					   }, tmpdir => $other_fs_dir), 1;
	is slurp("$tempdir/1st"), $old_content, 'nothing changed in dry run mode';
	no_leftover_tmp $other_fs_dir, '';
    }
}

# Find or even create another filesystem for
# cross-mount tests. Currently implemted:
# - if /run/user/$uid exists, then use this one (usually
#   it's on a separate tmpfs)
# - if a lot of conditions match (linux, no container,
#   sudo possible...), then create a filesystem on
#   the fly; it will cleaned up later
sub get_another_filesystem {
    if ($ENV{XDG_RUNTIME_DIR} && -d $ENV{XDG_RUNTIME_DIR} && -w $ENV{XDG_RUNTIME_DIR}) {
	my $xdg_dev     = (stat $ENV{XDG_RUNTIME_DIR})[0];
	my $tempdir_dev = (stat $tempdir)[0];
	if ($xdg_dev != $tempdir_dev) {
	    my $other_fs_dir = tempdir('doit_XXXXXXXX', DIR => $ENV{XDG_RUNTIME_DIR}, CLEANUP => 1);
	    return { other_fs_dir => $other_fs_dir };
	}
    }

    return { skip => "Mounting fs only implemented for linux" } if $^O ne 'linux';
    return { skip => "Cannot mount in linux containers" } if TestUtil::in_linux_container($doit);
    return { skip => "dd not available" } if !$doit->which("dd");
    return { skip => "mkfs not available" } if !-x "/sbin/mkfs";
    my $sudo = TestUtil::get_sudo($doit, info => \my %info);
    return { skip => $info{error} } if !$sudo;

    my $fs_file = "$tempdir/testfs";
    $doit->system(qw(dd if=/dev/zero), "of=$fs_file", qw(count=1 bs=1MB));
    $doit->system(qw(/sbin/mkfs -t ext3), $fs_file);
    my $mnt_point = "$tempdir/testmnt";
    $doit->mkdir($mnt_point);
    my $mount_scope = new_scope_cleanup {
	$sudo->system(qw(umount), $mnt_point);
    };
    $sudo->system(qw(mount -o loop), $fs_file, $mnt_point);
    $sudo->mkdir("$mnt_point/dir");
    $sudo->chown($<, undef, "$mnt_point/dir");

    return { other_fs_dir => "$mnt_point/dir", scope_cleanup => $mount_scope };
}