view release on metacpan or  search on metacpan

lib/Tree/Navigator/Node/Perl/Ref.pm  view on Meta::CPAN

package Tree::Navigator::Node::Perl::Ref;
use utf8;
use Moose;
extends 'Tree::Navigator::Node';

use Scalar::Util     qw/reftype blessed/;
use List::Util       qw/min/;
use Params::Validate qw/validate HASHREF ARRAYREF SCALARREF/;
use namespace::autoclean;

use constant MAX_CHILDREN => 99;

sub MOUNT {
  my ($class, $mount_args) = @_;
  my @mount_point = %{$mount_args->{mount_point} || {}};
  $mount_args->{mount_point} = validate(@mount_point , {
    ref     => {type => HASHREF | ARRAYREF},
    exclude => {type => SCALARREF, isa => 'Regexp', optional => 1},
   });
}


sub _find_ref {
  my $self  = shift;
  my $path = $self->path || "" ;
  my $ref = $self->mount_point->{ref};
  
  foreach my $fragment (split m[/], $path) {
    my $reftype = reftype $ref;
    if ($reftype eq 'ARRAY') {
      $ref = $ref->[$fragment];
    }
    elsif ($reftype eq 'HASH') {
      $ref = $ref->{$fragment};
    }
    elsif ($reftype eq 'SCALAR' || $reftype eq 'REF') {
      $ref = $$ref;
    }
    else {
      die "no such path in data : '$path'";
    }
  }

  return $ref;
}


# inner hashrefs, arrayrefs and scalarrefs are considered 'children';
# other data are considered 'attributes'
sub _ref_is_child {
  my $ref = shift;
  my $reftype = reftype $ref || ''; 
  return $reftype =~ /^(?:HASH|ARRAY|SCALAR|REF)$/;
}


sub _children {
  my $self = shift;
  $self->_find_children_and_attrs;
  return $self->{children};
}

sub _attributes {
  my $self = shift;
  $self->_find_children_and_attrs;
  return $self->{attributes};
}

sub _find_children_and_attrs {
  my $self  = shift;
  my $ref = $self->_find_ref;
  my @children;
  my %attrs;

  my $reftype = reftype $ref;
  if ($reftype eq 'ARRAY') { 
    my @indices = 0 .. min($#$ref, MAX_CHILDREN);
    for my $i (@indices) {
      my $val = $ref->[$i];
      if (_ref_is_child($val)) {
        push @children, $i
      } else {
        $attrs{$i} = $val;
      }
    }
  }
  elsif ($reftype eq 'HASH')  {
    my @keys = keys %$ref;