File Coverage

blib/lib/Path/List/Rule.pm

Criterion	Covered	Total	%
statement	78	88	88.6
branch	23	28	82.1
condition			n/a
subroutine	17	23	73.9
pod	1	1	100.0
total	119	140	85.0

package Path::List::Rule;

# ABSTRACT: Path::Iterator::Rule on an list of paths

use 5.006;

use strict;
use warnings;

our $VERSION = '0.01';

use File::Spec::Functions ();
use parent 'Path::Iterator::Rule';

{
    package    # avoid CPAN indexing
      Path::List::Rule::Entry;

    use overload
      '-X'     => '_statit',
      'bool'   => sub { 1 },
      '""'     => 'stringify',
      fallback => 1,
      ;

    sub _croak {
        require Carp;
        goto \&Carp::croak;
    }

    sub new {
        my ( $class, $fs, $path, $leaf ) = @_;

        substr($path,-1,1,'') if substr($path,-1,1) eq q{/};
        my %self = (
            exists => 1,
            path   => $path,
            leaf   => $leaf,
            fs     => {},
        );

        # doesn't exist
        if ( !defined $fs ) {
            $self{is_dir} = $self{is_file} = $self{exists} = 0;
        }
        # maybe a file
        elsif ( defined $leaf ) {
            $self{is_dir}  = defined $fs->{$leaf};
            $self{is_file} = !defined $fs->{$leaf};
            $self{fs}      = $fs->{$leaf} if $self{is_dir};
        }
        # not a file
        else {
            $self{is_dir}  = 1;
            $self{is_file} = 0;
            $self{fs}      = $fs;
        }

        return bless \%self, $class;
    }

    sub _children {
        my $self = shift;
        return map { __PACKAGE__->new( $self->{fs}, "$self->{path}/$_", $_ ) } keys %{ $self->{fs} };
    }

    sub _statit {
        my ( $self, $op ) = @_;
        if    ( $op eq 'e' ) { return $self->{exists} }
        if    ( $op eq 'l' ) { return 0; }
        if    ( $op eq 'r' ) { return 1; }
        elsif ( $op eq 'd' ) { return $self->{is_dir} }
        elsif ( $op eq 'f' ) { return $self->{is_file} }
        else                 { _croak( "unsupported file test: -$op\n" ) }
    }

    sub is_dir {
        return !! $_[0]->{is_dir};
    }

    sub is_file {
        return !! $_[0]->{is_file};
    }

    sub exists {
        return !! $_[0]->{exists};
    }

    sub stringify {
        return $_[0]->{path};
    }

}

sub _deconstruct_path {
    my $path = shift;
    my ( $volume, $directories, $file ) = File::Spec::Functions::splitpath( $path );
    my @dirs = File::Spec::Functions::splitdir( $directories );
    pop @dirs     if !length( $dirs[-1] );
    $file = undef if !length( $file );
    return ( $volume, $file, @dirs );
}

sub new {
    my $class = shift;
    my $paths = shift;
    my %fs;

    # let's create our "filesystem"! leafs which we know are
    # directories are set to an empty hash; otherwise undef.
    for my $path ( @{$paths} ) {
        my ( $volume, $file, @dirs ) = _deconstruct_path( $path );
        my $ref = \%fs;
        for my $entry ( $volume, @dirs ) {
            $ref->{$entry} = {} if !exists $ref->{$entry};
            $ref = $ref->{$entry};
        }
        $ref->{$file} = undef if defined $file;
    }

    my $self = $class->SUPER::new();
    $self->{_fs} = \%fs;

    return $self;
}

sub _objectify {
    my ( $self, $path ) = @_;

    my ( $volume, $file, @dirs ) = _deconstruct_path( $path );
    my $ref    = $self->{_fs};
    my $exists = 1;
    for my $entry ( $volume, @dirs ) {
        $exists = 0, last
          if !exists $ref->{$entry};
        $ref = $ref->{$entry};
    }
    return Path::List::Rule::Entry->new( $ref, $path, $file );
}

sub _children {
    my ( $self, $path ) = @_;
    return map { [ $_->{leaf}, $_ ] } $path->_children;
}

sub _defaults {
    return (
        _stringify      => 0,
        follow_symlinks => 1,
        depthfirst      => 0,
        sorted          => 1,
        loop_safe       => 1,
        error_handler   => sub { die sprintf( "%s: %s", @_ ) },
        visitor         => undef,
    );
}

sub _fast_defaults {

    return (
        _stringify      => 0,
        follow_symlinks => 1,
        depthfirst      => -1,
        sorted          => 0,
        loop_safe       => 0,
        error_handler   => undef,
        visitor         => undef,
    );
}

sub _iter {
    my $self     = shift;
    my $defaults = shift;
    $defaults->{loop_safe} = 0;
    $self->SUPER::_iter( $defaults, @_ );
}

1;

#
# This file is part of Path-List-Rule
#
# This software is copyright (c) 2022 by Smithsonian Astrophysical Observatory.
#
# This is free software; you can redistribute it and/or modify it under
# the same terms as the Perl 5 programming language system itself.
#

__END__