File Coverage

lib/Test/Chai/Util/PathInfo.pm

Criterion	Covered	Total	%
statement	52	52	100.0
branch	20	22	90.9
condition	2	3	66.6
subroutine	8	8	100.0
pod	0	1	0.0
total	82	86	95.3

package Test::Chai::Util::PathInfo;
use strict;
use warnings;
use utf8;

use Exporter qw/import/;
our @EXPORT_OK = qw/get_path_info/;

use Test::Chai::Util::Property qw/has_property/;

sub get_path_info {
    my ($path, $obj) = @_;

    my $parsed = _parse_path($path);
    my $last   = $parsed->[@$parsed - 1];

    my $info = {
        parent => @$parsed > 1 ? _get_path_value($parsed, $obj, @$parsed - 1) : $obj,
        name   => $last->{p} // $last->{i},
        value  => _get_path_value($parsed, $obj),
    };

    $info->{exists} = has_property($info->{name}, $info->{parent});
    return $info;
}

sub _parse_path {
    my $path = shift;

    my $str   = $path; $str =~ s/([^\\])\[/$1.[/g;
    my @parts = $str =~ /(\\\.|[^.]+)+/g;

    return [ map {
        my $value = $_;
        my $re    = qr/^\[(\d+)\]$/;
        my @m_arr = $value =~ $re;

        if (@m_arr > 0) {
            { i => $m_arr[0] };
        }

        else {
            $value =~ s/\\([.\[\]])/$1/g;
            { p => $value };
        }
    } @parts ];
}

sub _get_path_value {
    my ($parsed, $obj, $index) = @_;

    my $tmp = $obj;
    my $res;

    $index = defined $index ? $index : @$parsed;

    for (my ($i, $l) = (0, $index); $i < $l; $i++) {
        my $part = $parsed->[$i];

        if ($tmp) {
            if (ref $tmp eq 'ARRAY') {
                if (defined $part->{p}) {
                    $tmp = $tmp->[$part->{p}];
                }

                elsif (defined $part->{i}) {
                    $tmp = $tmp->[$part->{i}];
                }
            }

            elsif (ref $tmp eq 'HASH') {
                if (defined $part->{p}) {
                    $tmp = $tmp->{$part->{p}};
                }

                elsif (defined $part->{i}) {
                    $tmp = $tmp->{$part->{i}};
                }
            }

            else {
                $tmp = undef;
            }

            if ($i == $l - 1) {
                $res = $tmp;
            }
        }

        else {
            $res = undef;
        }
    }

    return $res;
}

1;