How can I refer to an object when I create it using Perl Class :: Struct?

Question

I'm new to object oriented Perl, and I need to access a member variable of the same object in another routine of the same object. Sample code here:

use Class::Struct; struct Breed => { name => '$', cross => '$', }; struct Cat => [ name => '$', kittens => '@', markings => '%', breed => 'Breed', breed2 => '$', ]; my $cat = Cat->new( name => 'Socks', kittens => ['Monica', 'Kenneth'], markings => { socks=>1, blaze=>"white" }, breed => { name=>'short-hair', cross=>1 }, ** //breed2 => sub { return $cat->breed->name;}** ); print "Once a cat called ", $cat->name, "\n"; **print "(which was a ", $cat->breed->name, ")\n";** print "had two kittens: ", join(' and ', @{$cat->kittens}), "\n"; 

But I'm not sure how to use this name $ cat-> breed-> in a routine for breed2? Can anyone help me on this.

Answer 1

The problem in breed2 is that you are trying to refer to a variable that you have not yet defined. This seems to be the same name, but it is not the object you are creating. This is a bit of a problem with chicken and egg.

I'm not sure if you want to use an anonymous routine in this slot. Are you just to shorten $cat->breed->name to $cat->breed2 ? You can start with undef in breed2 and change its value immediately after the constructor, since then you will have a reference to the object. However, even if you put a subroutine there, you must dereference it:

 my $cat = Cat->new( name => 'Socks', kittens => ['Monica', 'Kenneth'], markings => { socks=>1, blaze=>"white" }, breed => { name=>'short-hair', cross=>1 }, breed2 => undef, ); $cat->breed2( sub { $cat->breed->name } ); print "Once a cat called ", $cat->name, "\n"; print "(which was a ", $cat->breed2->(), ")\n"; print "had two kittens: ", join(' and ', @{$cat->kittens}), "\n"; 

Answer 2

You cannot use $ cat-> breed-> name inside the Cat constructor. But you can define breed2 () as the method after the constructor:

 sub Cat::breed2 { my ($self) = @_; return $self->breed->name; } 

Answer 3

Do not use Class :: Struct Moose .

 package Breed; use Moose; has 'name' => ( isa => 'Str', is => 'ro', required => 1 ); has 'cross' => ( isa => 'Bool', is => 'ro' ); package Cat; use Moose; has 'name' => ( isa => 'Str', is => 'ro', required => 1 ); has 'kittens' => ( isa => 'ArrayRef[Cat]', is => 'ro' ); has 'markings' => ( isa => 'HashRef', is => 'ro', default => sub { +{} } ); has 'breeds' => ( isa => 'ArrayRef[Breed]', is => 'ro' ); package main; use Modern::Perl; my $cat = Cat->new({ name => 'Socks', , kittens => [ Cat->new({name=>'Monica'}), Cat->new({name=>'Kenneth'}) ] , markings => { socks=>1, blaze=>"white" } , breeds => [ Breed->new({ name=>'short-hair', cross => 1 }) ] }); say "Once a cat called ", $cat->name; say "Which was a:"; say "\t".$_->name for @{$cat->breeds}; say "had kittens:"; say "\t".$_->name for @{$cat->kittens}; 

In this design, a cat can have any number of Breed s, and a Cat can have any number of kittens , which are also Cat objects.

to solve your problem specifically

• You can make this implicit in the constructor, the second breed will be the first if it is not provided.

  package Cat; sub BUILD { my $self = shift; $self->breeds->[1] = $self->breeds->[0] if $self->breeds->[0] && ! $self->breeds->[1] }

• You can pass to the token, which identifies it as such, in the constructor (this should be easy, but I can add an example if you want)

• You can make Cat understand that if there is only one breed, then both parents are the same.

  package Cat; sub is_pure_bred { length @{$_[0]->breeds} == 1 ? 1 : 0 }

• You can ignore the cat breed by setting it to undef and define the breed by the breed of the parent. This is because your breed is always a function of your line anyway. You can limit this to a Moose trigger , a cat either requires two cat parents or requires a breed.

footnote Trash objects serialize pretty well with XXX :

 ... use XXX; YYY $cat; --- !!perl/hash:Cat breeds: - !!perl/hash:Breed cross: 1 name: short-hair kittens: - !!perl/hash:Cat markings: {} name: Monica - !!perl/hash:Cat markings: {} name: Kenneth markings: blaze: white socks: 1 name: Socks ... 

Answer 4

Firstly, I will start with a few comments, then I will answer the meat of your question.

OO Perl is slightly different from other OO systems. There is a very thin layer of basic OO support that allows you to make your objects almost whatever you want. From the bottom, you can make your objects almost whatever you want. The classic OO Perl includes many code templates, as you implement accessors and mutators for each attribute, maybe add type checking, etc. This has led to the emergence of a wide range of tools for automating the production of templates.

There are three ways that I approach OO Perl: Moose, a classic hash based on all manual encodings, and Class :: Struct. Moose is great for systems where you have complex needs, but it greatly affects the launch time of the application. If startup time is important for your application, Moose is out of the question right now. The :: Struct class is a great way to get the lowest common denominator, a quick, simple OO application together, at the bottom it does not support inheritance. In this case, a manually encoded OOP is entered. If Moose or Class :: Struct are not viable options for one reason or another, I will return to the basics. This strategy worked well for me. The only change I have felt in the last few years is to add Moose to my standard toolkit. This is a nice addition.

Damian Conway Object Oriented Perl is an amazing book that clearly describes OOP, how OO Perl works and how to create objects that can do amazing things. It's a bit outdated, but the book is still holding on. Any serious OO Perl student should read this book.

Now, for your question -

It seems to me that breed2 not an attribute of your object, but a method.

 use Class::Struct; use strict; use warnings; struct Breed => { name => '$', cross => '$', }; struct Cat => [ name => '$', kittens => '@', markings => '%', breed => 'Breed', ]; my $cat = Cat->new( name => 'Socks', kittens => ['Monica', 'Kenneth'], markings => { socks=>1, blaze=>"white" }, breed => { name=>'short-hair', cross=>1 }, ); # Delegate to Breed::name sub Cat::breed2 { my $self = shift; my $breed = $self->breed; # Get the breed object my $name; eval { $name = $breed->name(@_) }; warn "No breed specified for ".( $self->name )."\n" unless defined $name; return $name; } print "Once a cat called ", $cat->name, "\n", "(which was a ", $cat->breed2, ")\n", "had two kittens: ", join(' and ', @{$cat->kittens}), "\n"; 

Things get a little more hairy if you want to keep a set of predefined breeds and breed2 select a breed object by name if not set.

This abbreviated Cat implementation uses class data to track breeds of cats and

 package Cat; use strict; use warnings; use Carp qw( croak ); my %breeds = map { $_->{name}, Breed->new( %$_ ) } ( { name=>'short-hair', cross=>1 }, { name=>'long-hair', cross=>1 }, { name=>'siamese', cross=>0 }, ); sub new { my $class = shift; my %args = @_; my $self = {}; bless $self, $class; for my $arg ( keys %args ) { $self->$arg( $args{$arg} ) if $self->can($arg); } return $self; } sub breed { my $self = shift; if( @_ ) { my $v = shift; croak "Illegal cat breed" unless eval {$v->isa( 'Breed' ) }; $self->{breed} = $v; } return $self->{breed}; } sub breed2 { my $self = shift; my @breed_args; if( @_ ) { my $v = shift; croak "$v is not a supported breed\n" unless exists $breeds{$v}; @breed_args = ( $breeds{$v} ); } my $breed = $self->breed(@breed_args); return unless $breed; return $breed->name; } 

Now let's look at the Moose solution, which uses all sorts of advanced goodies, such as coercion and type overloading:

 BEGIN { package Breed; use Moose; has 'name' => ( isa => 'Str', is => 'ro', required => 1 ); has 'cross' => ( isa => 'Bool', is => 'ro', required => 1 ); use overload '""' => \&_overload_string; sub _overload_string { my $self = shift; return $self->name; } __PACKAGE__->meta->make_immutable; no Moose; 1; } BEGIN { package Cat; use Moose; use Moose::Util::TypeConstraints; use Carp; subtype 'MyTypes::CatBreed' => as class_type('Breed'); coerce 'MyTypes::CatBreed' => from 'Str' => via { Cat->supported_breed_by_name( $_ ) }; has 'name' => ( isa => 'Str', is => 'rw', required => 1 ); has 'kittens' => ( traits => ['Array'], is => 'ro', isa => 'ArrayRef[Str]', default => sub{ [] }, handles => { all_kittens => 'elements', add_kittens => 'push', get_kitten => 'get', count_kittens => 'count', has_kittens => 'count', }, ); has 'markings' => ( traits => ['Hash'], is => 'ro', isa => 'HashRef[Str]', default => sub{ {} }, handles => { set_marking => 'set', get_marking => 'get', has_marking => 'exists', all_markings => 'keys', delete_marking => 'delete', }, ); has 'breed' => ( isa => 'MyTypes::CatBreed', is => 'ro', coerce => 1, ); my %breeds; sub supported_breed_by_name { my $class = shift; my $name = shift; croak 'No breed name specified' unless defined $name and length $name; return $breeds{$name}; } sub add_breed { my $class = shift; my $breed = shift; croak 'No breed specified' unless eval { $breed->isa('Breed') }; croak 'Breed already exists' if exists $breeds{$breed}; $breeds{$breed} = $breed; return $class; } sub delete_breed { my $class = shift; my $name = shift; croak 'No breed name specified' unless defined $name and length $name; return delete $breeds{$name}; } __PACKAGE__->meta->make_immutable; no Moose; 1; } # Set up the supported breeds Cat->add_breed($_) for map Breed->new( %$_ ), ( { name=>'short-hair', cross=>1 }, { name=>'long-hair', cross=>1 }, { name=>'siamese', cross=>0 }, ); # Make a cat my $cat = Cat->new( name => 'Socks', kittens => ['Monica', 'Kenneth'], markings => { socks=>1, blaze=>"white" }, breed => 'short-hair', ); print "Once a cat called ", $cat->name, "\n", "(which was a ", $cat->breed, ")\n", "had ", , " kittens: ", join(' and ', @{$cat->kittens}), "\n"; 

Answer 5

You can fix this in several ways, here are two of them:

 use warnings; use strict; sub say {print @_, "\n"} use Class::Struct; struct Breed => { name => '$', cross => '$', }; struct Cat => [ name => '$', kittens => '@', markings => '%', breed => 'Breed', breed2 => '$', ]; sub Cat::breed_name {shift->breed->name} #create a new accessor method my $cat; # or declare $cat first $cat = Cat->new( name => 'Socks', kittens => ['Monica', 'Kenneth'], markings => { socks=>1, blaze=>"white" }, breed => { name=>'short-hair', cross=>1 }, breed2 => sub { return $cat->breed->name;}, # this is now ok, but a bit awkward to call ); print "Once a cat called ", $cat->name, "\n"; print "(which was a ", $cat->breed2->(), ")\n"; #returns then calls code ref print "(which was a ", $cat->breed_name, ")\n"; #new accessor method print "had two kittens: ", join(' and ', @{$cat->kittens}), "\n"; 

The reason your closure is not working correctly is because you cannot close the variable defined in the current statement. When sub {...} tried to close around $cat , he could not, because he was not yet in scope. The solution simply predetermines the variable.

However, it looks like Class::Struct allows you to set methods this way. Instead, adding a new access method to the Cat:: package allows you to call the method as you would expect.