File Coverage

blib/lib/Data/PathSimple.pm

Criterion	Covered	Total	%
statement	55	56	98.2
branch	34	38	89.4
condition			n/a
subroutine	6	6	100.0
pod	2	2	100.0
total	97	102	95.1

package Data::PathSimple;

use strict;
use warnings;

use version 0.77;
our $VERSION = qv("v1.0.2");

use base 'Exporter';
our @EXPORT_OK = qw{
  get
  set
};

sub get {
  my ( $root_ref, $root_path ) = @_;

  return undef unless defined $root_path;
  $root_path =~ s/^\///;

  my @root_parts  = split '/', $root_path;
  my $current_ref = $root_ref;

  return undef unless @root_parts;

  foreach my $current_part ( @root_parts ) {
    if ( ref $current_ref eq 'HASH' ) {
      if ( exists $current_ref->{$current_part} ) {
        $current_ref = $current_ref->{$current_part};
        next;
      }
    }
    elsif ( ref $current_ref eq 'ARRAY' ) {
      return undef if $current_part !~ /^\d+$/;

      if ( exists $current_ref->[$current_part] ) {
        $current_ref = $current_ref->[$current_part];
        next;
      }
    }

    return undef;
  }

  return $current_ref;
}

sub set {
  my ( $root_ref, $root_path, $value ) = @_;

  return undef unless defined $root_path;
  $root_path  =~ s/^\///;

  my @root_parts  = split '/', $root_path;
  my $current_ref = $root_ref;

  return undef unless @root_parts;

  for ( my $i = 0; $i < ( @root_parts - 1 ); $i++ ) {
    my $current_part = $root_parts[ $i ];
    my $next_part    = $root_parts[ $i + 1 ];

    if ( ref $current_ref eq 'HASH' ) {
      if ( not ref $current_ref->{$current_part} ) {
        $current_ref->{$current_part}
          = $next_part =~ /^\d+$/
            ? []
            : {};
      }

      $current_ref = $current_ref->{$current_part};
      next;
    }
    elsif ( ref $current_ref eq 'ARRAY' ) {
      return undef if $current_part !~ /^\d+$/;

      if ( not ref $current_ref->[$current_part] ) {
        $current_ref->[$current_part]
          = $next_part =~ /^\d+$/
            ? []
            : {};
      }

      $current_ref = $current_ref->[$current_part];
      next;
    }

    return undef;
  }

  my $last_part = pop @root_parts;

  if ( ref $current_ref eq 'HASH' ) {
    return $current_ref->{$last_part} = $value;
  }

  if ( ref $current_ref eq 'ARRAY' ) {
    return undef if $last_part !~ /^\d+$/;
    return $current_ref->[$last_part] = $value;
  }

  return undef;
}

1;

__END__