in reply to Re^5: Pronoun Programming
in thread Pronoun Programming

I was mistaken. Should have paid a little more attention while reviewing extending and embedding perl. $hash in the following structure refers to the hashed value of the key, not the hashtable from which the HE came. Confusing terminology. 
# from Extending and Embedding Perl, section 4.5 
$HE = {
       NEXT => $HE_next,
       HEK => {
           HASH => $hash,
           LEN => length($key),
           KEY => $key,
          }
       VAL => $SV,
      };

[download]
My approach didn't try ordering, so the hash was actually based on a hashref, not an array.

I looked over the tie modules on CPAN (the first 20 pages before I got bored). None of them seemed to implement the functionality of what I envisioned as a solution: A tied hash that gives defered processing objects as results.

Being interested in something in inverse proportion to how useful that thing is, I expanded upon my ideas in the previous post. I think it caught feauture-use-itis though (2 tie classes and an overloaded inside-out class is a bit much complication for one module, IMHO).

I called it Tie::LazyHash, but it probably would be better named Tie::DeferredLookupRefHash. But that's just ugly sounding.

You can do a couple of things with the lookup values that invoke the actual lookup (which can be invoked multiple times for the same object): 
$elem->delete;
$elem->exists;
$$elem = $x;
print $elem; # overloaded for convenience
print $$elem;

[download]
use strict;
use warnings;
package Tie::LazyHash;
require Tie::Hash;
our @ISA = 'Tie::StdHash';

sub FETCH {
    Tie::LazyHash::Elem->new( @_ );
}

package Tie::LazyHash::Elem;
use Class::InsideOut qw(id private register);
use Scalar::Util 'weaken';

use overload 'bool' => '_get';
use overload '""' => '_get';
use overload '0+' => '_get';

private _hash => my %hash;
private _key => my %key;

sub _hash;
sub _key;

sub new {
    my ($proto, $hash, $key) = @_;
    my $class = ref $proto || $proto;
    my $self = bless \do{ my $bidding }, $class;
    tie $$self, 'Tie::LazyHash::Elem::Inner', id($self);
    weaken( $hash{id $self} = $hash );
    $key{id $self} = $key;
    register $self;
}

sub _get {
    my $self = shift;
    my $hash = _hash $self;
    return $hash->{_key $self};
}

sub _set {
    my ($self, $val) = @_;
    my $hash = _hash $self;
    $hash->{_key $self} = $val;
}

sub delete {
    my $self = shift;
    my $hash = _hash $self;
    delete $hash->{_key $self};
}

sub exists {
    my $self = shift;
    my $hash = _hash $self;
    exists $hash->{_key $self};
}

sub _hash {
    my $self = shift;
    if (ref $self) {
    $self = id $self;
    }
    return $hash{$self};
}

sub _key {
    my $self = shift;
    if (ref $self) {
    $self = id $self;
    }
    return $key{$self};
}

package Tie::LazyHash::Elem::Inner;

sub TIESCALAR {
    my ($class, $id) = @_;
    bless \$id, $class;
}

sub FETCH {
    my $self = shift;
    Tie::LazyHash::Elem::_get($$self);
}

sub STORE {
    my ($self, $val) = @_;
    Tie::LazyHash::Elem::_set($$self, $val);
}

1;
__END__

[download]

In Section Meditations