From: Stevan Little Date: Thu, 30 Mar 2006 16:16:50 +0000 (+0000) Subject: recipe4 X-Git-Tag: 0_05~53 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=ad5ed80c0d3c2d0c181e7de843c0d83b075471d7;p=gitmo%2FMoose.git recipe4 --- diff --git a/lib/Moose/Cookbook/Recipe4.pod b/lib/Moose/Cookbook/Recipe4.pod index 26265a5..c2a4701 100644 --- a/lib/Moose/Cookbook/Recipe4.pod +++ b/lib/Moose/Cookbook/Recipe4.pod @@ -3,7 +3,7 @@ =head1 NAME -Moose::Cookbook::Recipe4 +Moose::Cookbook::Recipe4 - Modeling a simple B class =head1 SYNOPSIS @@ -43,7 +43,7 @@ Moose::Cookbook::Recipe4 has 'name' => (is => 'rw', isa => 'Str', required => 1); has 'address' => (is => 'rw', isa => 'Address'); has 'employees' => (is => 'rw', isa => subtype ArrayRef => where { - ($_->isa('Employee') || return) for @$_; 1 + (blessed($_) && $_->isa('Employee') || return) for @$_; 1 }); sub BUILD { @@ -55,7 +55,14 @@ Moose::Cookbook::Recipe4 } } - sub get_employee_count { scalar @{(shift)->employees} } + after 'employees' => sub { + my ($self, $employees) = @_; + if (defined $employees) { + foreach my $employee (@{$employees}) { + $employee->company($self); + } + } + }; package Person; use strict; @@ -168,6 +175,103 @@ the B constructor, and that the C accessor cannot accept an undefined value for the slot. The result is that C should always have a value. +The next attribute option is not actually a new one, but a new varient +of options we have already introduced. + + has 'employees' => (is => 'rw', isa => subtype ArrayRef => where { + (blessed($_) && $_->isa('Employee') || return) for @$_; 1 + }); + +Here, instead of passing a string to the C option, we are passing +an anyonomous subtype of the C type constraint. This subtype +basically checks that all the values in the ARRAY ref are instance of +the B class. + +Now this will assure that our employee's will all be of the correct +type, however, the B object (which we will see in a moment) +also maintains a reference back to it's associated B. In order +to maintain this relationship (and preserve the referential integrity +of our objects), we need to do some processing of the employees over +and above that of the type constraint check. This is accomplished in +two places. First we need to be sure that any employees array passed +to the constructor is properly initialized. For this we can use the +C method (2). + + sub BUILD { + my ($self, $params) = @_; + if ($params->{employees}) { + foreach my $employee (@{$params->{employees}}) { + $employee->company($self); + } + } + } + +The C method will have run after the intial type constraint +check, so we can do just a basic existence check on the C +param here, and assume that if it does exist, it is both an ARRAY ref +and full of I instances of B. + +The next place we need to address is the C read/write +accessor (see the C attribute declaration above). This +accessor will properly check the type constraint, but we need to add +so additional behavior. For this we use an C method modifier +like so: + + after 'employees' => sub { + my ($self, $employees) = @_; + if (defined $employees) { + foreach my $employee (@{$employees}) { + $employee->company($self); + } + } + }; + +Again, as with the C method, we know that the type constraint +check has already happened, so we can just check for defined-ness on the +C<$employees> argument. + +At this point, our B class is complete. Next comes our B +class and it's subclass the previously mentioned B class. + +The B class should be obvious to you at this point. It has a few +C attributes, and the C slot has an additional +C method (which we saw in the previous recipe with the +B class). + +Next the B class, this too should be pretty obvious at this +point. It requires a C, and maintains a weakend reference to a +B<Company> instance. The only new item, which we have seen before in +examples, but never in the recipe itself, is the C<override> method +modifier. + + override 'full_name' => sub { + my $self = shift; + super() . ', ' . $self->title + }; + +This just tells Moose that I am intetionally overriding the superclass +C<full_name> method here, and adding the value of the C<title> slot at +the end of the employee's full name. + +And thats about it. + +Once again, as with all the other recipes, you can go about using +these classes like any other Perl 5 class. A more detailed example of +usage can be found in F<t/004_basic.t>. + +=head1 CONCLUSION + +This recipe was intentionally longer and more complex to illustrate both +how easily Moose classes can interact (using class type constraints, etc.) +and the shear density of information and behaviors which Moose can pack +into a relatively small amount of typing. Ponder for a moment how much +more code a non-Moose plain old Perl 5 version of this recipe would have +been (including all the type constraint checks, weak references, etc). + +And of course, this recipe also introduced the C<subtype> keyword, and +it's usefulness within the Moose toolkit. In the next recipe we will +focus more on subtypes, and introduce the idea of type coercion as well. + =head1 FOOTNOTES =over 4 @@ -178,6 +282,13 @@ The value being checked is also passed as the first argument to the C<where> block as well, so it can also be accessed as C<$_[0]> as well. +=item (2) + +The C<BUILD> method is called by C<Moose::Object::BUILDALL>, which is +called by C<Moose::Object::new>. C<BUILDALL> will climb the object +inheritence graph and call the approriate C<BUILD> methods in the +correct order. + =back =head1 AUTHOR diff --git a/lib/Moose/Cookbook/Recipe5.pod b/lib/Moose/Cookbook/Recipe5.pod index 6bc325d..bcace64 100644 --- a/lib/Moose/Cookbook/Recipe5.pod +++ b/lib/Moose/Cookbook/Recipe5.pod @@ -40,7 +40,6 @@ Moose::Cookbook::Recipe5 => as Str => where { /^HTTP\/[0-9]\.[0-9]$/ }; - has 'base' => (is => 'rw', isa => 'Uri', coerce => 1); has 'url' => (is => 'rw', isa => 'Uri', coerce => 1); has 'method' => (is => 'rw', isa => 'Str'); diff --git a/t/004_basic.t b/t/004_basic.t index 0a69fab..4a68090 100644 --- a/t/004_basic.t +++ b/t/004_basic.t @@ -8,7 +8,7 @@ use Test::More; BEGIN { eval "use Regexp::Common; use Locale::US;"; plan skip_all => "Regexp::Common & Locale::US required for this test" if $@; - plan tests => 72; + plan tests => 81; } use Test::Exception; @@ -54,7 +54,7 @@ BEGIN { has 'name' => (is => 'rw', isa => 'Str', required => 1); has 'address' => (is => 'rw', isa => 'Address'); has 'employees' => (is => 'rw', isa => subtype ArrayRef => where { - ($_->isa('Employee') || return) for @$_; 1 + (blessed($_) && $_->isa('Employee') || return) for @$_; 1 }); sub BUILD { @@ -68,6 +68,19 @@ BEGIN { sub get_employee_count { scalar @{(shift)->employees} } + after 'employees' => sub { + my ($self, $employees) = @_; + # if employees is defined, it + # has already been type checked + if (defined $employees) { + # make sure each gets the + # weak ref to the company + foreach my $employee (@{$employees}) { + $employee->company($self); + } + } + }; + package Person; use strict; use warnings; @@ -224,6 +237,22 @@ isa_ok($ii->employees->[3]->address, 'Address'); is($ii->employees->[3]->address->city, 'Marysville', '... got the right city'); is($ii->employees->[3]->address->state, 'OH', '... got the right state'); +# create new company + +my $new_company = Company->new(name => 'Infinity Interactive International'); +isa_ok($new_company, 'Company'); + +my $ii_employees = $ii->employees; +foreach my $employee (@$ii_employees) { + is($employee->company, $ii, '... has the ii company'); +} + +$new_company->employees($ii_employees); + +foreach my $employee (@{$new_company->employees}) { + is($employee->company, $new_company, '... has the different company now'); +} + ## check some error conditions for the subtypes dies_ok {