#!/usr/bin/perl
use strict;
use warnings;
use Path::Class;
use File::Spec::Functions;
use Test::More 'no_plan';
use Test::Exception;
use Test::TempDir qw(tempdir);
use ok 'Directory::Transactional';
my $name = catfile("foo", "foo.txt");
my $work;
foreach my $nfs ( 0, 1 ) {
my $dir = tempdir;
my $file = dir($dir)->file($name);
{
alarm 5;
my $d = Directory::Transactional->new( root => $dir, nfs => $nfs );
alarm 0;
isa_ok( $d, "Directory::Transactional" );
$work = $d->_work;
ok( not(-e $file), "file does not exist" );
{
$d->txn_begin;
ok( not(-e $file), "root file does not exist after starting txn" );
is_deeply( [ $d->list("foo") ], [ ], "file listing" );
is_deeply( [ $d->list("/") ], [ ], "file listing" );
$d->openw($name)->print("dancing\n");
is_deeply( [ $d->list("foo") ], [ "foo/foo.txt" ], "file listing" );
is_deeply( [ $d->list("/") ], [ "foo" ], "file listing" );
ok( not(-e $file), "root file does not exist after writing" );
$d->txn_commit;
}
ok( -e $file, "file exists after comitting" );
is( $file->slurp, "dancing\n", "file contents" );
$d->txn_do(sub {
$d->opena($name)->print("hippies\n");
});
ok( -e $file, "file exists after comitting" );
is( $file->slurp, "dancing\nhippies\n", "file contents" );
$d->txn_do(sub {
$d->open(">", $name)->print("dancing\n");
});
ok( -e $file, "file exists after comitting" );
is( $file->slurp, "dancing\n", "file contents" );
$d->txn_do(sub {
$d->open(">", "new_file.txt")->print("moose\n");
});
is( dir($dir)->file("new_file.txt")->slurp, "moose\n", "new file created, vivify did not die" );
$d->txn_do(sub { $d->unlink("new_file.txt") });
ok( not( -e dir($dir)->file("new_file.txt") ), "new file deleted" );
$d->txn_do(sub {
my $outer_path = $d->_work_path($name);
ok( not( -e $outer_path ), "txn not yet modified" );
is( $file->slurp, "dancing\n", "root file not yet modified" );
$d->txn_do(sub {
$d->openw($name)->print("hippies\n");
ok( not( -e $outer_path ), "txn not yet modified" );
is( $file->slurp, "dancing\n", "root file not yet modified" );
});
is( file($outer_path)->slurp, "hippies\n", "nested transaction comitted to parent" );
is( $file->slurp, "dancing\n", "root file not yet modified" );
});
is( $file->slurp, "hippies\n", "root file comitted" );
throws_ok {
$d->txn_do(sub {
$d->openr($name); # get a read lock, to test downgrading
$d->txn_do(sub {
my $path = $d->_work_path($name);
is( $file->slurp, "hippies\n", "root file unmodified" );
$d->openw($name)->print("hairy\n");
is( $file->slurp, "hippies\n", "root file unmodified" );
die "foo\n";
});
});
} qr/^foo$/, "caught error in txn_do";
is( $file->slurp, "hippies\n", "root file unmodified" );
{
$d->txn_begin;
ok( -e $file, "file exists" );
is( $file->slurp, "hippies\n", "unmodified" );
ok( !$d->is_deleted($name), "not marked as deleted" );
is_deeply( [ $d->list("foo") ], [ "foo/foo.txt" ], "file " );
$d->unlink($name);
ok( $d->is_deleted($name), "marked as deleted" );
is_deeply( [ $d->list("foo") ], [ ], "file listing" );
ok( -e $file, "file still exists" );
is( $file->slurp, "hippies\n", "unmodified" );
$d->txn_commit;
ok( not(-e $file), "file removed" );
}
$file->openw->print("hippies\n");
{
$d->txn_begin;
ok( -e $file, "file exists" );
is( $file->slurp, "hippies\n", "unmodified" );
ok( !$d->is_deleted($name), "not marked as deleted" );
{
$d->txn_begin;
ok( !$d->is_deleted($name), "not marked as deleted" );
$d->unlink($name);
ok( $d->is_deleted($name), "marked as deleted" );
ok( -e $file, "file still exists" );
is( $file->slurp, "hippies\n", "unmodified" );
$d->txn_commit;
}
ok( $d->is_deleted($name), "marked as deleted" );
ok( -e $file, "file still exists" );
is( $file->slurp, "hippies\n", "unmodified" );
$d->txn_commit;
ok( not(-e $file), "file removed" );
}
$file->openw->print("hippies\n");
{
my $targ = dir($dir)->file('oi_vey.txt');
$d->txn_begin;
ok( -e $file, "file exists" );
is( $file->slurp, "hippies\n", "unmodified" );
ok( !$d->is_deleted($name), "not marked as deleted" );
{
$d->txn_begin;
ok( !$d->is_deleted($name), "not marked as deleted" );
ok( $d->is_deleted("oi_vey.txt"), "target file is considered deleted" );
is_deeply( [ $d->list("foo") ], [ "foo/foo.txt" ], "file listing" );
is_deeply( [ $d->list("/") ], [ "foo" ], "file listing" );
$d->rename($name, "oi_vey.txt");
is_deeply( [ $d->list("foo") ], [ ], "file listing" );
is_deeply( [ $d->list("/") ], [ "foo", "oi_vey.txt" ], "file listing" );
ok( !$d->is_deleted("oi_vey.txt"), "renamed not deleted" );
ok( -e $d->_work_path("oi_vey.txt"), "target exists in the txn dir" );
my $stat = $d->stat("oi_vey.txt");
is( $stat->nlink, 1, "file has one link (stat)" );
ok( !$d->old_stat($name), "no stat for source file" );
ok( $d->is_deleted($name), "marked as deleted" );
ok( -e $file, "file still exists" );
is( $file->slurp, "hippies\n", "unmodified" );
$d->txn_commit;
}
ok( $d->is_deleted($name), "marked as deleted" );
ok( -e $file, "file still exists" );
is( $file->slurp, "hippies\n", "unmodified" );
$d->txn_commit;
ok( not(-e $file), "file removed" );
ok( -e $targ, "target file exists" );
is( $targ->slurp, "hippies\n", "contents" );
}
}
ok( not( -d $work ), "work dir removed" );
}