Three level structure for handling objects -- Hash of Hash of Array of Objects (5 questions)
[email protected] (Dean)
| Newsgroups | perl.moose |
|---|---|
| Message-ID | <[email protected]> |
Hello Moose Team et al,
I'm looking for moose documentation, example code or missing key concepts
to handle a hash of hash of array of objects. See 2 sample files:
HrArObj.pl and Farm.pm
Questions are noted by XXX_question_
__--__--__ File HrArObj.pl __--__--__
#!/usr/bin/env perl -l
use lib qw( /var/tmp/pbuild/lib/perl5 /Users/dcb/dvlp/lib);
use Moose;
use Moose::Util::TypeConstraints;
use Declare::Constraints::Simple -All;
use Farm;
{
package Animal;
use Moose;
use Moose::Util::TypeConstraints;
## ToDo: write tests about Legs
##
subtype 'Legs'
=> as 'Int'
=> where { length $_ > 0 } ##
=> message { "$_ Legs: 0 - 4 "};
has 'name' => (is => 'rw');
has 'color' => (is => 'rw', default => sub { shift->default_color});
## requires 'default_color';
has 'pedal' => (is => 'rw', isa => 'Legs');
sub speak {
my $self = shift;
print $self->name, " goes ", $self->sound, "\n";
}
}
{
package Domesticated;
use Moose::Role;
has 'is_friendly' => (
is => 'rw',
isa => 'Bool',
);
sub wild {
my $self = shift;
print "Wild Spirits\n";
$self->is_friendly(1);
};
}
{
package Horse;
use Moose;
extends 'Animal'; ## inherit
with 'Domesticated'; ## role
use vars qw($VERSION);
use version; our $VERSION = qv(1.0611); # $MyPackage::VERSION = 1.061;
sub default_color { return 'brown' }
sub sound { return 'neigh'}
}
sub horse {
my $nelly = Horse->new( name => 'nell');
dbg " blessed horse " if Scalar::Util::blessed ($nelly); # Carp::confess
$nelly->sound;
$nelly->speak;
return $nelly;
}
# sub main {
my $farm = Farm->new( farmers_name => 'joe', name => 'in_the_Dell' );
my $talking_horse = Horse->new(name => 'Mr. Ed', color => 'grey');
my $horsey = Horse->new( name => 'shore', color => 'white' );
my $hor = Horse->new( name => 'hor', color => 'black' );
$farm->add_animal( $talking_horse ); # Add a few horses to the
$farm->add_animal( $horsey ); # livestock array.
$farm->add_animal( $hor );
$farm->addem( $horsey, ref $horsey, $horsey ); # Confusing!!!
# How do you insert into a hash of hashes of array of Animals?
$farm->partition( $horsey, ref $horsey, $horsey);
# Insert a new key/value pair into the horse into a hash.
$farm->corridor( $hor, ref $hor, $hor );
# Additional attempt to insert a hash of hashes of array of objects.
print " animal count: ", $farm->num_animals();
print "Horse bins_HrAn contents: ", $farm->corl(); # XXX_question_1
# How do you get the contents of
# the hash?
# It seems like get should
# retrieve the information.
my %crops = ( 'corn', 2,
'nuts', 6,
'olives', 8,
'wheat', 3);
my ( $crop, $acres);
while( ( $crop, $acres) = each %crops) { ## Farmer diversifies
$farm->setter( $crop => $acres ); ## by planting crops.
dbg "crop: $crop, acres: $acres ";
}
use Data::Dumper;
$Data::Dumper::Varname = 'farm'; #'Farm:_in_the_Dell';
dbg $farm->dump;
print "Ending program";
____----____----____ End of File HrArObj.pl ____----____----
____----____---- File Farm.pm ____----____----
package Farm;
use Moose;
use Moose::Util::TypeConstraints; # for types
use Test::Exception;
use Declare::Constraints::Simple -All; ## complaining!!!
##use Moose::Meta::Attribute::Native::MethodProvider::Hash;
# use Moose::Manual::MethodModifiers
use ldcb;
use lib qw( /var/tmp/pbuild/lib/perl5);
our ($VERSION) = '1.12.34.45';
## t/200_examples/004_example_w_DCS.t
##
has 'name' => (is => 'rw', isa => 'Str');
has 'farmers_name' => (is => 'rw', isa => 'Str');
my $ArrayRefAnimals = subtype 'ArrayRefAnimals',
as 'ArrayRef[Animal]';
my $HashRefArray = subtype 'HashRefArray',
as 'HashRef[ArrayRef]';
my $HoAoAnmls = subtype 'HoAoAnmls',
as 'HashRefArray[ArrayRefAnimals]'; ## The type we want
## to use.
##
# Hash of animals where the key is the animal name
# and the value is the animal object.
#
#
has 'yard' => (
traits => ['Hash'], ## trait: a role that applies to an
isa => 'HashRef[Animal]',
is => 'rw',
default => sub { {} },
handles => {
partition => [ set => ( 'previous') ], # XXX_question_2
# sub { if( ! exists($k) {
# [ set( $k, $v ]
#}
# }
## How do you insert a new key/value pair
## without overwriting the previous hash?
## The method partition should insert the new
## key/value of the new animal name (key) and
## value (animal object).
##
## This is coming from a place of ignorance --
## The symbol 'previous' from above is
## a placeholder for the set action.
## I'm not sure how to access the hash
## in order to insert the new k/v pair.
# partition => accessor( 'previous', 'bar') , # 'accessor'
corral => [ get => ('murky')], # 'get_bins'
},
);
before 'partition' => sub {
my ($self0,$self1,$self2,$self3) = @_; # Farm, object, type, name_key
if( keys(%{$self1}) ) {
print "type $self2 is in $self0 keys _exist_ in $self2 __--__ $self1 ";
print " ";
}
else {
print $self1, " is not defined";
}
};
after 'partition' => sub {
my ($slf0, $slf1, $slf2, $slf3) = @_;
if( keys(%{$slf0}) ) {
print "type $slf2 has keys ", scalar keys(%{$slf0});
}
};
##
# This data structure from the inside out is:
# Array of animal_objects in an animal type hash in a category hash.
#
# e.g $farm->animal_bins->Horse->[]
#
has 'animal_bins' => (
traits => ['Hash'], ## trait: a role that applies to an
isa => 'HashRef[Animal]',
# isa => 'HashRefArray[ArrayRefAnimals]', # XXX_question_3
## How can I make this type work with
## the animal_bins attribute?
## Is this the correct type for the
## task I want to perform?
## This type should be used instead of
## the type HashRef[Animal]
is => 'rw',
default => sub { { } },
## XXX_question_4
## If we consider pushing a new horse
## object:
## Method addem should push the horse object
## onto the array which is in the horse
## hash underneath the animal_bins hash.
##
## How can I do this?
##
## $farm->animal_bins->Horse->[]
handles => { ##
addem => ['set' => [push => sub { { $_[0] => [ $_[1] ] } }]],
corl => [ get => ('SeaHorse')], # This is an attempt to
corridor => ( [ set => 'Bullwinkle']), # get something working.
},
);
before 'addem' => sub { print " ..xxXX Inside before for animal_bins XXxx.."; };
after 'addem' => sub { print "\n XXxx.. AFTER animal_bins ..xxXX "; };
around 'addem' => sub {
my $orig = shift; # accessor function ref
my $self = shift; # object
my $key = shift; # key
my @args = @_; # value(s)
my $retval = $self->$orig($key, @args) if @args; # use it
$retval ||= []; # if undefined, then create a blank arrayref
print " orig: $orig \t self: $self \t key: $key \t args: ", @args;
print " XX__XX retval: $retval";
print " args size: ", scalar @args;
printf(" arg1: %s arg2: %s ", $args[0], $args[1]);
return $retval;
};
##
# Array of animal objects.
#
#
has 'livestock' => (
traits => ['Array'], # native delegation
isa => 'ArrayRef[Animal]',
is => 'rw',
default => sub { [] },
handles => { ## built in delegation support.
add_animal => 'push',
num_animals => 'count',
n_of_em => 'natatime',
add_many_animals => 'splice',
}
);
subtype 'cultivated_crops'
=> as 'Str'
=> where { /^(corn|nuts|olives|wheat)/i }
=> message { "$_ is not valid!" };
coerce 'Int'
=> from 'cultivated_crops';
has 'crop_acres' => (
is => 'rw',
isa => 'HashRef[Int]',
traits => ['Hash'],
default => sub { {} },
handles => {
setter => 'set',
getter => 'get',
pairs => 'kv',
none => 'is_empty',
num_choices => 'count',
delete_choice => 'delete',
}
);
##
# Animals are first pushed on to the livestock array.
# Afterwards animals should be inserted into the
# yard hash. key: name value: Animal_object
#
after 'add_animal' => sub {
my ($self1, $self2) = @_;
## XXX_question_5
## How can I call partition from this attribute
## group to run a method from another attribute?
##
## add_animal is in the livestock attribute.
##
## partition is in the yard attribute.
##
## A call to partition should add the
## animal to the yard hash after it's been pushed on
## to the livestock array.
# $self1->partition( ref $self2, [$self2] );
# partition( $self1, ref $self2, $self2 );
};
sub number_of_animals {
my ($self) = @_;
my $number_of_animals = scalar $self->yard; # @yard; # $self->yard;
return $number_of_animals;
}
1;
____----____---- End of file Farm.pm ____----____----