Tie::Hash::Method - Tied hash with specific methods overriden by callbacks

Tie-Hash-Method documentation Contained in the Tie-Hash-Method distribution.

Index

Code Index:

NAME

Top

Tie::Hash::Method - Tied hash with specific methods overriden by callbacks

VERSION

Top

Version 0.02

SYNOPSIS

Top

    tie my %hash, 'Tie::Hash::Method',
        FETCH => sub {
            exists $_[0]->base_hash->{$_[1]} ? $_[0]->base_hash->{$_[1]} : $_[1]
        };

DESCRIPTION

Top

Tie::Hash::Method provides a way to create a tied hash with specific overriden behaviour without having to create a new class to do it. A tied hash with no methods overriden is functionally equivalent to a normal hash.

Each method in a standard tie can be overriden by providing a callback to the tie call. So for instance if you wanted a tied hash that changed 'foo' into 'bar' on store you could say:

    tie my %hash, 'Tie::Hash::Method',
        STORE => sub {
            (my $v=pop)=~s/foo/bar/g if defined $_[2];
            return $_[0]->base_hash->{$_[1]}=$v;
        };

The callback is called with exactly the same arguments as the tie itself, in particular the tied object is always passed as the first argument.

The tied object is itself an array, which contains a second hash in the HASH slot (index 0) which is used to perform the default operations.

The callbacks available are in a hash keyed by name in the METHOD slot of the array (index 1).

If your code needs to store extra data in the object it should be stored in the PRIVATE slot of the object (index 2). No future release of this module will ever use or alter anything in that slot.

The arguments passed to the tie constructor will be seperated by the case of their keys. The ones with all capitals will be stored in the METHOD hash, and the rest will be stored in the PRIVATE hash.

CALLBACKS

STORE this, key, value

Store datum value into key for the tied hash this.

FETCH this, key

Retrieve the datum in key for the tied hash this.

FIRSTKEY this

Return the first key in the hash.

NEXTKEY this, lastkey

Return the next key in the hash.

EXISTS this, key

Verify that key exists with the tied hash this.

DELETE this, key

Delete the key key from the tied hash this.

CLEAR this

Clear all values from the tied hash this.

SCALAR this

Returns what evaluating the hash in scalar context yields.

Methods

base_hash

return or sets the underlying hash for this tie.

    $_[0]->base_hash->{$key}= $value;
h

alias for base_hash.

    $_[0]->h->{$key}= $value;
private_hash

Return or sets the hash of private data associated with this tie. This value will never be touched by any code in this class or its subclasses. It is purely object specific.

    $_[0]->p->{'something'}= 'cake!';
p

alias for private_hash

method_hash

return or sets the hash of methods that are overriden for this tie. Exactly why you would want to use this is a little beyond my imagination, but for those who can think of a reason here is a nice way to do it. :-)

methods

Returns a list of methods that are overriden for this tie. Why this would be useful escapes me, but here it is anyway for Completeness sake, whoever she is, but people are always coding for her so I might as well too.

Exportable Subs

The following subs are exportable on request:

hash_overload(PAIRS)

Returns a reference to a hash tied with the specified callbacks overriden. Just a short cut.

HASH

Constant subroutine equivalent to 0

METHOD

Constant subroutine equivalent to 1

PRIVATE

Constant subroutine equivalent to 2

AUTHOR

Top

Yves Orton, <yves at cpan.org>

BUGS

Top

Please report any bugs or feature requests to bug-tie-hash-method at rt.cpan.org, or through the web interface at http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Tie-Hash-Method. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.

SUPPORT

Top

You can find documentation for this module with the perldoc command.

    perldoc Tie::Hash::Method

You can also look for information at:

* RT: CPAN's request tracker

http://rt.cpan.org/NoAuth/Bugs.html?Dist=Tie-Hash-Method

* AnnoCPAN: Annotated CPAN documentation

http://annocpan.org/dist/Tie-Hash-Method

* CPAN Ratings

http://cpanratings.perl.org/d/Tie-Hash-Method

* Search CPAN

http://search.cpan.org/dist/Tie-Hash-Method

ACKNOWLEDGEMENTS

Top

COPYRIGHT & LICENSE

Top

Copyright 2008 Yves Orton, all rights reserved.

This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

Tie-Hash-Method documentation Contained in the Tie-Hash-Method distribution. 
package Tie::Hash::Method;
use strict;
use warnings;
use base 'Exporter';


our $VERSION= '0.02';
$VERSION= eval $VERSION;    # just in case we have a dev release
our @EXPORT_OK= qw(tie_hash_method HASH METHOD PRIVATE);

use constant HASH => 0;
use constant METHOD => 1;
use constant PRIVATE => 2;
use Data::Dumper;

# not overridable obviously.
sub TIEHASH {
    my $class= shift;
    my %opts= @_;
    #die Dumper 
    bless [
            {}, #HASH
            +{ map { $_ => $opts{$_} } grep {$_ eq uc($_) } keys %opts }, #METHOD
            +{ map { $_ => $opts{$_} } grep {$_ ne uc($_) } keys %opts }, #PRIVATE
           ], $class;
}

sub FETCH {
    if ( my $cb= $_[0][METHOD]->{FETCH} ) {
        return $cb->(@_);
    } else {
        return $_[0][HASH]->{ $_[1] };
    }
}

sub STORE {
    if ( my $cb= $_[0][METHOD]->{STORE} ) {
        return $cb->(@_);
    } else {
        return $_[0][HASH]->{ $_[1] }= $_[2];
    }
}

sub EXISTS {
    if ( my $cb= $_[0][METHOD]->{EXISTS} ) {
        return $cb->(@_);
    } else {
        exists $_[0][HASH]->{ $_[1] };
    }
}

sub DELETE {
    if ( my $cb= $_[0][METHOD]->{DELETE} ) {
        return $cb->(@_);
    } else {
        delete $_[0][HASH]->{ $_[1] };
    }
}


sub FIRSTKEY {
    if ( my $cb= $_[0][METHOD]->{FIRSTKEY} ) {
        return $cb->(@_);
    } else {
        # reset iterator
        my $val= scalar keys %{ $_[0][HASH] };
        return each %{ $_[0][HASH] };
    }
}

sub NEXTKEY {
    if ( my $cb= $_[0][METHOD]->{NEXTKEY} ) {
        return $cb->(@_);
    } else {
        return each %{ $_[0][HASH] };
    }
}


sub CLEAR {
    if ( my $cb= $_[0][METHOD]->{CLEAR} ) {
        return $cb->(@_);
    } else {
        return %{ $_[0][HASH] }= ();
    }
}

sub SCALAR {
    if ( my $cb= $_[0][METHOD]->{SCALAR} ) {
        return $cb->(@_);
    } else {
        return scalar %{ $_[0][HASH] };
    }
}

sub methods {
    return grep { $_ ne 'hash' } keys %{ $_[0][METHOD] };
}

sub method_hash : lvalue { $_[0][METHOD] }

sub base_hash : lvalue { $_[0][HASH] }
sub h         : lvalue { $_[0][HASH] }
sub private_hash : lvalue { $_[0][PRIVATE] }
sub p            : lvalue { $_[0][PRIVATE] }

sub hash_overload {
    tie my %hash, __PACKAGE__, @_;
    return \%hash;
}

1;    #make require happy

__END__