view release on metacpan or  search on metacpan

lib/Catmandu/Path/simple.pm  view on Meta::CPAN

package Catmandu::Path::simple;

use Catmandu::Sane;

our $VERSION = '1.2025';

use Catmandu::Util
    qw(is_hash_ref is_array_ref is_value is_natural is_code_ref trim);
use Moo;
use namespace::clean;

with 'Catmandu::Path', 'Catmandu::Emit';

use overload '""' => sub {$_[0]->path};

sub split_path {
    my ($self) = @_;
    my $path = $self->path;
    if (is_value($path)) {
        $path = trim($path);
        $path =~ s/^\$[\.\/]//;
        $path = [map {s/\\(?=[\.\/])//g; $_} split /(?<!\\)[\.\/]/, $path];
        return $path;
    }
    if (is_array_ref($path)) {
        return $path;
    }
    Catmandu::Error->throw("path should be a string or arrayref of strings");
}

sub getter {
    my ($self)   = @_;
    my $path     = $self->split_path;
    my $data_var = $self->_generate_var;
    my $vals_var = $self->_generate_var;

    my $body = $self->_emit_declare_vars($vals_var, '[]') . $self->_emit_get(
        $data_var,
        $path,
        sub {
            my ($var, %opts) = @_;

            # looping goes backwards to keep deletions safe
            "unshift(\@{${vals_var}}, ${var});";
        },
    ) . "return ${vals_var};";

    $self->_eval_sub($body, args => [$data_var]);
}

sub setter {
    my $self     = shift;
    my %opts     = @_ == 1 ? (value => $_[0]) : @_;
    my $path     = $self->split_path;
    my $key      = pop @$path;
    my $data_var = $self->_generate_var;
    my $val_var  = $self->_generate_var;
    my $captures = {};
    my $args     = [$data_var];

    my $body = $self->_emit_get(
        $data_var,
        $path,
        sub {
            my $var = $_[0];
            my $val;
            if (is_code_ref($opts{value})) {
                $captures->{$val_var} = $opts{value};
                $val = "${val_var}->(${var}, ${data_var})";
            }
            elsif (exists $opts{value}) {
                $captures->{$val_var} = $opts{value};
                $val = $val_var;
            }
            else {
                push @$args, $val_var;
                $val
                    = "is_code_ref(${val_var}) ? ${val_var}->(${var}, ${data_var}) : ${val_var}";
            }

            $self->_emit_set_key($var, $key, $val);