view release on metacpan or  search on metacpan

lib/File/Wildcard.pm  view on Meta::CPAN

    my ($new_re) = validate_pos( @_, { type => SCALARREF, optional => 1 } );

    $new_re ? ( $self->{match} = $new_re ) : $self->{match};
}

sub append {
    my $self = shift;

    my %par = validate(
        @_,
        {   path     => { type => SCALAR | ARRAYREF },
            follow   => 0,
            absolute => 0,
        }
    );
    my %new;

    @new{qw/ path_remaining absolute follow /}
        = $self->_split_path( @par{qw/ path absolute follow /} );
    $new{state} = 'nextdir';
    $new{resulting_path} = $new{absolute} ? '/' : '';

    unshift @{ $self->{state_stack} }, \%new;

    $self->_pop_state if !$self->{state} || ( $self->{state} eq 'finished' );
}

sub prepend {
    my $self = shift;

    my %par = validate(
        @_,
        {   path     => { type => SCALAR | ARRAYREF },
            follow   => 0,
            absolute => 0,
        }
    );

    $self->_push_state;

    my ( $pr, $abs, $fol )
        = $self->_split_path( @par{qw/ path absolute follow /} );
    $self->{path_remaining} = $pr;
    $self->{absolute}       = $abs;
    $self->{follow}         = $fol;
    $self->{resulting_path} = $self->{absolute} ? '/' : '';
    $self->_set_state( state => 'nextdir' );
}

sub _split_path {
    my $self = shift;

    my ( $path, $abs, $follow ) = validate_pos( @_, 0, 0, 0 );

    return ( $path, $abs, $follow ) if !defined($path) || ref $path;

    $path =~ s!//!/!g;
    $abs = $path =~ s!^/!!;
    $path =~ s!^\./!/!;
    my @out = split m(/), $path, -1;    #/ (syntax highlighting)
    shift @out if $out[0]  eq '';
    pop @out   if $out[-1] eq '';

    ( \@out, $abs, $follow );
}

sub _set_state {
    my $self = shift;

    my %par = validate(
        @_,
        {   state => { type => SCALAR },
            dir   => { type => GLOBREF | CODEREF, optional => 1 },
            wildcard => 0,
        }
    );
    $self->{$_} = $par{$_} for keys %par;
}

sub _push_state {
    my $self = shift;

    $self->_debug( "Push state: "
            . $self->{state}
            . " resulting_path: "
            . $self->{resulting_path}
            . " Wildcard: "
            . ( $self->{wildcard} || '' )
            . " path_remaining: "
            . join( '/', @{ $self->{path_remaining} } )
            . "\n" );
    push @{ $self->{state_stack} }, {
        map {
            $_, ( ref( $self->{$_} ) eq 'ARRAY' )
                ? [ @{ $self->{$_} } ]
                : $self->{$_}
            } qw/ state path_remaining dir resulting_path /
    };
}

sub _pop_state {
    my $self = shift;

    $self->{state_stack} ||= [];
    my $newstate
        = @{ $self->{state_stack} }
        ? pop( @{ $self->{state_stack} } )
        : { state => 'finished', dir => undef };
    $self->{$_} = $newstate->{$_} for keys %$newstate;
    $self->_debug( "Pop state to "
            . $self->{state}
            . " resulting_path: "
            . $self->{resulting_path}
            . " Wildcard: "
            . ( $self->{wildcard} || '' )
            . " path_remaining: "
            . join( '/', @{ $self->{path_remaining} } )
            . "\n" );
}