Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW

Tieing and Blessing

by McA (Priest)
on Oct 05, 2012 at 09:09 UTC ( #997413=perlquestion: print w/replies, xml ) Need Help??
McA has asked for the wisdom of the Perl Monks concerning the following question:

Hi all,

once upon a time there was a hash introduced in our codebase. And the usage of that hash which was transferred to almost any function grew and grew. The usage of several keys cemented the "API" of that hash. After years I'm not happy with that because an object would have been the better approach (e.g. for the possibility to garantee the consistence of severals keys/value pairs). Now my question:

Is it possible to have somthing like Dr.-Jekyll-and-Mr. Hyde-object: A tied hash which is also blessed to be an object? Code would look like that:

my $obj = DrJekyll->new; $obj->{somekey} = 'something'; $obj->transform();

Everyone knowing the standard way of representing objects as blessed hash refs will now say: Yes, of course. With a simple blessed hash you can do that. But I want to have control over the access to a key. That means as soon as someone codes $obj->{somekey} = 'something'; I want a hook. That would be possible with tied hashes.

I hope this is an interesting question.

Best regards

Replies are listed 'Best First'.
Re: Tieing ans Blessing
by tobyink (Abbot) on Oct 05, 2012 at 09:13 UTC

    Tied hashes are backed by objects. If you have a tied hash %foo then you can access the underlying object using tied(%foo). You can call methods on it like tied(%foo)->my_method(42).

    If you have a tied hash, yes, it's also possible to bless a reference to that hash into a particular class. This may even be a different class to the one used to implement the tied behaviour.

    And here's a quick example to show a hash tied to one class and blessed into another...

    use v5.14; use Test::More; package MyClass 1.0 { sub new { my ($class, $hashref) = @_; bless $hashref => $class; } sub quux { return 'quuux'; } } use Hash::DefaultValue; # it's on CPAN tie my %hash, 'Hash::DefaultValue', 42; ok( $hash{hello} == 42, 'tie works properly', ); my $object = MyClass->new(\%hash); ok( $object->{world} == 42, 'tie works properly, even when blessed', ); ok( $object->isa('MyClass') && !$object->isa('Hash::DefaultValue'), 'blessed into the proper class' ); ok( tied(%$object)->isa('Hash::DefaultValue') && !tied(%$object)->isa( +'MyClass'), 'tied to the proper class' ); ok( $object->quux eq 'quuux', 'method calls on object work', ); done_testing();
    perl -E'sub Monkey::do{say$_,for@_,do{($monkey=[caller(0)]->[3])=~s{::}{ }and$monkey}}"Monkey say"->Monkey::do'
Re: Tieing and Blessing
by McA (Priest) on Oct 05, 2012 at 09:34 UTC

    Hi all

    As so often. As soon as I wrote my question in a structured way I had the idea just to try what tobyink answered meanwhile. Thank you for that, tobyink.

    I just wanted to present my little code snippet:

    use strict; use warnings; use Data::Dumper; use Tie::Hash (); package MyHash; use base 'Tie::StdHash'; sub TIEHASH { my $storage = bless {}, shift; warn "New hash created, stored in $storage.\n"; return $storage; } sub STORE { my $class = shift; warn "In STORE\n"; return $class->SUPER::STORE(@_); } package MyObj; sub new { my $class = shift; my %h; tie %h, 'MyHash'; return bless \%h, $class; } sub do_something { print "In method do_something\n"; } package main; my $g = MyObj->new(); $g->do_something(); $g->{'key'} = 'value'; print Dumper($g), "\n";

    UPDATE: As expected, tobyink presented a much fancier code example showing the right way to write test code. A ++ for that.

    Best regards

Re: Tieing and Blessing
by anazawa (Scribe) on Oct 05, 2012 at 13:38 UTC
      I have the question is that firstly I didn't use DBM file yet and can't understand tie from its manual since lack the experience of dbm file. I think blessing is tieing a reference to a package actually.
        Though I don't understand how tie() works, too, I know how to use it ;) The following class represents a hash whose keys are case-insensitive:
        package Insensitive::Hash; use strict; use warnings; sub new { my ( $class, @args ) = @_; my %self; while ( my ($key, $value) = splice @args, 0, 2 ) { $self{ lc $key } = $value; } bless \%self, $class; } sub get { my ( $self, $key ) = @_; $self->{ lc $key }; } sub set { my ( $self, $key, $value ) = @_; $self->{ lc $key } = $value; } 1;
        How can we use Insensitive::Hash?
        use strict; use warnings; use Insensitive::Hash; my $hash = Insensitive::Hash->new( 'Content-Type' => 'text/plain', ); # $key is case-insensitive $hash->get( 'Content-Type' ); # => "text/plain" $hash->get( 'content-type' ); # => "text/plain" $hash->set( 'CONTENT-TYPE' => 'text/html' );
        To implement tie() interface, rename the method names of Insensitive::Hash as follows:
        package Insensitive::Hash; use strict; use warnings; # new -> TIEHASH # get -> FETCH # set -> STORE sub TIEHASH { my ( $class, @args ) = @_; my %self; while ( my ($key, $value) = splice @args, 0, 2 ) { $self{ lc $key } = $value; } bless \%self, $class; } sub FETCH { my ( $self, $key ) = @_; $self->{ lc $key }; } sub STORE { my ( $self, $key, $value ) = @_; $self->{ lc $key } = $value; } 1;
        How tie() works?
        use strict; use warnings; use Insensitive::Hash; tie my %hash, 'Insensitive::Hash', ( 'Content-Type' => 'text/plain' ); # <=> my $hash = Insensitive::Hash->TIEHASH( ... ) $hash{'Content-Type'}; # <=> $hash->FETCH( 'Content-Type' ); $hash{'content-type'}; # <=> $hash->FETCH( 'content-type' ); $hash{'CONTENT-TYPE'} = 'text/html'; # <=> $hash->STORE( 'CONTENT-TYPE' => 'text/html' );
        Insensitive::Hash was taken from "Object-oriented Perl" written by D. Conway. See also HTTP::Headers (field names are case-insensitive).

Log In?

What's my password?
Create A New User
Node Status?
node history
Node Type: perlquestion [id://997413]
Approved by tobyink
Front-paged by tobyink
and all is quiet...

How do I use this? | Other CB clients
Other Users?
Others avoiding work at the Monastery: (3)
As of 2018-06-19 07:04 GMT
Find Nodes?
    Voting Booth?
    Should cpanminus be part of the standard Perl release?

    Results (111 votes). Check out past polls.