On Tue, Jun 14, 2011 at 11:03:33AM +0200, Ævar Arnfjörð Bjarmason wrote:
> On Tue, Jun 14, 2011 at 01:56, Jesse Luehrs <d...@tozt.net> wrote:
> > On Mon, Jun 13, 2011 at 06:45:10PM +0200, Ævar Arnfjörð Bjarmason wrote:
> >> On Mon, Jun 13, 2011 at 18:39, Ævar Arnfjörð Bjarmason <ava...@gmail.com>
> >> wrote:
> >> > For Mouse this monkeypatching would work:
> >>
> >> And this would work for Moose:
> >>
> >> package Foo;
> >> use Moose;
> >> {
> >> package Moose::Meta::Attribute;
> >>
> >> sub verify_against_type_constraint {
> >> my $self = shift;
> >> my $val = shift;
> >>
> >> return 1 if !$self->has_type_constraint;
> >>
> >> my $type_constraint = $self->type_constraint;
> >>
> >> $type_constraint->check($val)
> >> || Carp::cluck("Attribute ("
> >> . $self->name
> >> . ") does not pass the type constraint because: "
> >> . $type_constraint->get_message($val), data => $val,
> >> @_);
> >> }
> >> }
> >>
> >> has x => (is => "ro", isa => "Int");
> >> my $foo = Foo->new(x => "blah");
> >> use Data::Dumper;
> >> print Dumper $foo;
> >>
> >> And give you:
> >>
> >> $ perl -Ilib /tmp/error.pl
> >> Subroutine RegexpRef redefined at
> >> lib/Moose/Util/TypeConstraints/OptimizedConstraints.pm line 35.
> >> Subroutine verify_against_type_constraint redefined at /tmp/error.pl
> >> line 6.
> >> Attribute (x) does not pass the type constraint because:
> >> Validation failed for 'Int' with value
> >> blahdatablahinstanceFoo=HASH(0x1edadb0) at /tmp/error.pl line 14
> >>
> >> Moose::Meta::Attribute::verify_against_type_constraint('Moose::Meta::Attribute=HASH(0x27e0078)',
> >> 'blah', 'instance', 'Foo=HASH(0x1edadb0)') called at
> >> lib/Moose/Meta/Attribute.pm line 1125
> >>
> >> Moose::Meta::Attribute::_coerce_and_verify('Moose::Meta::Attribute=HASH(0x27e0078)',
> >> 'blah', 'Foo=HASH(0x1edadb0)') called at lib/Moose/Meta/Attribute.pm
> >> line 485
> >>
> >> Moose::Meta::Attribute::initialize_instance_slot('Moose::Meta::Attribute=HASH(0x27e0078)',
> >> 'Moose::Meta::Instance=HASH(0x27ad5c0)', 'Foo=HASH(0x1edadb0)',
> >> 'HASH(0x1ec8f90)') called at lib/Class/MOP/Class.pm line 575
> >>
> >> Class::MOP::Class::_construct_instance('Moose::Meta::Class=HASH(0x266bab0)',
> >> 'HASH(0x1ec8f90)') called at lib/Class/MOP/Class.pm line 548
> >>
> >> Class::MOP::Class::new_object('Moose::Meta::Class=HASH(0x266bab0)',
> >> 'HASH(0x1ec8f90)') called at lib/Moose/Meta/Class.pm line 252
> >>
> >> Moose::Meta::Class::new_object('Moose::Meta::Class=HASH(0x266bab0)',
> >> 'HASH(0x1ec8f90)') called at lib/Moose/Object.pm line 22
> >> Moose::Object::new('Foo', 'x', 'blah') called at
> >> /tmp/error.pl line 23
> >> $VAR1 = bless( {
> >> 'x' => 'blah'
> >> }, 'Foo' );
> >>
> >
> > For the record, please please PLEASE don't do this. Attribute traits
> > exist for a reason.
>
> How would you accomplish the same thing with attribute traits?
package My::Attr::Trait;
use Moose::Role;
around verify_against_type_constraint => sub {
my $orig = shift;
my $self = shift;
my ($val) = @_;
return 1 if !$self->has_type_constraint;
my $type_constraint = $self->type_constraint;
$type_constraint->check($val)
|| Carp::cluck("Attribute ("
. $self->name
. ") does not pass the type constraint because: "
. $type_constraint->get_message($val), data => $val, @_);
};
package Foo;
use Moose;
has x => (
traits => ['My::Attr::Trait'],
is => 'ro',
isa => 'Int',
);
my $foo = Foo->new(x => "blah");
use Data::Dumper;
print Dumper $foo;
__END__
Attribute (x) does not pass the type constraint because: Validation failed for
'Int' with value "blah"datablahblahinstanceFoo=HASH(0x14db428) at test11.pl
line 13
Class::MOP::Class:::around('CODE(0x1baace0)',
'Moose::Meta::Class::__ANON__::SERIAL::1=HASH(0x1e4e390)', 'blah', 'instance',
'Foo=HASH(0x14db428)') called at
/home/doy/perl5/perlbrew/perls/perl-5.14.0/lib/site_perl/5.14.0/x86_64-linux/Class/MOP/Method/Wrapped.pm
line 161
Class::MOP::Method::Wrapped::__ANON__('Moose::Meta::Class::__ANON__::SERIAL::1=HASH(0x1e4e390)',
'blah', 'instance', 'Foo=HASH(0x14db428)') called at
/home/doy/perl5/perlbrew/perls/perl-5.14.0/lib/site_perl/5.14.0/x86_64-linux/Class/MOP/Method/Wrapped.pm
line 91
Moose::Meta::Class::__ANON__::SERIAL::1::verify_against_type_constraint('Moose::Meta::Class::__ANON__::SERIAL::1=HASH(0x1e4e390)',
'blah', 'instance', 'Foo=HASH(0x14db428)') called at
/home/doy/perl5/perlbrew/perls/perl-5.14.0/lib/site_perl/5.14.0/x86_64-linux/Moose/Meta/Attribute.pm
line 1131
Moose::Meta::Attribute::_coerce_and_verify('Moose::Meta::Class::__ANON__::SERIAL::1=HASH(0x1e4e390)',
'blah', 'Foo=HASH(0x14db428)') called at
/home/doy/perl5/perlbrew/perls/perl-5.14.0/lib/site_perl/5.14.0/x86_64-linux/Moose/Meta/Attribute.pm
line 491
Moose::Meta::Attribute::initialize_instance_slot('Moose::Meta::Class::__ANON__::SERIAL::1=HASH(0x1e4e390)',
'Moose::Meta::Instance=HASH(0x14e5130)', 'Foo=HASH(0x14db428)',
'HASH(0x14c6fc8)') called at
/home/doy/perl5/perlbrew/perls/perl-5.14.0/lib/site_perl/5.14.0/x86_64-linux/Class/MOP/Class.pm
line 524
Class::MOP::Class::_construct_instance('Moose::Meta::Class=HASH(0x1de0200)',
'HASH(0x14c6fc8)') called at
/home/doy/perl5/perlbrew/perls/perl-5.14.0/lib/site_perl/5.14.0/x86_64-linux/Class/MOP/Class.pm
line 497
Class::MOP::Class::new_object('Moose::Meta::Class=HASH(0x1de0200)',
'HASH(0x14c6fc8)') called at
/home/doy/perl5/perlbrew/perls/perl-5.14.0/lib/site_perl/5.14.0/x86_64-linux/Moose/Meta/Class.pm
line 269
Moose::Meta::Class::new_object('Moose::Meta::Class=HASH(0x1de0200)',
'HASH(0x14c6fc8)') called at
/home/doy/perl5/perlbrew/perls/perl-5.14.0/lib/site_perl/5.14.0/x86_64-linux/Moose/Object.pm
line 28
Moose::Object::new('Foo', 'x', 'blah') called at test11.pl line 29
$VAR1 = bless( {
'x' => 'blah'
}, 'Foo' );
You could also use Moose::Util::MetaRole to apply the trait to all attributes
in a class by default.
-doy
