The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!/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" );
}