###############################################################################
# Attributes
###############################################################################
has 'primary_cluster' => (
is => 'ro',
isa => 'Str',
required => TRUE,
);
has 'secondary_cluster' => (
is => 'ro',
isa => 'Str',
required => FALSE,
default => sub {$_[0]->primary_cluster},
);
has '_connection' => (
is => 'ro',
required => FALSE,
init_arg => undef,
default => sub {
Core::mConnection->new(
primary_cluster => $_[0]->primary_cluster,
secondary_cluster => $_[0]->secondary_cluster,
);
},
);
I'm trying to have a private attribute _connection that uses other attributes to create a mConnection object. The problem I'm running into is that inside the default subroutine of _connection, $_[0]->primary_cluster is always undef. Is there any way to guarantee order to the attribute creation or is there a better way to go about doing this?
I do not want this attribute to be lazy; I need it to be created when the object is constructed.
The object is still being constructed! Delay your attribute's initialization until after it's constructed. the following delays its initialization until it's used:
lazy => 1
You could also use a BUILD method instead of a default.
sub BUILD {
my $self = shift;
$self->_connection(
Core::mConnection->new(
primary_cluster => $self->primary_cluster,
secondary_cluster => $self->secondary_cluster,
)
);
}
Of course, you'll need to make the attribute writable first.
Related
I have a Moose class Person
package Person;
use Moose;
has 'first_name' => (
is => 'rw',
isa => 'Str',
);
has 'last_name' => (
is => 'rw',
isa => 'Str',
);
has 'check' => (
is => 'rw',
isa => 'CodeRef',
);
no Moose;
__PACKAGE__->meta->make_immutable;
I am initializing a new Person object in another file like so
use Person;
my $user = Person->new(
first_name => 'Example',
last_name => 'User',
check => sub {
print "yo yo\n";
},
);
print "here\n";
$user->check();
print "here\n";
The two here debug statements are printing but the debug message in the subroutine is not.
I'd like to know the correct way for me to pass a function to the constructor such that I can pass an anonymous sub routine to the object.
$user->check() is equivalent to $user->check. It just returns the value of the check attribute (i.e, the coderef) without doing anything with it -- just like any other accessor would. The fact that this attribute holds a coderef doesn't change that.
If you want to retrieve the coderef, then call it, you need another arrow:
$user->check->()
An alternative is to use the trait Code implemented by Moose::Meta::Attribute::Native::Trait::Code, and then define a handle with a different name.
package Person;
use Moose;
has 'check' => (
is => 'rw',
isa => 'CodeRef',
traits => ['Code'],
handles => {
run_check => 'execute',
},
);
And then call it like this
my $user = Person->new(
first_name => 'Example',
last_name => 'User',
check => sub {
print "yo yo\n";
},
);
print "here\n";
$user->run_check;
print "here\n";
This allows you to separate the accessor for the code-ref from the functionality it fulfills.
I've created subtype Birth_d with coercion as shown below, and I'm trying to use it in combination with the built-in Maybe type, per Moose::Manual::Types.
I'm getting the error You cannot coerce an attribute (birth_d) unless its type (Maybe[Birth_d]) has a coercion. Here's complete test code:
package Student;
use Moose;
use Moose::Util::TypeConstraints;
use DateTime::Format::MySQL;
class_type 'Birth_d', { class => 'DateTime' };
coerce 'Birth_d',
from 'Str',
via { DateTime::Format::MySQL->parse_date( $_ ) };
has 'name' => (
isa => 'Str',
is => 'ro',
);
has 'birth_d' => (
isa => 'Maybe[Birth_d]', # This works: isa => 'Birth_d'
coerce => 1,
is => 'ro',
);
package main;
use Test::More;
my $student = Student->new(
name => 'Johnnie Appleseed',
birth_d => '2015-01-01'
);
is ( $student->birth_d->ymd(), '2015-01-01' );
my $student2 = Student->new(
name => 'Foo Bar',
birth_d => undef
);
is( $student2->birth_d, undef );
Replacing isa => 'Maybe[Birth_d]' with isa => 'Birth_d' works, but is not what is needed. I need to make the birth_d optional, and if not supplied, should be undef.
I should add, I tried using MooseX::Types to tuck this Birth_d type away in a separate place, but found its cavalier use of barewords a bit unorthodox, so I slowly backed away. I'm open to reconsidering it, if it makes sense to do so.
Moose does not do any chaining of coercions, in other words you have to tell it explicitly how to convert to a Maybe[Birth_d].
You can do this by reusing the existing coercion to Birth_d:
package Student;
use Moose;
use Moose::Util::TypeConstraints;
use DateTime::Format::MySQL;
# save the Moose::Meta::TypeConstraint object
# you can also get it with find_type_constraint('Birth_d')
my $birth_d = class_type 'Birth_d', { class => 'DateTime' };
coerce 'Birth_d',
from 'Str',
via { DateTime::Format::MySQL->parse_date( $_ ) };
subtype 'MaybeBirth_d',
as 'Maybe[Birth_d]';
coerce 'Maybe[Birth_d]',
from 'Str|Undef',
via { $birth_d->coerce($_) };
has 'name' => (
isa => 'Str',
is => 'ro',
);
has 'birth_d' => (
isa => 'Maybe[Birth_d]',
coerce => 1,
is => 'ro',
predicate => 'has_birth_d', # as per your comment
);
package main;
use Test::More;
my $student = Student->new(
name => 'Johnnie Appleseed',
birth_d => '2015-01-01'
);
is ( $student->birth_d->ymd(), '2015-01-01' );
my $student2 = Student->new(
name => 'Foo Bar',
birth_d => undef
);
is( $student2->birth_d, undef );
ok( $student2->has_birth_d );
done_testing;
I would find it more useful to not have a Maybe[Birth_d] type, but simply declare the attribute with the Birth_d type, and no "required" set.
That way, if a valid String is passed in, it will be accepted, an invalid String will lead to an error, and nothing just does not need to be passed in.
However, you can coerce to a maybe type:
subtype 'MaybeBirth_d',
as maybe_type(class_type('DateTime'));
coerce 'MaybeBirth_d',
from 'Str',
via { DateTime::Format::MySQL->parse_date( $_ ) };
has 'birth_d' => (
isa => 'MaybeBirth_d',
coerce => 1,
is => 'ro',
);
I just do not see the value of being able to pass in undef for a birthdate - how is that better than not setting it?
I would also like to suggest using no Moose::Util::TypeConstraints; and no Moose; at the end of your package, or namespace::autoclean; at the beginning, as well as __PACKAGE__->meta->make_immutable; at the end of your Student class.
I have WrapperClass object that has an InnerClass object as an attribute. The InnerClass object has a weight attribute. My WrapperClass object also has a weight attribute and I want its default value to be whatever the value of the InnerClass object's weight attribute is.
#!/usr/bin/perl
package InnerClass;
use Moose;
has 'weight' => (
is => 'rw',
);
package WrapperClass;
use Moose;
has 'wrapped' => (
is => 'rw',
lazy => 1,
default => sub {InnerClass->new(weight => 1)},
);
has 'weight' => (
is => 'rw',
default => sub {
my $self = shift;
$self->wrapped->weight()
},
lazy => 1,
);
The code above works, but in reality InnerClass has many attributes which WrapperClass needs to do the same thing for. Ideally I would do something like this when I'm writing WrapperClass:
use Moose;
has 'wrapped' => (
is => 'rw',
);
my #getDefaultsFromWrappers
= qw(weight height mass x y z label); # etc ...
foreach my $attr (#getDefaultsFromWrappers) {
has $attr => (
is => 'rw',
default => sub {
# Somehow tell the default which attribute
# it needs to call from wrapped object?
my $self = shift;
$self->wrapped->???()
},
lazy => 1,
);
}
However, there is no way of passing an argument to a default or builder to tell it which attribute it is building. I've considered using caller but this seems like a hack.
Does anyone know how I could accomplish this style of attribute declaration or is it a case of declaring each attribute and its default separately?
You can use $attr where your question marks are because it is still in scope when you declare the attributes.
foreach my $attr (#getDefaultsFromWrappers) {
has $attr => (
is => 'rw',
default => sub { shift->wrapped->$attr() },
lazy => 1,
);
}
The following is a possible alternative, which you might want to use if your attribute declarations are not uniform:
has weight => (
is => 'rw',
isa => 'Num',
default => _build_default_sub('weight'),
lazy => 1,
);
has label => (
is => 'rw',
isa => 'Str',
default => _build_default_sub('label'),
lazy => 1,
);
sub _build_default_sub {
my ($attr) = #_;
return sub { shift->wrapped->$attr };
}
This may be better handled by method delegation and default values in the inner object.
With these, the example you gave can be better written as:
#!/usr/bin/perl
use strict;
use warnings;
package InnerClass;
use Moose;
has weight => (
is => 'rw',
default => 1,
);
package WrapperClass;
use Moose;
has wrapped => (
is => 'rw',
isa => 'InnerClass',
lazy => 1,
default => sub { InnerClass->new },
handles => [ 'weight' ],
);
package main;
my $foo = WrapperClass->new;
print $foo->weight;
Any additional defaults would be added as default on the InnerClass, and within the WrapperClass, add to wrapped 'handles' array ref to indicate that it should be delegated to that object.
If don't want the defaults to be applied to all instances of InnerClass, then you can remove the default from there, specify all attributes required (to give better error detection), and specify all attributes in the default constructor.
I have a Moose::Role that has (among other things):
package My::Role;
use strict;
use warnings;
use Moose::Role;
use MooseX::ClassAttribute;
class_has table => (
is => 'ro'
isa => 'Str',
lazy => 1,
);
has id => (
is => 'ro',
isa => 'Int',
predicate => 'has_id',
writer => '_id',
required => 0,
);
has other => (
is => 'rw',
isa => 'Int',
);
...
1;
Then, in a module that consumes that Role,
package Some::Module;
with 'My::Role' => {
-excludes => [qw( id table )]
};
has module_id => (
is => 'ro',
isa => 'Int',
);
...
1;
Then, in a script I'm instantiating an instance of Some::Module:
my $some_module = Some::Module->new({ other => 3 });
and I'm able to call
$some_module->id; # I'd expect this to die but returns undef.
However, I'm unable to call
$some_module->table; # this dies as I'd expect
As I'd expect calling $some_module->table causes the script to cease. Calling
$some_module->id doesn't.
When I use Data::Dumper to dump out the attribute list of the $some_module meta
class it show that the id attribute is defined but the table attribute is not.
Does anyone know why the 'id' attribute defined in the Role would not be excluded
from the meta class but the 'table' class_attribute would? The problem being, as
described above, is that users of Some::Module can call id() when they should be
required to call module_id().
Furthermore, when dumping $some_module object, the 'id' doesn't show up in the dump.
Edit:
Here's a sample that illustrates the problem. I've defined a role
that implements an id then I'm consuming the role in the package My::Product.
I'm excluding the id when consuming it however. When I print the attribute
from the meta object it shows that it is in fact there. I was under the impression
that excluding the id from a role when consuming it wouldn't allow it to be called.
I'd expect that it would not only be NOT in the meta object but also to die on
an attempt to call it.
#!/usr/bin/perl
package My::Model;
use Moose::Role;
use MooseX::ClassAttribute;
class_has first_name => (
is => 'rw',
isa => 'Str',
);
class_has last_name => (
is => 'rw',
isa => 'Str',
);
has id => (
is => 'rw',
isa => 'Int',
predicate => 'has_id',
writer => '_id',
required => 0,
);
1;
package My::Product;
use Moose;
use Class::MOP::Class;
use Data::Dumper;
with 'My::Model' => { -excludes => [ qw( first_name id ) ], };
has count => (
is => 'rw',
isa => 'Int',
);
has product_id => (
is => 'ro',
isa => 'Int',
required => 0,
predicate => 'has_product_id'
);
sub create_classes {
my #list = ();
foreach my $subclass (qw( one two three )) {
Class::MOP::Class->create(
"My::Product::"
. $subclass => (
superclasses => ["My::Product"],
)
);
push #list, "My::Product::$subclass";
}
return \#list;
}
__PACKAGE__->meta()->make_immutable;
1;
package main;
use strict;
use warnings;
use Data::Dumper;
my $product = My::Product->new();
my $classes = $product->create_classes();
my #class_list;
foreach my $class ( #{ $classes } ) {
my $temp = $class->new( { count => time } );
$temp->first_name('Don');
$temp->last_name('MouseCop');
push #class_list, $temp;
}
warn "what is the id for the first obj => " . $class_list[0]->id ;
warn "what is the first_name for the first obj => " . $class_list[0]->first_name ;
warn "what is the last_name for the first obj => " . $class_list[0]->last_name ;
warn "\nAttribute list:\n";
foreach my $attr ( $class_list[2]->meta->get_all_attributes ) {
warn "name => " . $attr->name;
# warn Dumper( $attr );
}
Edit 2:
Upon dumping the $attr I am seeing that first_name and id are in the method_exclusions.
'role_applications' => [
bless( {
'class' => $VAR1->{'associated_class'},
'role' => $VAR1->{'associated_class'}{'roles'}[0],
'method_aliases' => {},
'method_exclusions' => [
'first_name',
'id'
]
}, 'Moose::Meta::Class::__ANON__::SERIAL::8' )
]
I have no idea how the innards of this works but I believe this is to do with the fact that the two methods you are excluding are attribute methods. The only relevant article I can find is here, where it says:
A roles attributes are similar to those of a class, except
that they are not actually applied. This means that methods that are
generated by an attributes accessor will not be generated in the role,
but only created once the role is applied to a class.
Therefore I'm guessing the problem is that when your classes are being constructed, the role is applied (and the methods are excluded), but after that the role's attributes are applied and the accessor methods (including id and first_name) are constructed.
To demonstrate, change the id attribute to _id, give it a different writer and create an id sub to access it:
# This replaces id
has _id => (
is => 'rw',
isa => 'Int',
writer => 'set_id',
required => 0,
);
sub id {
my $self = shift;
return $self->_id();
}
The script will now die with an exception:
Can't locate object method "id" via package "My::Product::one" at ./module.pm line 89.
I'm currently delegating the builder method to all of the objects that extend one of my base classes. The problem that I'm facing is I need all of the objects to either read an attribute of itself or be passed in a value.
# In Role:
has 'const_string' => (
isa => 'Str',
is => 'ro',
default => 'test',
);
has 'attr' => (
isa => 'Str',
is => 'ro',
builder => '_builder',
);
requires '_builder';
# In extending object - desired 1
sub _builder {
my ($self) = shift;
# $self contains $self->const_string
}
# In extending object - desired 2
sub _builder {
my ($arg1, $arg2) = #_;
# $args can be passed somehow?
}
Is this currently possible or am I going to have to do it some other way?
You can't pass arguments to attribute build methods. They are called automatically by Moose internals, and passed only one argument -- the object reference itself. The builder must be able to return its value based on what it sees in $self, or anything else in the environment that it has access to.
What sort of arguments would you be wanting to pass to the builder? Can you instead pass these values to the object constructor and store them in other attributes?
# in object #2:
has other_attr_a => (
is => 'ro', isa => 'Str',
);
has other_attr_b => (
is => 'ro', isa => 'Str',
);
sub _builder
{
my $self = shift;
# calculates something based on other_attr_a and other_attr_b
}
# object #2 is constructed as:
my $obj = Class2->new(other_attr_a => 'value', other_attr_b => 'value');
Also note that if you have attributes that are built based off of other attribute values, you should define them as lazy, otherwise the builders/defaults will run immediately on object construction, and in an undefined order. Setting them lazy will delay their definition until they are first needed.
You can do something like this:
has 'attr' => (
isa => 'Str',
is => 'ro',
builder => '_pre_builder',
);
sub pre_builder {
_builder(#_, 'your_arg');
}