Re: Moose Type Constraints violations to warnings?

[email protected] (Jesse Luehrs)
Newsgroups perl.moose
Message-ID <[email protected]>
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 <[email protected]> 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 <[email protected]> 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
lmpx.com only provides a reader for public news (NNTP) servers. It is not affiliated with the servers or forums shown here and is not responsible for the content of articles, which is written by their respective authors.