package Tree::Navigator::Node::Perl::Ref;
use 5.010;
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) {
    for (reftype $ref) {
      when ('ARRAY') {$ref = $ref->[$fragment]}
      when ('HASH')  {$ref = $ref->{$fragment}}
#      when ($_ eq 'SCALAR' && $fragment eq '$')
      when (['SCALAR', 'REF'])
                     {$ref = $$ref}
      default        {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;

  for (reftype $ref) {
    when ('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;
        }
      }
    }
    when ('HASH')  {
      my @keys = keys %$ref;
      my $regex = $self->mount_point->{exclude};
      @keys = grep {$_ !~ $regex} @keys if $regex;
      for my $k (@keys) {
        my $val = $ref->{$k};
        if (_ref_is_child($val)) {
          push @children, $k
        } 
        else {
          $attrs{$k} = $val;
        }
      }
      @children = sort {lc($a) cmp lc($b)} @children;
    }
    when (['SCALAR', 'REF'])  {
      @children = '$';
    }
  }
  my $blessed = blessed $ref;
  $attrs{isa} //= $blessed if $blessed;
  $self->{children}   = \@children;
  $self->{attributes} = \%attrs;
}


sub _child {
  my ($self, $child_path) = @_;
  my $class = ref $self;

  $DB::single = 1;

  # check if child exists
  my $ref = $self->_find_ref;
  my $child_ok;
  for (reftype $ref) {
    when ('ARRAY')           { $child_ok = exists $ref->[$child_path] }
    when ('HASH')            { $child_ok = exists $ref->{$child_path} }
    when (['SCALAR', 'REF']) { $child_ok = $child_path eq '$'         }
  }
  $child_ok or die "no child '$child_path' in " . $self->full_path;

  return $class->new(
    mount_point => $self->mount_point, 
    path        => $self->_join_path($self->path, $child_path),
   );
}





__PACKAGE__->meta->make_immutable;


1; # End of Tree::Navigator::Node::Perl::Ref


__END__


=head1 NAME

Tree::Navigator::Node::Perl::Ref - 

=cut