package Hash::DotPath;
$Hash::DotPath::VERSION = '0.002';
use Modern::Perl;
use Moose;
use namespace::autoclean;
use Kavorka 'method';
use Data::Printer alias => 'pdump';
use Hash::Merge;
use Util::Medley::Hash;

with
  'Util::Medley::Roles::Attributes::Hash',
  'Util::Medley::Roles::Attributes::List',
  'Util::Medley::Roles::Attributes::Logger',
  'Util::Medley::Roles::Attributes::String';

########################################################

=head1 NAME

Hash::DotPath - Class for manipulating hashes via dot path notation.

=head1 VERSION

version 0.002

=cut

########################################################

=head1 SYNOPSIS

  $dot = Hash::DotPath->new;
  $dot = Hash::DotPath->new(\%myhash);
  $dot = Hash::DotPath->new(\%myhash, delimiter => '~');

  $val = $dot->get('foo.bar');
  $val = $dot->get('biz.baz.0.zoo');  

  $dot->set('foo', 'bar');
  $dot->set('cats', []); 
  $dot->set('cats.0', 'calico');
  
  $dot->delete('foo');
  
  $newObj = $dot->merge({ biz => 'baz' });
  $newObj = $dot->merge({ biz => 'other' }, 'RIGHT'); 

  %hash = $dot->toHash;
  $href = $dot->toHashRef;  
  
=cut

=head1 ARRAYS

You interact with array elements slightly differently than hash ones.  

To access an element in an array, use the numeric index in the path.

  $dot = Hash::DotPath->new({foo => ['a', 'b', 'c']});
  $dot->get('foo.0');
  
To set a value on an existing array, the same notation works. 
  
  $dot->set('foo.3', 'd');

To add a NEW array to the tree, you must first instantiate it.  This is 
because hash keys can be numeric.  Since this is a hash class, the default
is to treat integers like hash keys unless a array already exists at the
given location. 

  $dot = Hash::DotPath->new({ foo => 'bar'});
  
  # WRONG - this is a non-existent array
  $dot->set('biz.0', 'baz'); 
  
  # CORRECT
  $dot->set('biz', []);
  $dot->set('biz.0', 'baz');
  
=cut

##############################################################################
# PUBLIC ATTRIBUTES
##############################################################################

=head1 ATTRIBUTES

=cut

# this attrib is used indirectly.  therefore, it isn't documented.
has init => (
	is      => 'rw',
	isa     => 'HashRef',
	default => sub { {} },
);

=head2 delimiter [Str] (optional)

The delimiter to use when analyzing a dot path.  

Default: "."

=cut

has delimiter => (
	is      => 'rw',
	isa     => 'Str',
	default => '.',
);

##############################################################################
# PRIVATE_ATTRIBUTES
##############################################################################

has _href => (
	is  => 'rw',
	isa => 'HashRef',
);

##############################################################################
# CONSTRUCTOR
##############################################################################

around BUILDARGS => sub {

	my $orig  = shift;
	my $class = shift;

	my $href;
	if (@_) {

		# TODO: is there a way to use the 'Hash' attrib instead?
		my $util = Util::Medley::Hash->new;
		if ( $util->isHash( $_[0] ) ) {
			$href = shift @_;
		}
	}

	my %args = @_;
	$args{init} = $href if $href;

	return $class->$orig(%args);
};

method BUILD {

	$self->_href( $self->init );
}

##############################################################################
# PUBLIC METHODS
##############################################################################

=head1 METHODS 

=head2 delete

Deletes an element at the specified path.  Returns the value of the element
that was deleted.

=over

=item usage:

 $val = $dot->delete('foo.bar');
 $val = $dot->delete('biz.0.baz');

=item args:

=over

=item path [Str]

Dot-path of the element you wish to delete.

=back

=back

=cut

method delete (Str $path!) {

	my $ptr     = $self->_href;
	my @keys    = $self->_splitKey($path);
	my $lastKey = pop @keys;
	
	if (@keys) {
		$ptr = $self->_get( $self->_href, \@keys );
	}
    
    my $val;
    if ( $self->List->isArray($ptr) ) {
        if ( $self->String->isInt($lastKey) ) {
        	$val = splice(@$ptr, $lastKey, 1);
        }
        else {
            confess "can't reference array index at $path by $lastKey";
        }
    }
    else {
        $val = $ptr->{$lastKey} ;
        delete $ptr->{$lastKey};
    }

	return $val; # --> Any
}

=head2 get

Gets an element at the specified path. Returns 'Any'.

=over

=item usage:

 $val = $dot->get('foo.bar');
 $val = $dot->get('biz.0.baz');

=item args:

=over

=item path [Str]

Dot-path of the element you wish to get.

=back

=back

=cut

method get (Str $path!) {

	my @keys = $self->_splitKey($path);

	return $self->_get( $self->_href, \@keys );    # --> Any
}

=head2 exists

Determines if an element exists at the given path.  Returns 'Bool'.

=over

=item usage:

 $bool = $dot->exists('foo.bar');
 $bool = $dot->exists('biz.0.baz');

=item args:

=over

=item path [Str]

Dot-path of the element you wish to get.

=back

=back

=cut

method exists (Str $path!) {

	my @keys = $self->_splitKey($path);

	return $self->_exists( $self->_href, \@keys );    # --> Bool
}

