view release on metacpan or  search on metacpan

lib/Test/MockFile.pm  view on Meta::CPAN

        keys %files_being_mocked
    };

    return @files_in_dir;
}

# Walk up the path to find the nearest ancestor directory with autovivify enabled.
# Returns the mock object if found, undef otherwise.
sub _find_autovivify_parent {
    my ($abs_path) = @_;

    return unless %_autovivify_dirs;

    my $dir = $abs_path;
    while ( $dir =~ s{/[^/]+$}{} && length $dir ) {
        if ( my $mock = $_autovivify_dirs{$dir} ) {
            return $mock;
        }
    }

    return;
}

# If $abs_path is under an autovivify directory, create a non-existent file mock
# for it and return the mock. Otherwise return undef.
sub _maybe_autovivify {
    my ($abs_path) = @_;

    return unless defined $abs_path && length $abs_path;

    # Already mocked? Nothing to do.
    return $files_being_mocked{$abs_path} if $files_being_mocked{$abs_path};

    my $parent = _find_autovivify_parent($abs_path) or return;

    # Create a non-existent file mock (contents=undef means "not there yet")
    my $mock = _new_nonexistent_file_mock($abs_path);

    # Store in global hash (weak ref, as usual)
    $files_being_mocked{$abs_path} = $mock;
    Scalar::Util::weaken( $files_being_mocked{$abs_path} );

    # Parent holds the strong ref so it stays alive until parent is destroyed
    $parent->{'_autovivified_children'} //= [];
    push @{ $parent->{'_autovivified_children'} }, $mock;

    return $mock;
}

sub _abs_path_to_file {
    my ($path) = shift;

    return unless defined $path;

    # Tilde expansion must happen before making the path absolute
    # ~
    # ~/...
    # ~sawyer
    if ( $path =~ m{ ^(~ ([^/]+)? ) }xms ) {
        my $req_homedir = $1;
        my $username    = $2 || getpwuid($<);
        my $pw_homedir;

        # Reset iterator so we *definitely* start from the first one
        # Then reset when done looping over pw entries
        endpwent;
        while ( my @pwdata = getpwent ) {
            if ( $pwdata[0] eq $username ) {
                $pw_homedir = $pwdata[7];
                endpwent;
                last;
            }
        }
        endpwent;

        $pw_homedir
          or die;

        $path =~ s{\Q$req_homedir\E}{$pw_homedir};
    }

    # Make path absolute if relative
    if ( $path !~ m{^/}xms ) {
        $path = Cwd::getcwd() . "/$path";
    }

    # Resolve path components: remove ".", resolve "..", collapse slashes
    my @resolved;
    for my $part ( split m{/}, $path ) {
        next if $part eq '' || $part eq '.';
        if ( $part eq '..' ) {
            pop @resolved;
            next;
        }
        push @resolved, $part;
    }

    return '/' . join( '/', @resolved );
}

# Override for Cwd::abs_path / Cwd::realpath that resolves mocked symlinks.
# When a path (or any component of it) involves a mocked symlink, we resolve
# the symlinks ourselves. Otherwise, we delegate to the original implementation.

sub __cwd_abs_path {
    my ($path) = @_;
    $path = '.' unless defined $path && length $path;

    # Make absolute without collapsing .. (symlink-aware resolution does that)
    if ( $path !~ m{^/} ) {
        $path = Cwd::getcwd() . "/$path";
    }

    my @remaining = grep { $_ ne '' && $_ ne '.' } split( m{/}, $path );
    my $resolved      = '';
    my $depth         = 0;
    my $involves_mock = 0;

    while (@remaining) {
        my $component = shift @remaining;