Beefy Boxes and Bandwidth Generously Provided by pair Networks
Just another Perl shrine
 
PerlMonks  

Inheritance in Hash

by Eyck (Priest)
on Apr 20, 2005 at 12:42 UTC ( [id://449569]=perlquestion: print w/replies, xml ) Need Help??

Eyck has asked for the wisdom of the Perl Monks concerning the following question:

I'm trying to create a datastructure that hold inheritance-like properties, ie:
$mylovelydata= { 'Colour'=>'blue', 'Entries'=> { 'Flowers'=> { 'Dahlia'=>{'Smell'=>'nice',}, 'Rose'=>{'Colour'=>'red'}, } }, };
and now I would like my code to know, that 'Dahlia' is supposed to be blue, while as we all know 'Roses Are Red'.

While code like this:

my $colour; if defined($data->{'Entries'}->{'Flowers'}->$flower->{'Colour'}) {$colour=$data->{'Entries'}->{'Flowers'}->$flower->{'Colour'};}; if defined($data->{'Entries'}->{'Colour'}) {$colour=$data->{'Entries'}->{'Colour'};}; if defined($data->{'Colour'}) {$colour=$data->{'Colour'};};
would probably work OK, this isn't something I would like to maintain later...

Since this is a recurring problem, how do Monks solve that?

Replies are listed 'Best First'.
Re: Inheritance in Hash
by Transient (Hermit) on Apr 20, 2005 at 13:11 UTC
Re: Inheritance in Hash
by tlm (Prior) on Apr 20, 2005 at 13:32 UTC

    Take a look at Class::Prototyped. Caveat, I have never actually used this module, but it seems like it may be applicable to your question.

    the lowliest monk

Re: Inheritance in Hash
by merlyn (Sage) on Apr 20, 2005 at 20:59 UTC
Re: Inheritance in Hash
by mp (Deacon) on Apr 20, 2005 at 15:28 UTC
Re: Inheritance in Hash
by samtregar (Abbot) on Apr 20, 2005 at 18:13 UTC
    I wouldn't use a hash for this application, I'd use objects. I needed something like this for XML::Validator::Schema's simple type library. In XML Schema, simple types are defined as a tree where each child node adds restrictions and inherits the behavior of its parent. I modeled this tree as a hash of objects which track their parent through composition.

    For example, to instantiate the entry for nonPositiveInteger I call the derivation constructor (dervive()) on the integer object and then add a new restriction (that the value can't be greater than 0):

    $BUILTIN{nonPositiveInteger} = $BUILTIN{integer}->derive(name => 'no +nPositiveInteger'); $BUILTIN{nonPositiveInteger}->restrict( maxInclusive => 0 );

    You can see this code here: XML::Validator::Schema::SimpleType. I've found this to be an easy to maintain system which has grown smoothly as new types have been added by myself and others. It also makes supporting custom simple-types created by schemas easy.

    -sam

Re: Inheritance in Hash
by shotgunefx (Parson) on Apr 20, 2005 at 18:43 UTC
    You might find this useful. Re: AI in Perl - proof of concept

    It does most of what your asking IIRC. Keep in mind, I wrote this as a quick proof of concept 3 years ago.


    -Lee

    "To be civilized is to deny one's nature."
Re: Inheritance in Hash
by crashtest (Curate) on Apr 20, 2005 at 18:48 UTC
    If your data is always going to be a HoHoH..., I would write a little function that plucks your attributes out for you, and saves you the tedious typing in your code. The function would accept a path to the value you're seeking in dotted-path notation. Something like this:
    use strict; use warnings; # Recursive function to traverse a HoH according to a # "dotted" properties path: sub getprop{ my ($properties, $path) = @_; return $properties unless $path; my ($key, @remaining_path) = split /\./, $path; return getprop($properties->{$key}, join('.' => @remaining_path)); } # Define our properties: my $mylovelydata= { 'Colour'=>'blue', 'Entries'=> { 'Flowers'=> { 'Dahlia'=>{'Smell'=>'nice',}, 'Rose'=>{'Colour'=>'red'}, } }, }; # Test the function for my $flower qw/Dahlia Rose/{ my $colour = getprop($mylovelydata, "Entries.Flowers.$flower.Colou +r"); $colour = getprop($mylovelydata, "Entries.Colour") unless defined( +$colour); $colour = getprop($mylovelydata, "Colour") unless defined($colour) +; print "A ${flower}'s color is: $colour\n"; } __END__ A Dahlia's color is: blue A Rose's color is: red
    This allows for less typing, but more importantly, I think, it just looks a lot cleaner. You could even expand the getprop function to handle accessing arrays stashed in your properties data structure with something like Some.Array[1].Property.

    Update:: This idea is actually stolen from JavaScript. It allows you to "walk" a data structure in a similar fashion. For instance, to access a hidden field named "somedata" in the second form of a web page, you'd write something like var value = document.forms[1].somedata.
Re: Inheritance in Hash
by ikegami (Patriarch) on Apr 20, 2005 at 22:32 UTC

    How do you like the folowing?

    use strict; use warnings; sub get { my $ref = shift(@_); my $key = shift(@_); my $val; for (;;) { last unless UNIVERSAL::isa($ref, 'HASH'); $val = $ref->{$key} if exists $ref->{$key}; last unless @_; my $branch = shift(@_); $ref = $ref->{$branch}; } return $val; } my $data = { Colour => 'blue', Entries => { Flowers => { Dahlia => { Smell => 'nice' }, Rose => { Colour => 'red' }, }, }, }; print get($data, 'Colour', qw( Entries Flowers Rose )), $/, # red get($data, 'Colour', qw( Entries Flowers Dahlia )), $/; # blue

    If $data was blessed to the package which contained get, you could improve the syntax a bit:

    print $data->get('Colour', qw( Entries Flowers Rose )), $/, # red $data->get('Colour', qw( Entries Flowers Dahlia )), $/; # blue

      Here's a version with a better syntax:

      # Using "tie". use Tie::Hash::Inheriting (); { tie(my %data, 'Tie::Hash::Inheriting'); %data = ( Colour => 'blue', Entries => { Flowers => { Dahlia => { Smell => 'nice' }, Rose => { Colour => 'red' }, }, }, ); print $data{'Entries'}{'Flowers'}{'Rose' }{'Colour'}, $/, # red $data{'Entries'}{'Flowers'}{'Dahlia'}{'Colour'}, $/; # blue untie(%data); # Free mem. %data going out of scope is not enough. }

      or

      # Using objects. use Hash::Inherting (); { my $data = Hash::Inheriting->new(); %$data = ( Colour => 'blue', Entries => { Flowers => { Dahlia => { Smell => 'nice' }, Rose => { Colour => 'red' }, }, }, ); print $data->{'Entries'}{'Flowers'}{'Rose' }{'Colour'}, $/, # red $data->{'Entries'}{'Flowers'}{'Dahlia'}{'Colour'}, $/; # blue }

      Tie/Hash/Inheriting.pm

      Hash/Inheriting.pm

        bah, there are still memory leaks, I think.

        $data{'moo'}{'test'} = { a => 1, b => 2 }; # The following line doesn't free the tied hash # containing a => 1, b => 2 until %data is untied. $data{'moo'}{'test'} = 'foo';
Re: Inheritance in Hash
by Miguel (Friar) on Apr 21, 2005 at 02:59 UTC
    And another way could be something like:
    #!/usr/bin/perl -w use strict; my $data = { Colour => 'blue', Entries => { Flowers => { Dahlia => { Smell => 'nice' }, Rose => { Colour => 'red' } } } }; my $ref_flowers = $data->{Entries}->{Flowers}; my $colour = sub{my $fl=shift; $ref_flowers->{$flw}->{Colour}}; my $smell = sub{my $fl=shift; $ref_flowers->{$flw}->{Smell}}; print "Rose's color is ",$colour->('Rose'),".\n" if $colour->('Rose'); print "Dahlia smells ",$smell->('Dahlia'),".\n" if $smell->('Dahlia'); __OUTPUT__ Rose's color is red. Dahlia smells nice.
    Miguel
      print "Dahlia's color is ",$colour->('Dahlia'),".\n"
      doesn't print "blue", as requested.
        You're right.
        #!/usr/bin/perl -w use strict; my $data = { Colour => 'blue', Entries => { Flowers => { Dahlia => { Smell => 'nice' }, Rose => { Colour => 'red' } } } }; my $ref_flowers = $data->{Entries}->{Flowers}; my $colour = sub { my $flw=shift; $ref_flowers->{$flw}->{Colour} || $data->{Colour} }; print "Rose's color is ",$colour->('Rose'),"\n"; print "Dahlia's color is ", $colour->('Dahlia'),"\n"; __output__ Rose's color is Red. Dahlia's color is Blue.
        Miguel

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://449569]
Approved by pelagic
Front-paged by bart
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others chilling in the Monastery: (4)
As of 2024-03-29 14:44 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found