=head2 merge

Merges the provided dot-path object or hashref with the object.  You indicate 
which hash has precedence by providing the 'overwrite' arg.

=over

=item usage:

 $newDot = $dot->merge({foo => 'bar'}, [0|1]);

 $dot2 = Hash::DotPath->new(biz => 'baz');
 $newDot = $dot->merge($dot2, [0|1]);
  
=item args:

=over

=item merge [HashRef|Hash::DotPath]

Hashref you wish to merge into the dot-path object.

=item overwrite [Bool] (optional)

Indicates which hash has precedence over the other.  A true value means
the element passed in will overwrite any pre-existing elements.  A false value
will preserve existing elements and just merge the new ones in.

Default: 1

=back

=back

=cut

method merge (Object|HashRef $merge!,
              Bool           $overwrite = 1) {

    my $href; 
	if ( $self->Hash->isHash($merge) ) {
		$href = $merge;
	}
	else {
		my $ref = ref($merge);
		if ($ref eq 'Hash::DotPath') {
	       $href = $merge->toHashRef;
		}
		else {
		  confess "can't use $ref as a hashref";	
		}
	}

    my %args = (left => $self->_href, right => $href);
    $args{precedent} = 'RIGHT' if $overwrite;
    my $merged = $self->Hash->merge(%args);
     
	return __PACKAGE__->new( $merged, delimiter => $self->delimiter );
}

=head2 set

Sets an element at the specified path.  Returns the value that was passed in.

=over

=item usage:

 $val = $dot->set('foo.bar', 'abc');
 $val = $dot->set('biz.0.baz', 'def');

=item args:

=over

=item path [Str]

Dot-path of the element you wish to set.

=item value [Any]

Value you wish to set at the given path.

=back

=back

=cut

method set (Str $path!,
            Any $value!) {

	my @keys       = $self->_splitKey($path);
	my $lastKey    = pop @keys;
	my $parentPath = join $self->delimiter, @keys;

	my $ptr = $self->_buildPath( $self->_href, \@keys );
	if ( $self->List->isArray($ptr) ) {
		if ( $self->String->isInt($lastKey) ) {
			$ptr->[$lastKey] = $value;
		}
		else {
			confess "can't reference array index at $parentPath by $lastKey";
		}
	}
	else {
		$ptr->{$lastKey} = $value;
	}

	return $value;    # --> Any
}

=head2 toHash

Returns a hash version of the object.

=over

=item usage:

 %hash = $dot->toHash;

=back

=cut

method toHash {

	return %{ $self->_href };
}

=head2 toHashRef

Returns a hashref version of the object.

=over

=item usage:

 $href = $dot->toHashRef;

=back

=cut

method toHashRef {

	return $self->_href;
}

##############################################################################
# PRIVATE METHODS
##############################################################################

method _splitKey (Str $key) {

	my $regex = sprintf '\%s', $self->delimiter;
	my @split = split( /$regex/, $key );

	return @split;
}

method _exists (HashRef  $ptr,
                ArrayRef $keys) {

	my @remKeys = @$keys;           # make a copy
	my $currKey = shift @remKeys;

	if ( $self->List->isArray($ptr) ) {

		if ( $self->String->isInt($currKey) ) {
			if (@remKeys) {
				return $self->_get( $ptr->[$currKey], \@remKeys );
			}
			elsif ( exists $ptr->[$currKey] ) {
				return 1;
			}
		}
	}
	else {

		if ( exists $ptr->{$currKey} ) {
			if (@remKeys) {
				return $self->_get( $ptr->{$currKey}, \@remKeys );
			}
			else {
				return 1;
			}
		}
	}

	return 0;
}

method _get (HashRef|ArrayRef  $ptr,
             ArrayRef          $keys) {

	my @remKeys = @$keys;           # make a copy
	my $currKey = shift @remKeys;

	if ( $self->List->isArray($ptr) ) {

		if ( $self->String->isInt($currKey) ) {
			if (@remKeys) {
				return $self->_get( $ptr->[$currKey], \@remKeys );
			}
			else {
				return $ptr->[$currKey];
			}
		}
	}
	else {

		if ( exists $ptr->{$currKey} ) {
			if (@remKeys) {
				return $self->_get( $ptr->{$currKey}, \@remKeys );
			}
			else {
				return $ptr->{$currKey};
			}
		}
	}

	return;    # not found (undef)
}

method _buildPath (HashRef|ArrayRef $ptr,
                   ArrayRef         $keys) {

	my @remKeys = @$keys;

	if (@remKeys) {
		my $currKey = shift @remKeys;

		if ( $self->List->isArray($ptr) ) {
			if ( $self->String->isInt($currKey) ) {
				if ( !exists $ptr->[$currKey] ) {
					$ptr->[$currKey] = {};
				}

				return $self->_buildPath( $ptr->[$currKey], \@remKeys );
			}
			else {
				confess "can't reference an array index by $currKey";
			}
		}
		elsif ( $self->Hash->isHash($ptr) ) {
			if ( !exists $ptr->{$currKey} ) {
				$ptr->{$currKey} = {};
			}

			return $self->_buildPath( $ptr->{$currKey}, \@remKeys );
		}
	}

	return $ptr;
}

__PACKAGE__->meta->make_immutable;

1;
