From: Stevan Little Date: Sun, 13 Apr 2008 03:54:34 +0000 (+0000) Subject: fixing trigger/coerce bug, adding test and reformating some yuval code :P X-Git-Tag: 0_55~228 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=4078709c36bf84c9c6747935aeed8b13bcd0f0ec;p=gitmo%2FMoose.git fixing trigger/coerce bug, adding test and reformating some yuval code :P --- diff --git a/Changes b/Changes index 536146a..d41647a 100644 --- a/Changes +++ b/Changes @@ -12,6 +12,12 @@ Revision history for Perl extension Moose as well. There will be 2 releases, and then it will be removed. + * Moose::Meta::Class + - fixing &new_object to make sure trigger gets the + coerced value (spotted by Charles Alderman on the + mailing list) + - added test for this + * Moose::Meta::Method::Constructor - immutable classes which had non-lazy attributes were calling the default generating sub twice in the constructor. (bug @@ -40,18 +46,25 @@ Revision history for Perl extension Moose type constraint object (nothingmuch) * Moose::Meta::TypeConstraint - - added the &equals method for comparing two type - constraints (nothingmuch) - - added tests for this (nothingmuch) + Moose::Meta::TypeConstraint::Class + Moose::Meta::TypeConstraint::Enum + Moose::Meta::TypeConstraint::Union + Moose::Meta::TypeConstraint::Parameterized + - added the &equals method for comparing two type + constraints (nothingmuch) + - added tests for this (nothingmuch) + + * Moose::Meta::TypeConstraint - add the &parents method, which is just an alias to &parent. Useful for polymorphism with TC::Class (nothingmuch) * Moose::Meta::TypeConstraint::Class - - added the &equals method for comparing two type - constraints (nothingmuch) - added the class attribute for introspection purposes (nothingmuch) - added tests for this + + * Moose::Meta::TypeConstraint::Enum + - broke this out into it's own class (nothingmuch) * Moose::Cookbook::Recipe* - fixed references to test file locations in the POD diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 3daf355..68ffa24 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -121,10 +121,27 @@ sub new_object { my ($class, %params) = @_; my $self = $class->SUPER::new_object(%params); foreach my $attr ($class->compute_all_applicable_attributes()) { - if ( defined( my $init_arg = $attr->init_arg ) ) { - if ( exists($params{$init_arg}) && $attr->can('has_trigger') && $attr->has_trigger ) { - $attr->trigger->($self, $params{$init_arg}, $attr); - } + # if we have a trigger, then ... + if ($attr->can('has_trigger') && $attr->has_trigger) { + # make sure we have an init-arg ... + if (defined(my $init_arg = $attr->init_arg)) { + # now make sure an init-arg was passes ... + if (exists $params{$init_arg}) { + # and if get here, fire the trigger + $attr->trigger->( + $self, + # check if there is a coercion + ($attr->should_coerce + # and if so, we need to grab the + # value that is actually been stored + ? $attr->get_read_method_ref->($self) + # otherwise, just get the value from + # the constructor params + : $params{$init_arg}), + $attr + ); + } + } } } return $self; diff --git a/lib/Moose/Meta/TypeConstraint/Class.pm b/lib/Moose/Meta/TypeConstraint/Class.pm index a094aae..0a763a1 100644 --- a/lib/Moose/Meta/TypeConstraint/Class.pm +++ b/lib/Moose/Meta/TypeConstraint/Class.pm @@ -7,26 +7,23 @@ use metaclass; use Scalar::Util 'blessed'; use Moose::Util::TypeConstraints (); -our $VERSION = '0.01'; +our $VERSION = '0.02'; our $AUTHORITY = 'cpan:STEVAN'; use base 'Moose::Meta::TypeConstraint'; __PACKAGE__->meta->add_attribute('class' => ( - reader => 'class', + reader => 'class', )); sub new { my ( $class, %args ) = @_; - $args{class} = $args{name} unless exists $args{class}; - + $args{class} = $args{name} unless exists $args{class}; $args{parent} = Moose::Util::TypeConstraints::find_type_constraint('Object'); - - my $self = $class->meta->new_object(%args); + my $self = $class->meta->new_object(%args); $self->_create_hand_optimized_type_constraint; - $self->compile_type_constraint(); return $self; @@ -35,7 +32,11 @@ sub new { sub _create_hand_optimized_type_constraint { my $self = shift; my $class = $self->class; - $self->hand_optimized_type_constraint(sub { blessed( $_[0] ) && $_[0]->isa($class) }); + $self->hand_optimized_type_constraint( + sub { + blessed( $_[0] ) && $_[0]->isa($class) + } + ); } sub parents { @@ -48,7 +49,9 @@ sub parents { # if anybody thinks this problematic please discuss on IRC. # a possible fix is to add by attr indexing to the type registry to find types of a certain property # regardless of their name - Moose::Util::TypeConstraints::find_type_constraint($_) || __PACKAGE__->new( name => $_ ) + Moose::Util::TypeConstraints::find_type_constraint($_) + || + __PACKAGE__->new( name => $_ ) } $self->class->meta->superclasses, ); } @@ -107,6 +110,8 @@ Moose::Meta::TypeConstraint::Class - Class/TypeConstraint parallel hierarchy =item B +=item B + =item B =item B diff --git a/lib/Moose/Meta/TypeConstraint/Enum.pm b/lib/Moose/Meta/TypeConstraint/Enum.pm index c823040..6360d53 100644 --- a/lib/Moose/Meta/TypeConstraint/Enum.pm +++ b/lib/Moose/Meta/TypeConstraint/Enum.pm @@ -1,18 +1,18 @@ -#!/usr/bin/perl - package Moose::Meta::TypeConstraint::Enum; use strict; use warnings; use metaclass; -our $VERSION = '0.06'; +use Moose::Util::TypeConstraints (); + +our $VERSION = '0.01'; our $AUTHORITY = 'cpan:STEVAN'; use base 'Moose::Meta::TypeConstraint'; __PACKAGE__->meta->add_attribute('values' => ( - accessor => 'values', + accessor => 'values', )); sub new { @@ -66,7 +66,7 @@ sub _compile_hand_optimized_type_constraint { sub { defined($_[0]) && !ref($_[0]) && exists $values{$_[0]} }; } -__PACKAGE__ +1; __END__ @@ -88,8 +88,29 @@ Moose::Meta::TypeConstraint::Enum - Type constraint for enumerated values. =item B +=item B + =back +=head1 BUGS + +All complex software has bugs lurking in it, and this module is no +exception. If you find a bug please either email me, or add the bug +to cpan-RT. + +=head1 AUTHOR + +Yuval Kogman Enothingmuch@cpan.orgE + +=head1 COPYRIGHT AND LICENSE + +Copyright 2006-2008 by Infinity Interactive, Inc. + +L + +This library is free software; you can redistribute it and/or modify +it under the same terms as Perl itself. + =cut diff --git a/t/020_attributes/020_trigger_and_coerce.t b/t/020_attributes/020_trigger_and_coerce.t new file mode 100644 index 0000000..73de6de --- /dev/null +++ b/t/020_attributes/020_trigger_and_coerce.t @@ -0,0 +1,63 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Test::More tests => 9; +use Test::Exception; + +BEGIN { + use_ok('Moose'); +} + +{ + package Fake::DateTime; + use Moose; + + has 'string_repr' => (is => 'ro'); + + package Mortgage; + use Moose; + use Moose::Util::TypeConstraints; + + coerce 'Fake::DateTime' + => from 'Str' + => via { Fake::DateTime->new(string_repr => $_) }; + + has 'closing_date' => ( + is => 'rw', + isa => 'Fake::DateTime', + coerce => 1, + trigger => sub { + my ( $self, $val, $meta ) = @_; + ::pass('... trigger is being called'); + ::isa_ok($self->closing_date, 'Fake::DateTime'); + ::isa_ok($val, 'Fake::DateTime'); + } + ); +} + +{ + my $mtg = Mortgage->new( closing_date => 'yesterday' ); + isa_ok($mtg, 'Mortgage'); + + # check that coercion worked + isa_ok($mtg->closing_date, 'Fake::DateTime'); +} + +Mortgage->meta->make_immutable; +ok(Mortgage->meta->is_immutable, '... Mortgage is now immutable'); + +{ + my $mtg = Mortgage->new( closing_date => 'yesterday' ); + isa_ok($mtg, 'Mortgage'); + + # check that coercion worked + isa_ok($mtg->closing_date, 'Fake::DateTime'); +} + + + + + +