File Coverage

blib/lib/JSON/Path.pm

Criterion	Covered	Total	%
statement	82	88	93.1
branch	9	14	64.2
condition	7	9	77.7
subroutine	24	24	100.0
pod	11	11	100.0
total	133	146	91.1

use 5.008;
use strict;
use warnings;

package JSON::Path;
$JSON::Path::VERSION = '0.5';
# VERSION

use Exporter::Tiny ();
our @ISA       = qw/ Exporter::Tiny /;
our $AUTHORITY = 'cpan:POPEFELIX';
our $Safe      = 1;

use Carp;
use JSON::MaybeXS qw/decode_json/;
use JSON::Path::Evaluator;
use Scalar::Util qw[blessed];
use LV ();

our @EXPORT_OK = qw/ jpath jpath1 jpath_map /;

use overload '""' => \&to_string;

sub jpath {
    my ( $object, $expression ) = @_;
    my @return = __PACKAGE__->new($expression)->values($object);
}

sub jpath1 : lvalue {
    my ( $object, $expression ) = @_;
    __PACKAGE__->new($expression)->value($object);
}

sub jpath_map (&$$) {
    my ( $coderef, $object, $expression ) = @_;
    return __PACKAGE__->new($expression)->map( $object, $coderef );
}

sub new {
    my ( $class, $expression ) = @_;
    return $expression
        if blessed($expression) && $expression->isa(__PACKAGE__);
    return bless \$expression, $class;
}

sub to_string {
    my ($self) = @_;
    return $$self;
}

sub paths {
    my ( $self, $object ) = @_;
    my @paths = JSON::Path::Evaluator::evaluate_jsonpath( $object, "$self", want_path => 1);
    return @paths;
}

sub get {
    my ( $self, $object ) = @_;
    my @values = $self->values($object);
    return wantarray ? @values : $values[0];
}

sub set {
    my ( $self, $object, $value, $limit ) = @_;

    if ( !ref $object ) {
        # warn if not called internally. If called internally (i.e. from value()) we will already have warned.
        my @c = caller(0);
        if ( $c[1] !~ /JSON\/Path\.pm$/ ) {
            carp qq{Useless attempt to set a value on a non-reference};
        }
    }
    my $count = 0;
    my @refs = JSON::Path::Evaluator::evaluate_jsonpath( $object, "$self", want_ref => 1 );
    for my $ref (@refs) {
        ${$ref} = $value;
        ++$count;
        last if $limit && ( $count >= $limit );
    }
    return $count;
}

sub value : lvalue {
    my ( $self, $object ) = @_;
    LV::lvalue(
        get => sub {
            my ($value) = $self->get($object);
            return $value;
        },
        set => sub {
            my $value = shift;
            # do some caller() magic to warn at the right place
            if ( !ref $object ) {
                my @c = caller(2);
                my ( $filename, $line ) = @c[ 1, 2 ];
                warn qq{Useless attempt to set a value on a non-reference at $filename line $line\n};
            }
            $self->set( $object, $value, 1 );
        },
    );
}

sub values {
    my ( $self, $object ) = @_;
    croak q{non-safe evaluation, died} if "$self" =~ /\?\(/ && $JSON::Path::Safe;

    return JSON::Path::Evaluator::evaluate_jsonpath( $object, "$self", script_engine => 'perl' );
}

sub map {
    my ( $self, $object, $coderef ) = @_;
    my $count;
    foreach my $path ( $self->paths( $object ) ) {
        my ($ref) = JSON::Path::Evaluator::evaluate_jsonpath( $object, $path, want_ref => 1 );
        ++$count;
        my $value = do {
            no warnings 'numeric';
            local $_ = ${$ref};
            local $. = $path;
            scalar $coderef->();
        };
        ${$ref} = $value;
    }
    return $count;
}

1;

__END__