view release on metacpan or  search on metacpan

lib/HP/Handy.pm  view on Meta::CPAN

    # is / is not test
    if ($expr =~ /^(.+?)\s+is\s+not\b\s+(\w+)(?:\s+(.+))?$/) {
        my ($lhs, $test, $arg) = ($1, $2, $3);
        my $val = $self->_eval_expr($lhs, $vars);
        my $targ = defined $arg ? $self->_eval_expr($arg, $vars) : undef;
        my $fn = $self->{_tests}{$test};
        return $fn ? ($fn->($val, $targ) ? 0 : 1) : 1;
    }
    if ($expr =~ /^(.+?)\s+is\s+(\w+)(?:\s+(.+))?$/) {
        my ($lhs, $test, $arg) = ($1, $2, $3);
        my $val = $self->_eval_expr($lhs, $vars);
        my $targ = defined $arg ? $self->_eval_expr($arg, $vars) : undef;
        my $fn = $self->{_tests}{$test};
        return $fn ? ($fn->($val, $targ) ? 1 : 0) : 0;
    }

    # Attribute access: obj.attr or obj["key"] or obj['key']
    if ($expr =~ /^(.+?)\.(\w+)(?:\(([^)]*)\))?$/) {
        my ($obj_expr, $attr, $call_args) = ($1, $2, $3);
        my $obj = $self->_eval_expr($obj_expr, $vars);
        if (defined $call_args) {
            # Method call (filters on object)
            my $fn = $self->{_filters}{$attr};
            my @args = map { $self->_eval_expr($_, $vars) } _split_args($call_args);
            return $fn ? $fn->($obj, @args) : undef;
        }
        return _get_attr($obj, $attr);
    }

    if ($expr =~ /^(.+?)\[["'](\w+)["']\]$/) {
        my ($obj_expr, $key) = ($1, $2);
        my $obj = $self->_eval_expr($obj_expr, $vars);
        return _get_attr($obj, $key);
    }

    if ($expr =~ /^(.+?)\[(-?\d+)\]$/) {
        my ($obj_expr, $idx) = ($1, $2);
        my $obj = $self->_eval_expr($obj_expr, $vars);
        return ref($obj) eq 'ARRAY' ? $obj->[$idx] : undef;
    }

    # Slice: list[start:end]
    if ($expr =~ /^(.+?)\[(-?\d*):(-?\d*)\]$/) {
        my ($obj_expr, $s, $e) = ($1, $2, $3);
        my $obj = $self->_eval_expr($obj_expr, $vars);
        return undef unless ref($obj) eq 'ARRAY';
        my $len  = scalar @$obj;
        my $si   = ($s ne '') ? int($s) : 0;
        my $ei   = ($e ne '') ? int($e) : $len;
        $si += $len if $si < 0;
        $ei += $len if $ei < 0;
        $si = 0    if $si < 0;
        $ei = $len if $ei > $len;
        return [ @{$obj}[$si .. $ei - 1] ];
    }

    # Function/macro call: name(args)
    if ($expr =~ /^(\w+)\s*\(([^)]*)\)$/) {
        my ($fname, $argstr) = ($1, $2);
        # Macro call
        if (exists $self->{_macros}{$fname}) {
            return $self->_call_macro($fname, $argstr, $vars, '<expr>');
        }
        # Built-in functions
        if ($fname eq 'range') {
            return $self->_eval_range($argstr, $vars);
        }
    }

    # Variable lookup
    if ($expr =~ /^(\w+)$/) {
        return exists $vars->{$expr} ? $vars->{$expr} : undef;
    }

    return undef;
}

###############################################################################
# _eval_dict - Parse and evaluate a dict literal { key: val, ... }
###############################################################################
sub _eval_dict {
    my ($self, $inner, $vars) = @_;
    my %h;
    # Simple k:v split (no nested dicts)
    for my $pair (_split_args($inner)) {
        if ($pair =~ /^(.+?)\s*:\s*(.+)$/) {
            my $k = $self->_eval_expr($1, $vars);
            my $v = $self->_eval_expr($2, $vars);
            $h{$k} = $v if defined $k;
        }
    }
    return { %h };
}

###############################################################################
# _eval_range - Evaluate range(stop) / range(start, stop[, step])
###############################################################################
sub _eval_range {
    my ($self, $args_str, $vars) = @_;
    my @args = map { $self->_eval_expr($_, $vars) } _split_args($args_str);
    my ($start, $stop, $step);
    if (@args == 1) { ($start, $stop, $step) = (0, int($args[0]), 1) }
    elsif (@args == 2) { ($start, $stop, $step) = (int($args[0]), int($args[1]), 1) }
    else { ($start, $stop, $step) = (int($args[0]), int($args[1]), int($args[2] || 1)) }
    $step = 1 if $step == 0;
    my @result;
    if ($step > 0) { for (my $n = $start; $n < $stop; $n += $step) { push @result, $n } }
    else           { for (my $n = $start; $n > $stop; $n += $step) { push @result, $n } }
    return [ @result ];
}

###############################################################################
# _get_attr - Get attribute from hash or array
###############################################################################
sub _get_attr {
    my ($obj, $attr) = @_;
    return undef unless defined $obj;
    if (ref($obj) eq 'HASH') {
        return exists $obj->{$attr} ? $obj->{$attr} : undef;
    }