The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
use strict;
use warnings;

use Test::More;
use Test::Exception;

use File::Path::Tiny;

if ( !-x "/bin/mv" || !-x "/bin/mkdir" ) {    # dragons! patches welcome
    plan skip_all => 'Only operate on systems w/ /bin/mv and /bin/mkdir, for reasons see the cource code comments';
}
else {
    plan tests => 22;
}

use File::Temp;
use Cwd;
use File::Spec;

my $orig_dir = Cwd::cwd();
my $dir      = File::Temp->newdir();
our $catdir_toggle = sub { };
our @catdir_calls;

chdir $dir || die "Could not chdir into temp directory: $!\n";    # so we can pathrm(), dragons!

{
    ##############################################################################
    #### Wrap catdir() to control a symlink toggle in the path traversal loops. ##
    ##############################################################################
    no strict "refs";
    no warnings "redefine", "once";
    my $real_catdir = \&{ $File::Spec::ISA[0] . "::catdir" };
    local *File::Spec::catdir = sub {
        my ( $self, @args ) = @_;
        push @catdir_calls, \@args;
        $catdir_toggle->(@args);
        goto &$real_catdir;
    };

    mkdir "empty_dir";
    mkdir "empty_dir/sanity";
    File::Path::Tiny::empty_dir("empty_dir");
    is( @catdir_calls, 1, "sanity check: catdir was actually called in the empty_dir() loop" );

    mkdir "rm";
    mkdir "rm/sanity";
    File::Path::Tiny::rm("rm");
    is( @catdir_calls, 2, "sanity check: catdir was actually called in the pathrmdir() loop" );

    ####################
    #### Actual tests ##
    ####################

    for my $func (qw(empty_dir rm)) {
        _test( $func, "cwd/foo/bar/baz", "bails when high level changes" );
        _test( $func, "cwd/foo/bar",     "bails when mid level changes" );
        _test( $func, "cwd/foo",         "bails when low level changes" );
        _test( $func, "cwd",             "bails when CWD level changes" );
        _test( $func, "",                "bails when below level changes" );
    }

    # TODO: cover readdir, chdir, and post loop failures
}

chdir $orig_dir || die "Could not chdir back to original directory: $!\n";

###############
#### helpers ##
###############

sub _test {
    my ( $func, $toggle, $label ) = @_;

    _setup_tree($func);

    {
        local @catdir_calls  = ();
        local $catdir_toggle = sub {
            chdir $dir || die "could not toggle dir/symlink (chdir): $!";

            my $parent = "";
            if ($toggle) {
                $parent = $toggle;
                $parent =~ s{[^/]+$}{};

                # use system call since the perl to do this will likely use File::Spec
                system("/bin/mkdir -p moved/$func/$parent") and die "could not toggle dir/symlink (mkdir): $?\n";
            }

            # use system call since the perl to do this will likely use File::Spec
            system("/bin/mv $dir/$func/$toggle $dir/moved/$func/$toggle") and die "could not toggle dir/symlink (mv): $?\n";
            symlink( "$dir/victim", "$dir/$func" . ( $toggle ? "/$toggle" : "" ) ) or die "could not toggle dir/symlink (sym): $!\n";

            chdir "$func/cwd" || die "could not toggle dir/symlink (back into $func/cwd): $!\n";
        };

        throws_ok { no strict "refs"; "File::Path::Tiny::$func"->("foo/bar/baz") }
        qr/directory .* changed: expected dev=.* ino=.*, actual dev=.* ino=.*, aborting/,
          "$func() detected symlink toggle: $label";

        is( @catdir_calls, 1, "sanity check: catdir was actually called in $func() ($label)" );
    }

    _teardown_tree($func);
}

sub _teardown_tree {
    my ($base) = @_;

    chdir $dir || die "Could not chdir back into temp dir: $!\n";

    File::Path::Tiny::rm($base);
    File::Path::Tiny::rm("moved/");
    File::Path::Tiny::rm("victim/");

    return;
}

sub _setup_tree {
    my ($base) = @_;

    for my $dir ( "moved", "victim", "victim/cwd", $base, "$base/cwd", "$base/cwd/foo", "$base/cwd/foo/bar", "$base/cwd/foo/bar/baz" ) {
        mkdir $dir || die "Could not make test tree ($dir): $!\n";
        open my $fh, ">", "$dir/file.txt" || die "Could not make test file in ($dir): $!\n";
        print {$fh} "oh hai\n";
        close($fh);
    }

    chdir "$base/cwd" || die "Could not chdir into $base/cwd: $!\n";

    return;
}