File Coverage

blib/lib/JIP/DataPath.pm

Criterion	Covered	Total	%
statement	82	86	95.3
branch	28	34	82.3
condition	21	41	51.2
subroutine	15	15	100.0
pod	8	8	100.0
total	154	184	83.7

package JIP::DataPath;

use strict;
use warnings;

use Carp qw(croak);
use Exporter qw(import);
use English qw(-no_match_vars);

our $VERSION = '0.042';

our @EXPORT_OK = qw(path);

sub path {
    my ($document) = @ARG;

    return __PACKAGE__->new(document => $document);
}

sub document {
    my ($self) = @ARG;

    return $self->{'document'};
}

sub new {
    my ($class, %param) = @ARG;

    # Mandatory params
    if (!exists $param{'document'}) {
        croak 'Mandatory argument "document" is missing';
    }

    return bless(
        {
            document => $param{'document'},
        },
        $class,
    );
}

sub get {
    my ($self, $path_parts, $default_value) = @ARG;

    if (@{ $path_parts } == 0) {
        return $self->document;
    }

    my ($contains, $context) = $self->_accessor($path_parts);

    return $default_value if !$contains;

    my $last_part = $path_parts->[-1] // q{};
    my $type      = ref $context      // q{};

    if ($type eq 'HASH' && length $last_part) {
        return $context->{$last_part};
    }
    elsif ($type eq 'ARRAY' && $last_part =~ m{^\d+$}x) {
        return $context->[$last_part];
    }

    return $default_value;
}

sub get_new {
    my ($self, $path_parts, $default_value) = @ARG;

    if (@{ $path_parts } == 0) {
        return __PACKAGE__->new(document => $self->document);
    }

    my ($contains, $context) = $self->_accessor($path_parts);

    return $default_value if !$contains;

    my $last_part = $path_parts->[-1] // q{};
    my $type      = ref $context      // q{};

    if ($type eq 'HASH' && length $last_part) {
        return __PACKAGE__->new(document => $context->{$last_part});
    }
    elsif ($type eq 'ARRAY' && $last_part =~ m{^\d+$}x) {
        return __PACKAGE__->new(document => $context->[$last_part]);
    }

    return $default_value;
}

sub contains {
    my ($self, @xargs) = @ARG;

    my ($contains) = $self->_accessor(@xargs);

    return $contains;
}

sub set {
    my ($self, $path_parts, $value) = @ARG;

    if (@{ $path_parts } == 0) {
        $self->_set_document($value);
        return 1;
    }

    my ($contains, $context) = $self->_accessor($path_parts);

    return 0 if !$contains;

    my $last_part = $path_parts->[-1] // q{};
    my $type      = ref $context      // q{};

    if ($type eq 'HASH' && length $last_part) {
        $context->{$last_part} = $value;
        return 1;
    }
    elsif ($type eq 'ARRAY' && $last_part =~ m{^\d+$}x) {
        $context->[$last_part] = $value;
        return 1;
    }

    return 0;
}

sub perform {
    my ($self, $method, $path_parts, @xargs) = @ARG;

    return $self->$method($path_parts, @xargs);
}

sub _set_document {
    my ($self, $document) = @ARG;

    $self->{'document'} = $document;

    return $self;
}

sub _accessor {
    my ($self, $path_parts) = @ARG;

    my $context    = $self->document;
    my $last_index = $#{ $path_parts };

    foreach my $part_index (0 .. $last_index) {
        my $part = $path_parts->[$part_index];
        my $type = ref $context // q{};
        my $last = $part_index == $last_index;

        if ($type eq 'HASH' && exists $context->{$part}) {
            return 1, $context if $last;

            $context = $context->{$part};
        }
        elsif ($type eq 'ARRAY' && $part =~ m{^\d+$}x && @{ $context } > $part) {
            return 1, $context if $last;

            $context = $context->[$part];
        }
        else {
            return 0, undef;
        }
    }

    return 1, $context;
}

1;

__END__