view release on metacpan or  search on metacpan

lib/Data/XHash.pm  view on Meta::CPAN

package Data::XHash;

use 5.006;
use strict;
use warnings;
use base qw/Exporter/;
use subs qw/clear delete exists fetch first_key next_key
  scalar store xhash xhashref/;
use Carp;
use Scalar::Util qw/blessed/;

our @EXPORT_OK = (qw/&xhash &xhashref &xh &xhn &xhr &xhrn/);

# XHash values are stored internally using a ring doubly-linked with
# unweakened references:
# {hash}{$key} => [$previous_link, $next_link, $value, $key]

=head1 NAME

Data::XHash - Extended, ordered hash (commonly known as an associative array
or map) with key-path traversal and automatic index keys

=head1 VERSION

Version 0.09

=cut

our $VERSION = '0.09';

=head1 SYNOPSIS

    use Data::XHash;
    use Data::XHash qw/xhash xhashref/;
    use Data::XHash qw/xh xhn xhr xhrn/;

    $tiedhref = Data::XHash->new(); # A blessed and tied hashref
    # Note: Don't call "tie" yourself!

    # Exports are shortcuts to call Data::XHash->new()->push()
    # or Data::XHash->new()->pushref() for you.
    $tiedhref = xh('auto-indexed', { key => 'value' });
    $tiedhref = xhash('auto-indexed', { key => 'value' });
    $tiedhref = xhashref([ 'auto-indexed', { key => 'value' } ]);
    $tiedhref = xhn('hello', { root => { branch =>
      [ { leaf => 'value' }, 'world' ] } }); # (nested)
    $tiedhref = xhr([ 'auto-indexed', { key => 'value' } ]);
    $tiedhref = xhrn([ 'hello', { root => { branch =>
      [ { leaf => 'value' }, 'world' ] } } ]); # (nested)

    # Note: $xhash means you can use either $tiedhref or the
    # underlying object at tied(%$tiedhref)

    ## Hash-like operations

    # Getting keys or paths
    $value = $tiedhref->{$key};
    $value = $tiedhref->{\@path};
    $value = $xhash->fetch($key);
    $value = $xhash->fetch(\@path);

    # Auto-vivify a Data::XHash at the end of the path
    $tiedhref2 = $tiedhref1->{ [ @path, {} ] };
    $tiedhref->{ [ @path, {} ] }->$some_xh_method(...);
    $tiedhref = $xhash->fetch( [ @path, {} ] );
    $xhash->fetch( [ @path, {} ] )->$some_xh_method(...);

    # Setting keys or paths
    $tiedhref->{$key} = $value;
    $tiedhref->{\@path} = $value;
    $xhash->store($key, $value, %options);
    $xhash->store(\@path, $value, %options);

    # Setting the next auto-index key
    $tiedhref->{[]} = $value; # Recommended syntax

lib/Data/XHash.pm  view on Meta::CPAN

	$path->{container}->store($path->{key}, $value, %options);
    } else {
	# Store locally.
	my $self = tied(%$this) || $this;

	# Get the next index for undef or [].
	$key = defined($self->{max_index})? ($self->{max_index} + 1):
	  $self->next_index() if !defined($key) || $array_key;

	if ($options{nested}) {
	    # Convert nested native structures to XHashes.
	    if (ref($value) eq 'HASH') {
		$value = $self->new()->pushref([$value], %options);
	    } elsif (ref($value) eq 'ARRAY') {
		$value = $self->new()->pushref($value, %options);
	    }
	}

	if (my $entry = $self->{hash}{$key}) {
	    # Replace the value for an existing key.
	    $entry->[2] = $value;
	} else {
	    my $link;
	    if (my $tail = $self->{tail}) {
		my $head = $tail->[1];
		# Link an additional element into a non-empty ring.
		$link = $self->{hash}{$key} =
		  $tail->[1] = $head->[0] = [$tail, $head, $value, $key];
	    } else {
		# Start a new key ring.
		$link = $self->{hash}{$key} = [undef, undef, $value, $key];
		$link->[0] = $link->[1] = $link;
	    }
	    $self->{tail} = $link;
	    $self->{max_index} = $key
	      if ($key =~ /^\d+$/ && (defined($self->{max_index})?
	      ($key > $self->{max_index}): ($key >= $self->next_index())));
	}
    }

    return $this;
}

*store = \&STORE;

=head2 %$tiedref = ()

=head2 $xhash->clear( )

These clear the XHash.

Clear returns the XHash tiedref or object (whichever was used).

=cut

sub CLEAR {
    my ($this) = @_;
    my $self = tied(%$this) || $this;

    if ($self->{hash}) {
	# Blow away unweakened refs before tossing the hash.
	@$_ = () foreach (values %{$self->{hash}});
    }
    $self->{hash} = {};
    delete $self->{tail};
    delete $self->{iter};
    $self->{max_index} = -1;
    return $this;
}

*clear = \&CLEAR;

=head2 delete $tiedref->{$key} # or \@path

=head2 $xhash->delete($key) # or \@path

=head2 $xhash->delete(\%options?, @keys)

These remove the element with the specified key and return its value. They
quietly return C<undef> if the key does not exist.

The method call can also delete (and return) multiple local (not path) keys
at once.

Options:

=over

=item to => $destination

If C<$destination> is an arrayref, hashref, or XHash, each deleted
C<< { $key => $value } >> is added to it and the destination is returned
instead of the most recently deleted value.

=back

=cut

sub DELETE : method {
    my $self = shift;
    my %options = ref($_[0]) eq 'HASH'? %{+shift}: ();
    my $key = $_[0];

    if (ref($key) eq 'ARRAY' && @$key) {
	# Delete across the path.
	my $path = $self->traverse($key, op => 'delete');

	return $path->{container}?
	  $path->{container}->delete($path->{key}): undef;
    }

    # Delete locally.
    my $to = $options{to};
    my $return;
    $self = tied(%$self) || $self;

    while (@_) {
	$key = shift;

        if (my $link = $self->{hash}{$key}) {
	    if (ref($to) eq 'ARRAY') {