From: Stevan Little Date: Sun, 14 May 2006 03:51:32 +0000 (+0000) Subject: docs-n-attr-refactor X-Git-Tag: 0_09_03~17 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9e93dd19f8c035b497ddc9ed8a8628e66042015e;p=gitmo%2FMoose.git docs-n-attr-refactor --- diff --git a/lib/Moose.pm b/lib/Moose.pm index e073a15..8a570c9 100644 --- a/lib/Moose.pm +++ b/lib/Moose.pm @@ -433,6 +433,11 @@ reference. If an attribute is a weakened reference, it can B also be coerce This will tell the class to not create this slot until absolutely nessecary. If an attribute is marked as lazy it B have a default supplied. +=item I (1|0)> + +This tells the accessor whether to automatically de-reference the value returned. +This is only legal if your C option is either an C or C. + =item I $code> The trigger option is a CODE reference which will be called after the value of @@ -532,12 +537,8 @@ more :) =item Most Other Object Systems Emasculate -=item My Overcraft Overfilled (with) Some Eels - =item Moose Often Ovulate Sorta Early -=item Many Overloaded Object Systems Exists - =item Moose Offers Often Super Extensions =item Meta Object Orientation Syntax Extensions diff --git a/lib/Moose/Cookbook/Recipe6.pod b/lib/Moose/Cookbook/Recipe6.pod index 42c2381..88911a3 100644 --- a/lib/Moose/Cookbook/Recipe6.pod +++ b/lib/Moose/Cookbook/Recipe6.pod @@ -6,7 +6,7 @@ Moose::Cookbook::Recipe6 - The Moose::Role example =head1 SYNOPSIS - + package Eq; use strict; use warnings; @@ -16,10 +16,10 @@ Moose::Cookbook::Recipe6 - The Moose::Role example sub not_equal_to { my ($self, $other) = @_; - !$self->equal_to($other); + not $self->equal_to($other); } - package Ord; + package Comparable; use strict; use warnings; use Moose::Role; @@ -51,22 +51,34 @@ Moose::Cookbook::Recipe6 - The Moose::Role example sub less_than_or_equal_to { my ($self, $other) = @_; $self->less_than($other) || $self->equal_to($other); - } + } + + package Printable; + use strict; + use warnings; + use Moose::Role; + + requires 'to_string'; package US::Currency; use strict; use warnings; use Moose; - with 'Ord'; + with 'Comparable', 'Printable'; - has 'amount' => (is => 'rw', isa => 'Int', default => 0); + has 'amount' => (is => 'rw', isa => 'Num', default => 0); sub compare { my ($self, $other) = @_; $self->amount <=> $other->amount; } + sub to_string { + my $self = shift; + sprintf '$%0.2f USD' => $self->amount + } + =head1 DESCRIPTION Coming Soon. diff --git a/lib/Moose/Meta/Attribute.pm b/lib/Moose/Meta/Attribute.pm index 596f8a6..c806cde 100644 --- a/lib/Moose/Meta/Attribute.pm +++ b/lib/Moose/Meta/Attribute.pm @@ -222,6 +222,8 @@ sub initialize_instance_slot { if ref $val && $self->is_weak_ref; } +## Accessor inline subroutines + sub _inline_check_constraint { my ($self, $value) = @_; return '' unless $self->has_type_constraint; @@ -235,6 +237,26 @@ defined($attr->type_constraint->check(%s)) EOF } +sub _inline_check_coercion { + my $self = shift; + return '' unless $self->should_coerce; + return 'my $val = $attr->type_constraint->coercion->coerce($_[1]);' +} + +sub _inline_check_required { + my $self = shift; + return '' unless $self->is_required; + return 'defined($_[1]) || confess "Attribute ($attr_name) is required, so cannot be set to undef";' +} + +sub _inline_check_lazy { + my $self = shift; + return '' unless $self->is_lazy; + return '$_[0]->{$attr_name} = ($attr->has_default ? $attr->default($_[0]) : undef)' + . 'unless exists $_[0]->{$attr_name};'; +} + + sub _inline_store { my ($self, $instance, $value) = @_; @@ -291,24 +313,16 @@ sub generate_accessor_method { my $inv = '$_[0]'; my $code = 'sub { ' . 'if (scalar(@_) == 2) {' - . ($attr->is_required ? - 'defined($_[1]) || confess "Attribute ($attr_name) is required, so cannot be set to undef";' - : '') - . ($attr->should_coerce ? - 'my $val = $attr->type_constraint->coercion->coerce($_[1]);' - : '') + . $attr->_inline_check_required + . $attr->_inline_check_coercion . $attr->_inline_check_constraint($value_name) . $attr->_inline_store($inv, $value_name) . $attr->_inline_trigger($inv, $value_name) . ' }' - . ($attr->is_lazy ? - '$_[0]->{$attr_name} = ($attr->has_default ? $attr->default($_[0]) : undef)' - . 'unless exists $_[0]->{$attr_name};' - : '') + . $attr->_inline_check_lazy . 'return ' . $attr->_inline_auto_deref($attr->_inline_get($inv)) . ' }'; my $sub = eval $code; - warn "Could not create accessor for '$attr_name' because $@ \n code: $code" if $@; confess "Could not create accessor for '$attr_name' because $@ \n code: $code" if $@; return $sub; } @@ -318,12 +332,8 @@ sub generate_writer_method { my $value_name = $attr->should_coerce ? '$val' : '$_[1]'; my $inv = '$_[0]'; my $code = 'sub { ' - . ($attr->is_required ? - 'defined($_[1]) || confess "Attribute ($attr_name) is required, so cannot be set to undef";' - : '') - . ($attr->should_coerce ? - 'my $val = $attr->type_constraint->coercion->coerce($_[1]);' - : '') + . $attr->_inline_check_required + . $attr->_inline_check_coercion . $attr->_inline_check_constraint($value_name) . $attr->_inline_store($inv, $value_name) . $attr->_inline_trigger($inv, $value_name) @@ -334,15 +344,12 @@ sub generate_writer_method { } sub generate_reader_method { - my $self = shift; - my $attr_name = $self->slots; + my $attr = shift; + my $attr_name = $attr->slots; my $code = 'sub {' . 'confess "Cannot assign a value to a read-only accessor" if @_ > 1;' - . ($self->is_lazy ? - '$_[0]->{$attr_name} = ($self->has_default ? $self->default($_[0]) : undef)' - . 'unless exists $_[0]->{$attr_name};' - : '') - . 'return ' . $self->_inline_auto_deref( '$_[0]->{$attr_name}' ) . ';' + . $attr->_inline_check_lazy + . 'return ' . $attr->_inline_auto_deref( '$_[0]->{$attr_name}' ) . ';' . '}'; my $sub = eval $code; confess "Could not create reader for '$attr_name' because $@ \n code: $code" if $@; @@ -488,8 +495,6 @@ will behave just as L does. =item B -=item B - =item B =item B @@ -509,6 +514,12 @@ creation and type coercion. =over 4 +=item B + +This is to support the C feature, it clones an attribute +from a superclass and allows a very specific set of changes to be made +to the attribute. + =item B Returns true if this meta-attribute has a type constraint. diff --git a/lib/Moose/Meta/Class.pm b/lib/Moose/Meta/Class.pm index 03e00ad..5a6500d 100644 --- a/lib/Moose/Meta/Class.pm +++ b/lib/Moose/Meta/Class.pm @@ -256,26 +256,10 @@ This will test if this class C a given C<$role_name>. It will not only check it's local roles, but ask them as well in order to cascade down the role hierarchy. -=item B +=item B -This method does the same thing as L, but adds -suport for delegation. - -=back - -=head1 INTERNAL METHODS - -=over 4 - -=item compute_delegation - -=item generate_delegation_list - -=item generate_delgate_method - -=item get_delegatable_methods - -=item filter_delegations +This method does the same thing as L, but adds +support for taking the C<$params> as a HASH ref. =back diff --git a/lib/Moose/Meta/Instance.pm b/lib/Moose/Meta/Instance.pm index dde645e..3e3f831 100644 --- a/lib/Moose/Meta/Instance.pm +++ b/lib/Moose/Meta/Instance.pm @@ -20,7 +20,10 @@ Moose::Meta::Instance - The Moose Instance metaclass =head1 DESCRIPTION -=head1 METHODS +This is a stub mostly, but I know I will want to use it later on. + +See the L docs for details on the instance +protocol. =head1 BUGS diff --git a/lib/Moose/Role.pm b/lib/Moose/Role.pm index 5c21323..bee7fb9 100644 --- a/lib/Moose/Role.pm +++ b/lib/Moose/Role.pm @@ -217,8 +217,15 @@ Moose::Role also offers two role specific keyword exports: =item B +Roles can require that certain methods are implemented by any class which +C the role. + =item B +Roles can C other roles, in effect saying "I can never be combined +with these C<@role_names>". This is a feature which should not be used +lightly. + =back =head1 CAVEATS diff --git a/lib/Moose/Util/TypeConstraints.pm b/lib/Moose/Util/TypeConstraints.pm index 5d5f86f..e5b9e99 100644 --- a/lib/Moose/Util/TypeConstraints.pm +++ b/lib/Moose/Util/TypeConstraints.pm @@ -12,14 +12,17 @@ our $VERSION = '0.07'; use Moose::Meta::TypeConstraint; use Moose::Meta::TypeCoercion; -use Sub::Exporter - -setup => { - exports => qw[type subtype as where message coerce from via find_type_constraint enum], - groups => { - default => [':all'] - } +use Sub::Exporter -setup => { + exports => [qw/ + type subtype as where message + coerce from via + enum + find_type_constraint + /], + groups => { + default => [':all'] } -); +}; { my %TYPES; diff --git a/t/006_recipe.t b/t/006_recipe.t index 27f79ea..514444b 100644 --- a/t/006_recipe.t +++ b/t/006_recipe.t @@ -3,7 +3,7 @@ use strict; use warnings; -use Test::More tests => 52; +use Test::More tests => 62; use Test::Exception; BEGIN { @@ -22,10 +22,10 @@ BEGIN { sub not_equal_to { my ($self, $other) = @_; - !$self->equal_to($other); + not $self->equal_to($other); } - package Ord; + package Comparable; use strict; use warnings; use Moose::Role; @@ -57,7 +57,14 @@ BEGIN { sub less_than_or_equal_to { my ($self, $other) = @_; $self->less_than($other) || $self->equal_to($other); - } + } + + package Printable; + use strict; + use warnings; + use Moose::Role; + + requires 'to_string'; } ## Classes @@ -68,7 +75,7 @@ BEGIN { use warnings; use Moose; - with 'Ord'; + with 'Comparable', 'Printable'; has 'amount' => (is => 'rw', isa => 'Num', default => 0); @@ -76,10 +83,16 @@ BEGIN { my ($self, $other) = @_; $self->amount <=> $other->amount; } + + sub to_string { + my $self = shift; + sprintf '$%0.2f USD' => $self->amount + } } -ok(US::Currency->does('Ord'), '... US::Currency does Ord'); +ok(US::Currency->does('Comparable'), '... US::Currency does Comparable'); ok(US::Currency->does('Eq'), '... US::Currency does Eq'); +ok(US::Currency->does('Printable'), '... US::Currency does Printable'); my $hundred = US::Currency->new(amount => 100.00); isa_ok($hundred, 'US::Currency'); @@ -87,8 +100,12 @@ isa_ok($hundred, 'US::Currency'); can_ok($hundred, 'amount'); is($hundred->amount, 100, '... got the right amount'); -ok($hundred->does('Ord'), '... US::Currency does Ord'); +can_ok($hundred, 'to_string'); +is($hundred->to_string, '$100.00 USD', '... got the right stringified value'); + +ok($hundred->does('Comparable'), '... US::Currency does Comparable'); ok($hundred->does('Eq'), '... US::Currency does Eq'); +ok($hundred->does('Printable'), '... US::Currency does Printable'); my $fifty = US::Currency->new(amount => 50.00); isa_ok($fifty, 'US::Currency'); @@ -96,6 +113,9 @@ isa_ok($fifty, 'US::Currency'); can_ok($fifty, 'amount'); is($fifty->amount, 50, '... got the right amount'); +can_ok($fifty, 'to_string'); +is($fifty->to_string, '$50.00 USD', '... got the right stringified value'); + ok($hundred->greater_than($fifty), '... 100 gt 50'); ok($hundred->greater_than_or_equal_to($fifty), '... 100 ge 50'); ok(!$hundred->less_than($fifty), '... !100 lt 50'); @@ -127,37 +147,46 @@ isa_ok($eq_meta, 'Moose::Meta::Role'); ok($eq_meta->has_method('not_equal_to'), '... Eq has_method not_equal_to'); ok($eq_meta->requires_method('equal_to'), '... Eq requires_method not_equal_to'); -# Ord +# Comparable -my $ord_meta = Ord->meta; -isa_ok($ord_meta, 'Moose::Meta::Role'); +my $comparable_meta = Comparable->meta; +isa_ok($comparable_meta, 'Moose::Meta::Role'); -ok($ord_meta->does_role('Eq'), '... Ord does Eq'); +ok($comparable_meta->does_role('Eq'), '... Comparable does Eq'); foreach my $method_name (qw( equal_to not_equal_to greater_than greater_than_or_equal_to less_than less_than_or_equal_to )) { - ok($ord_meta->has_method($method_name), '... Ord has_method ' . $method_name); + ok($comparable_meta->has_method($method_name), '... Comparable has_method ' . $method_name); } -ok($ord_meta->requires_method('compare'), '... Ord requires_method compare'); +ok($comparable_meta->requires_method('compare'), '... Comparable requires_method compare'); + +# Printable + +my $printable_meta = Printable->meta; +isa_ok($printable_meta, 'Moose::Meta::Role'); + +ok($printable_meta->requires_method('to_string'), '... Printable requires_method to_string'); # US::Currency my $currency_meta = US::Currency->meta; isa_ok($currency_meta, 'Moose::Meta::Class'); -ok($currency_meta->does_role('Ord'), '... US::Currency does Ord'); +ok($currency_meta->does_role('Comparable'), '... US::Currency does Comparable'); ok($currency_meta->does_role('Eq'), '... US::Currency does Eq'); +ok($currency_meta->does_role('Printable'), '... US::Currency does Printable'); foreach my $method_name (qw( amount equal_to not_equal_to compare greater_than greater_than_or_equal_to - less_than less_than_or_equal_to + less_than less_than_or_equal_to + to_string )) { ok($currency_meta->has_method($method_name), '... US::Currency has_method ' . $method_name); } diff --git a/t/030_attribute_reader_generation.t b/t/030_attribute_reader_generation.t index b16f797..fd47d35 100644 --- a/t/030_attribute_reader_generation.t +++ b/t/030_attribute_reader_generation.t @@ -30,7 +30,7 @@ BEGIN { default => sub { 10 } ); }; - ::ok(!$@, '... created the lazy reader method okay'); + ::ok(!$@, '... created the lazy reader method okay') or warn $@; } {