Disallowing non-attribute parameters in a Moose Class - perl

Is there a way to die if there are extra parameters in a constructor call in Moose that are not attributes? For example, this:
package Shoe;
use Moose;
has 'size' => (is => 'ro', isa => 'Num');
has 'color' => (is => 'ro', isa => 'Str', default => 'brown');
1;
would die on
my $sneaker = Shoe->new(size => 11, colour => 'white');
because colour is not an attribute of Shoe.
I could swear I've seen a module or something to do this but I can't find it.

For me works MooseX::StrictConstructor:
package Shoe;
use Moose;
use MooseX::StrictConstructor; # <-- that's all what need
has 'size' => (is => 'ro', isa => 'Num');
has 'color' => (is => 'ro', isa => 'Str');
1;
package main;
my $sneaker = Shoe->new(size => 11, colour => 'white'); #blows up

Related

How to instantiate Moose classes from a big hash

I have a big hash many levels deep, and I'd like to turn this hash into a set of Moose classes.
The hash looks something like this:
my %hash = (
company => {
id => 1,
name => 'CorpInc',
departments => [
{
id => 1,
name => 'Sales',
employees => [
{
id => 1,
name => 'John Smith',
age => '30',
},
],
},
{
id => 2,
name => 'IT',
employees => [
{
id => 2,
name => 'Lucy Jones',
age => '28',
},
{
id => 3,
name => 'Miguel Cerveza',
age => '25',
},
],
},
],
}
);
And the Moose classes:
package Company;
use Moose;
has 'id' => (is => 'ro', isa => 'Num');
has 'name' => (is => 'ro', isa => 'Str');
has 'departments' => (is => 'ro', isa => 'ArrayRef[Company::Department]');
1;
package Company::Department;
use Moose;
has 'id' => (is => 'ro', isa => 'Num');
has 'name' => (is => 'ro', isa => 'Str');
has 'employees' => (is => 'ro', isa => 'ArrayRef[Company::Person]');
1;
package Company::Person;
use Moose;
has 'id' => (is => 'ro', isa => 'Num');
has 'first_name' => (is => 'ro', isa => 'Str');
has 'last_name' => (is => 'ro', isa => 'Str');
has 'age' => (is => 'ro', isa => 'Num');
1;
Whats the best way to turn this hash into a Company object?
The options I've considered so far are:
Manually loop the %hash, find the deepest "classes" (e.g Person), create these first, then manually add these to the newly created higher level classes (Department), and so on.
Add some kind of coercion functionality to each class, which lets me do something like Company->new(%hash), and make each class create its own "subclasses" (via coercion)
Convert the %hash into a structure similar to what MooseX::Storage would serialize to, then use MooseX::Storage to instatiate everything for me...
Any other ideas or suggestions?
You could have a BUILDARGS handler which converts unblessed references in those slots to objects. Coercions is probably the best, but it takes more doing. (Unless this is all coming from a RDBMS, in which case use DBIx::Class).
#!/usr/bin/env perl
use warnings;
use strict;
package Company;
use Moose;
has 'id' => (is => 'ro', isa => 'Num');
has 'name' => (is => 'ro', isa => 'Str');
has 'departments' => (is => 'ro', isa => 'ArrayRef[Company::Department]');
sub BUILDARGS {
my $self = shift;
my $args = $self->SUPER::BUILDARGS(#_);
#{ $args->{departments} } =
map { eval{ $_->isa('Company::Department') } ? $_ : Company::Department->new($_) }
#{ $args->{departments} };
return $args;
};
package Company::Department;
use Moose;
has 'id' => (is => 'ro', isa => 'Num');
has 'name' => (is => 'ro', isa => 'Str');
has 'employees' => (is => 'ro', isa => 'ArrayRef[Company::Person]');
sub BUILDARGS {
my $self = shift;
my $args = $self->SUPER::BUILDARGS(#_);
#{ $args->{employees} } =
map { eval{ $_->isa('Company::Person') } ? $_ : Company::Person->new($_) }
#{ $args->{employees} };
return $args;
};
package Company::Person;
use Moose;
has 'id' => (is => 'ro', isa => 'Num');
has 'name' => (is => 'ro', isa => 'Str');
has 'age' => (is => 'ro', isa => 'Num');
package main;
my %hash = (
company => {
id => 1,
name => 'CorpInc',
departments => [
{
id => 1,
name => 'Sales',
employees => [
{
id => 1,
name => 'John Smith',
age => '30',
},
],
},
{
id => 2,
name => 'IT',
employees => [
{
id => 2,
name => 'Lucy Jones',
age => '28',
},
{
id => 3,
name => 'Miguel Cerveza',
age => '25',
},
],
},
],
}
);
my $company = Company->new($hash{company});
use Data::Dumper;
print Dumper $company;
I've used your option 2 several times and it worked fine for me. Last instance was inflating JIRA REST API results into real objects. Note that with coercions you can also lookup an existing instance by id and create only if it does not exist.
Edit: Here is some code to demonstrate those coercions:
package Company::Types;
use Moose::Util::TypeConstraints;
subtype 'Company::Departments', as 'ArrayRef[Company::Department]';
coerce 'Company::Departments', from 'ArrayRef', via {
require Company::Department;
[ map { Company::Department->new($_) } #$_ ]
};
subtype 'Company::Persons', as 'ArrayRef[Company::Person]';
coerce 'Company::Persons', from 'ArrayRef', via {
require Company::Person;
[ map { Company::Person->new($_) } #$_ ]
};
no Moose::Util::TypeConstraints;
and in those classes:
use Company::Types;
has 'departments' => (is => 'ro', isa => 'Company::Departments', coerce => 1);
has 'employees' => (is => 'ro', isa => 'Company::Persons', coerce => 1);
then you can pass whole structure into Company constructor and all gets inflated properly.

Coercing ArrayRef[MyClass] from ArrayRef[HashRef]

In trying to answer How to instantiate Moose classes from a big hash, I think I have hit another place where I don't fully understand Moose type coercions. For some reason, the below code issues warnings:
You cannot coerce an attribute (departments) unless its type (ArrayRef[Company::Department]) has a coercion at ./test.pl line 12.
You cannot coerce an attribute (employees) unless its type (ArrayRef[Company::Person]) has a coercion at ./test.pl line 23.
but then succeeds.
#!/usr/bin/env perl
use warnings;
use strict;
package Company;
use Moose;
use Moose::Util::TypeConstraints;
has 'id' => (is => 'ro', isa => 'Num');
has 'name' => (is => 'ro', isa => 'Str');
has 'departments' => (is => 'ro', isa => 'ArrayRef[Company::Department]', coerce => 1);
coerce 'ArrayRef[Company::Department]',
from 'ArrayRef[HashRef]',
via { [ map { Company::Department->new($_) } #$_ ] };
package Company::Department;
use Moose;
has 'id' => (is => 'ro', isa => 'Num');
has 'name' => (is => 'ro', isa => 'Str');
has 'employees' => (is => 'ro', isa => 'ArrayRef[Company::Person]', coerce => 1);
package Company::Person;
use Moose;
use Moose::Util::TypeConstraints;
has 'id' => (is => 'ro', isa => 'Num');
has 'name' => (is => 'ro', isa => 'Str');
has 'age' => (is => 'ro', isa => 'Num');
coerce 'ArrayRef[Company::Person]',
from 'ArrayRef[HashRef]',
via { [ map { Company::Person->new($_) } #$_ ] };
package main;
my %hash = (
company => {
id => 1,
name => 'CorpInc',
departments => [
{
id => 1,
name => 'Sales',
employees => [
{
id => 1,
name => 'John Smith',
age => '30',
},
],
},
{
id => 2,
name => 'IT',
employees => [
{
id => 2,
name => 'Lucy Jones',
age => '28',
},
{
id => 3,
name => 'Miguel Cerveza',
age => '25',
},
],
},
],
}
);
my $company = Company->new($hash{company});
use Data::Dumper;
print Dumper $company;
How should this have been done? P.S. I tried simply doing
coerce 'Company::Department',
from 'HashRef',
via { Company::Department->new($_) };
but it died horribly.
Well, it doesn't succeed completely, and you should feel it when you'll try to update these fields with coerce => 1. That's why:
You cannot pass coerce => 1 unless the attribute's type constraint has
a coercion
Previously, this was accepted, and it sort of worked,
except that if you attempted to set the attribute after the object was
created, you would get a runtime error.
Now you will get an error when you attempt to define the attribute.
Still, I think I find the way to fix it, by introducing subtypes, first, and changing the order of packages, second:
package Company::Person;
use Moose;
use Moose::Util::TypeConstraints;
subtype 'ArrayRefCompanyPersons',
as 'ArrayRef[Company::Person]';
coerce 'ArrayRefCompanyPersons',
from 'ArrayRef[HashRef]',
via { [ map { Company::Person->new($_) } #$_ ] };
has 'id' => (is => 'ro', isa => 'Num');
has 'name' => (is => 'ro', isa => 'Str');
has 'age' => (is => 'ro', isa => 'Num');
package Company::Department;
use Moose;
has 'id' => (is => 'ro', isa => 'Num');
has 'name' => (is => 'ro', isa => 'Str');
has 'employees' => (is => 'ro', isa => 'ArrayRefCompanyPersons', coerce => 1);
package Company;
use Moose;
use Moose::Util::TypeConstraints;
subtype 'ArrayRefCompanyDepartments',
as 'ArrayRef[Company::Department]';
coerce 'ArrayRefCompanyDepartments',
from 'ArrayRef[HashRef]',
via { [ map { Company::Department->new($_) } #$_ ] };
has 'id' => (is => 'ro', isa => 'Num');
has 'name' => (is => 'ro', isa => 'Str');
has 'departments' => (is => 'ro', isa => 'ArrayRefCompanyDepartments', coerce => 1);
The rest of the code is the same as in your version. This works without any warnings, and more-o-less behaves like (again, I think) it should be.
From Moose::Manual::Type docs:
LOAD ORDER ISSUES
Because Moose types are defined at runtime, you may run into load order problems. In particular, you may want to use a class's type constraint before that type has been defined.
In order to ameliorate this problem, we recommend defining all of your custom types in one module, MyApp::Types, and then loading this module in all of your other modules.
So to add to raina77ow subtype & package order answer (+1) I would recommend creating a Company::Types module:
package Company::Types;
use Moose;
use Moose::Util::TypeConstraints;
subtype 'CompanyDepartments'
=> as 'ArrayRef[Company::Department]';
subtype 'CompanyPersons'
=> as 'ArrayRef[Company::Person]';
coerce 'CompanyDepartments'
=> from 'ArrayRef[HashRef]'
=> via {
require Company::Department;
[ map { Company::Department->new($_) } #$_ ];
};
coerce 'CompanyPersons'
=> from 'ArrayRef[HashRef]'
=> via { require Company::Person; [ map { Company::Person->new($_) } #$_ ] };
1;
And then put use Company::Types in all your Company:: classes.

Moose - coercing from Num to ArrayRef[Num]?

Ok, what am I doing wrong - Moose is ignoring my coercion:
package moo;
use Moose;
use Moose::Util::TypeConstraints;
subtype Bar => as 'ArrayRef[Num]';
coerce 'Bar' =>
from 'Num' => via { [ 10 ] }; # this doesn't seem to be getting called
has x => (
is => 'rw',
isa => 'Bar',
);
package main;
my $m1 = moo->new(x => [ 3 ]); # works
my $m2 = moo->new(x => 5); # doesn't work
Maybe you forgot coerce => 1 while defining x attribute.
has x => ( is => 'rw', isa => 'Bar', coerce => 1 );
`

Why does Moose make_immutable kill this script?

package testDB;
use Moose;
use Carp;
use SQL::Library;
has 'lib' => (#FOLDBEG
is => 'rw',
isa => 'Str',
default => 'default',
trigger => \&_sql_lib_builder,
);#FOLDEND
has 'lib_dir' => (#FOLDBEG
is => 'ro',
isa => 'Str',
default => '/SQL',
);#FOLDEND
has '_sql_lib' => (#FOLDBEG
builder => '_sql_lib_builder',
is => 'rw',
isa => 'Str',
);
has '_sql_lib' => (#FOLDBEG
builder => '_sql_lib_builder',
is => 'rw',
handles => {
get_sql => 'retr',
get_elements => 'elements',
},
);
sub _sql_lib_builder {
my ($self, $lib) = shift();
$self->lib() or die("I am unable to get a lib.");
$lib = $self->lib unless $lib;
my $lib_dir = $self->lib_dir;
print $lib_dir."\n";
my $lib_file = $lib_dir . '/' . $lib . '.sql';
unless (-e $lib_file ) {
confess "SQL library $lib does not exist";
}
my $library = new SQL::Library { lib => $lib_file };
$self->_sql_lib($library);
}#FOLDEND
__PACKAGE__->meta->make_immutable;
my $tdb=testDB->new();
Using perl 5.8.8 and Moose 2.0205
$ perl testDB.pl
I am unable to get a lib. at testDB.pl line 35.
You've defined the _sql_lib attribute twice, once saying isa Str and once saying it handles methods (which a Str doesn't), but that's not the problem you're talking about.
The main problem is that you didn't define _sql_lib with lazy => 1. Any attribute whose builder (or default) depends on other attributes of the object must be lazy, because Moose doesn't guarantee the order in which attributes are assigned values during object construction.
# REMOVE THIS:
#has '_sql_lib' => (#FOLDBEG
# builder => '_sql_lib_builder',
# is => 'rw',
# isa => 'Str',
#);
has '_sql_lib' => (#FOLDBEG
builder => '_sql_lib_builder',
is => 'rw',
lazy => 1, # ADD THIS LINE
handles => {
get_sql => 'retr',
get_elements => 'elements',
},
);
The reason that make_immutable brings out the bug is that calling it generates a different constructor for your class, which happens to initialize the attributes in a different order.

How to find whether there is a 'child' doc. in MongoDBx::Class

I am learning the Perl MongoDBX::Class and writing a blog app.
Bellow are Post and Comment model. If call this method:
my $comments = $a_post->comments;
it halt the application if there is no comment for this post. The question is how to check whether this post has comment?
Thanks.
package Model::Schema::Post;
use MongoDBx::Class::Moose;
use namespace::autoclean;
with 'MongoDBx::Class::Document';
has 'title' => (is => 'rw', isa => 'Str', required => 1,);
belongs_to 'author' => (is => 'ro', isa => 'Author', required => 1);
has 'post_date' => (is => 'ro', isa => 'DateTime', traits => ['Parsed'], required => 1);
has 'text' => (is => 'rw', isa => 'Str', required => 1);
joins_many 'comments' => (is => 'ro', isa => 'Comment', coll => 'comments', ref => 'post');
holds_many 'tags' => (is => 'rw', isa => 'Tag', predicate => 'has_tag');
__PACKAGE__->meta->make_immutable;
package Model::Schema::Comment;
use MongoDBx::Class::Moose;
use namespace::autoclean;
with 'MongoDBx::Class::Document';
belongs_to 'post' => (is => 'ro', isa => 'Post', required => 1);
has 'author' => (is => 'ro', isa => 'Author', required => 1);
has 'comment_date' => (is => 'ro', isa => 'DateTime', traits => ['Parsed'], required => 1);
has 'text' => (is => 'rw', isa => 'Str', required => 1);
has 'rateing' => (is => 'rw', isa => 'Int');
__PACKAGE__->meta->make_immutable;
I'm not sure why your application halts. Looking at your schema, running
my $comments = $a_post->comments;
Should return a MongoDBx::Class::Cursor object (which is really just a MongoDB::Cursor object). On this cursor, you can run:
my $num_comments = $comments->count;
if ($num_comments > 0) {
my #comments = $comments->all;
...
}
If this doesn't help you, and your application still hangs, It'll help me if you send me a sample of your code so I can try to find out what's going on.
By the way I'm the author of MongoDBx::Class.
P.S. If you feel you've stumbled upon some bug in MongoDBx::Class, feel free to open a bug report as described on the MongoDBx::Class page on CPAN.