File Coverage

blib/lib/Block/NamedVar/MapLike.pm

Criterion	Covered	Total	%
statement	50	55	90.9
branch	13	16	81.2
condition			n/a
subroutine	9	9	100.0
pod	3	4	75.0
total	75	84	89.2

package Block::NamedVar::MapLike;
use strict;
use warnings;

use Devel::Declare::Interface;
use base 'Devel::Declare::Parser';

Devel::Declare::Interface::register_parser( 'map_var' );
__PACKAGE__->add_accessor( $_ ) for qw/dec var/;

sub rewrite {
    my $self = shift;

    if ( @{ $self->parts } > 2 ) {
        ( undef, my @bad ) = @{ $self->parts };
        $self->bail(
            "Syntax error near: " . join( ' and ',
                map { $self->format_part($_)} @bad
            )
        );
    }

    my ($first, $second) = @{ $self->parts };
    my ( $dec, $var ) = ("");
    if ( @{ $self->parts } > 1 ) {
        $self->bail(
            "Syntax error near: " . $self->format_part($first)
        ) unless grep { $first->[0] eq $_ } qw/my our/;
        $dec = $first;
        $var = $second;
    }
    else {
        $var = $first;
        $dec = ['my'] if ref $self->parts->[0];
    }

    $var = $self->format_var( $var );
    $self->dec( $dec );
    $self->var( $var );

    $self->new_parts([]);
    1;
}

sub format_var {
    my $self = shift;
    my ( $var ) = @_;
    if ( ref $var ) {
        $var = $var->[0];
    }
    return $var if $var =~ m/^\$\w[\w\d_]*$/;
    return "\$$var" if $var =~ m/^\w[\w\d_]*$/;
    $self->bail( "Syntax error, '$var' is not a valid block variable name" );
}

sub inject {
    my $self = shift;
    my $dec = $self->dec ? $self->dec->[0] : '';
    my $var = $self->var;
    return ( "$dec $var = \$_" );
}

sub _scope_end {
    my $class = shift;
    my ( $id ) = @_;
    my $self = Devel::Declare::Parser::_unstash( $id );

    my $linestr = $self->line;
    $self->offset( $self->_linestr_offset_from_dd() );
    substr($linestr, $self->offset, 0) = ', ';
    $self->line($linestr);
}

sub open_line {
    my $self = shift;
    return "";
}

1;

__END__