view release on metacpan or  search on metacpan

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

    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);
        },
    ) . "return ${data_var};";

    $self->_eval_sub($body, args => $args, captures => $captures);
}

sub updater {
    my ($self, %opts) = @_;
    my $path     = $self->split_path;
    my $data_var = $self->_generate_var;
    my $captures = {};
    my $args     = [$data_var];
    my $cb;

    if (my $tests = $opts{if}) {
        $cb = sub {
            my ($var, %opts) = @_;
            my $perl = "";
            for (my $i = 0; $i < @$tests; $i += 2) {
                my $test     = $tests->[$i];
                my $val      = $tests->[$i + 1];
                my $test_var = $self->_generate_var;
                my $val_var  = $self->_generate_var;
                $captures->{$test_var} = $test;
                $captures->{$val_var}  = $val;
                if ($i) {
                    $perl .= 'els';
                }
                $perl
                    .= "if (List::Util::any {\$_->(${var})} \@{${test_var}}) {"
                    . $self->_emit_assign_cb($var, $val_var, %opts) . '}';
            }
            $perl;
        };
    }
    else {
        my $val_var = $self->_generate_var;
        if (my $val = $opts{value}) {
            $captures->{$val_var} = $val;
        }
        else {
            push @$args, $val_var;
        }
        $cb = sub {
            my ($var, %opts) = @_;
            $self->_emit_assign_cb($var, $val_var, %opts);
        };
    }

    my $body
        = $self->_emit_get($data_var, $path, $cb) . "return ${data_var};";

    $self->_eval_sub($body, args => $args, captures => $captures);
}

sub creator {
    my ($self, %opts) = @_;
    my $path     = $self->split_path;
    my $data_var = $self->_generate_var;
    my $val_var  = $self->_generate_var;
    my $captures = {};
    my $args     = [$data_var];
    my $cb;

    if (is_code_ref($opts{value})) {
        $captures->{$val_var} = $opts{value};
        $cb = sub {