X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMoose%2FCookbook%2FBasics%2FRecipe4.pod;h=325b43b82bea0a7d2417b3a68574641bf2c208e1;hb=53a4d826caec4b82f5b23e0bc0a4e8e2f44243b9;hp=857b9aa55b39ec5b07607e3dcf16932f5a264210;hpb=6549b0d1ae8b084898ac2d8ad60d6a57cccf4124;p=gitmo%2FMoose.git

diff --git a/lib/Moose/Cookbook/Basics/Recipe4.pod b/lib/Moose/Cookbook/Basics/Recipe4.pod
index 857b9aa..325b43b 100644
--- a/lib/Moose/Cookbook/Basics/Recipe4.pod
+++ b/lib/Moose/Cookbook/Basics/Recipe4.pod
@@ -1,6 +1,15 @@
 
 =pod
 
+=begin testing-SETUP
+
+use Test::Requires {
+    'Locale::US'     => '0',
+    'Regexp::Common' => '0',
+};
+
+=end testing-SETUP
+
 =head1 NAME
 
 Moose::Cookbook::Basics::Recipe4 - Subtypes, and modeling a simple B<Company> class hierarchy
@@ -43,19 +52,15 @@ Moose::Cookbook::Basics::Recipe4 - Subtypes, and modeling a simple B<Company> cl
 
   sub BUILD {
       my ( $self, $params ) = @_;
-      if ( $params->{employees} ) {
-          foreach my $employee ( @{ $params->{employees} } ) {
-              $employee->company($self);
-          }
+      foreach my $employee ( @{ $self->employees || [] } ) {
+          $employee->employer($self);
       }
   }
 
   after 'employees' => sub {
       my ( $self, $employees ) = @_;
-      if ( defined $employees ) {
-          foreach my $employee ( @{$employees} ) {
-              $employee->company($self);
-          }
+      foreach my $employee ( @{ $employees || [] } ) {
+          $employee->employer($self);
       }
   };
 
@@ -85,8 +90,8 @@ Moose::Cookbook::Basics::Recipe4 - Subtypes, and modeling a simple B<Company> cl
 
   extends 'Person';
 
-  has 'title'   => ( is => 'rw', isa => 'Str',     required => 1 );
-  has 'company' => ( is => 'rw', isa => 'Company', weak_ref => 1 );
+  has 'title'    => ( is => 'rw', isa => 'Str',     required => 1 );
+  has 'employer' => ( is => 'rw', isa => 'Company', weak_ref => 1 );
 
   override 'full_name' => sub {
       my $self = shift;
@@ -95,46 +100,40 @@ Moose::Cookbook::Basics::Recipe4 - Subtypes, and modeling a simple B<Company> cl
 
 =head1 DESCRIPTION
 
-In this recipe we introduce the C<subtype> keyword, and show
-how it can be useful for specifying type constraints
-without building an entire class to represent them. We
-will also show how this feature can be used to leverage the
-usefulness of CPAN modules. In addition to this, we will
-introduce another attribute option.
+This recipe introduces the C<subtype> sugar function from
+L<Moose::Util::TypeConstraints>. The C<subtype> function lets you
+declaratively create type constraints without building an entire
+class.
 
-Let's first look at the C<subtype> feature. In the B<Address> class we have
-defined two subtypes. The first C<subtype> uses the L<Locale::US> module, which
-provides two hashes which can be used to perform existential checks for state
-names and their two letter state codes. It is a very simple and very useful
-module, and perfect for use in a C<subtype> constraint.
+In the recipe we also make use of L<Locale::US> and L<Regexp::Common>
+to build constraints, showing how constraints can make use of existing
+CPAN tools for data validation.
 
-  my $STATES = Locale::US->new;
-  subtype 'USState'
-      => as Str
-      => where {
-             (    exists $STATES->{code2state}{ uc($_) }
-               || exists $STATES->{state2code}{ uc($_) } );
-         };
+Finally, we introduce the C<required> attribute option.
+
+In the C<Address> class we define two subtypes. The first uses the
+L<Locale::US> module to check the validity of a state. It accepts
+either a state abbreviation of full name.
 
-Because we know that states will be passed to us as strings, we
-can make C<USState> a subtype of the built-in type constraint
-C<Str>. This will ensure that anything which is a C<USState> will
-also pass as a C<Str>. Next, we create a constraint specializer
-using the C<where> keyword. The value being checked against in
-the C<where> clause can be found in the C<$_> variable (1). Our
-constraint specializer will then check whether the given string
-is either a state name or a state code. If the string meets this
-criteria, then the constraint will pass, otherwise it will fail.
-We can now use this as we would any built-in constraint, like so:
+A state will be passed in as a string, so we make our C<USState> type
+a subtype of Moose's builtin C<Str> type. This is done using the C<as>
+sugar. The actual constraint is defined using C<where>. This function
+accepts a single subroutine reference. That subroutine will be called
+with the value to be checked in C<$_> (1). It is expected to return a
+true or false value indicating whether the value is valid for the
+type.
+
+We can now use the C<USState> type just like Moose's builtin types:
 
   has 'state'    => ( is => 'rw', isa => 'USState' );
 
-The C<state> accessor will now check all values against the
-C<USState> constraint, thereby only allowing valid state names or
-state codes to be stored in the C<state> slot.
+When the C<state> attribute is set, the value is checked against the
+C<USState> constraint. If the value is not valid, an exception will be
+thrown.
 
-The next C<subtype> does pretty much the same thing using the L<Regexp::Common>
-module, and is used as the constraint for the C<zip_code> slot.
+The next C<subtype>, C<USZipCode>, uses
+L<Regexp::Common>. L<Regexp::Common> includes a regex for validating
+US zip codes. We use this constraint for the C<zip_code> attribute.
 
   subtype 'USZipCode'
       => as Value
@@ -142,124 +141,129 @@ module, and is used as the constraint for the C<zip_code> slot.
              /^$RE{zip}{US}{-extended => 'allow'}$/;
          };
 
-Using subtypes can save a lot of unnecessary abstraction by not requiring you to
-create many small classes for these relatively simple values. They also allow
-you to reuse the same constraints in a number of classes (thereby avoiding
-duplication), since all type constraints are stored in a global registry and
-always accessible to C<has>.
+Using a subtype instead of requiring a class for each type greatly
+simplifies the code. We don't really need a class for these types, as
+they're just strings, but we do want to ensure that they're valid.
+
+The type constraints we created are reusable. Type constraints are
+stored by name in a global registry. This means that we can refer to
+them in other classes. Because the registry is global, we do recommend
+that you use some sort of pseudo-namespacing in real applications,
+like C<MyApp.Type.USState>.
+
+These two subtypes allow us to define a simple C<Address> class.
 
-With these two subtypes and some attributes, we have defined
-as much as we need for a basic B<Address> class. Next, we define
-a basic B<Company> class, which itself has an address. As we saw in
-earlier recipes, we can use the C<Address> type constraint that
-Moose automatically created for us:
+Then we define our C<Company> class, which has an address. As we saw
+in earlier recipes, Moose automatically creates a type constraint for
+each our classes, so we can use that for the C<Company> class's
+C<address> attribute:
 
   has 'address'   => ( is => 'rw', isa => 'Address' );
 
-A company also needs a name, so we define that as well:
+A company also needs a name:
 
   has 'name' => ( is => 'rw', isa => 'Str', required => 1 );
 
-Here we introduce another attribute option, the C<required> option.
-This option tells Moose that C<name> is a required parameter in
-the B<Company> constructor, and that the C<name> accessor cannot
-accept an undefined value for the slot. The result is that C<name>
-will always have a value.
+This introduces a new attribute option, C<required>. If an attribute
+is required, then it must be passed to the class's constructor, or an
+exception will be thrown. It's important to understand that a
+C<required> attribute can still be false or C<undef>, if its type
+constraint allows that.
 
-The next attribute option is not actually new, but a new variant
-of options we have already introduced:
+The next attribute, C<employees>, uses a I<parameterized> type
+constraint:
 
   has 'employees' => ( is => 'rw', isa => 'ArrayRef[Employee]' );
 
-Here, we are passing a more complex string to the C<isa> option, we
-are passing a container type constraint. Container type constraints
-can either be C<ArrayRef> or C<HashRef> with a contained type given
-inside the square brackets. This basically checks that all the values
-in the ARRAY ref are instances of the B<Employee> class.
-
-This will ensure that our employees will all be of the correct type. However,
-the B<Employee> object (which we will see in a moment) also maintains a
-reference to its associated B<Company>. In order to maintain this relationship
-(and preserve the referential integrity of our objects), we need to perform 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<BUILD> method (2):
+This constraint says that C<employees> must be an array reference
+where each element of the array is an C<Employee> object. It's worth
+noting that an I<empty> array reference also satisfies this
+constraint.
+
+Parameterizable type constraints (or "container types"), such as
+C<ArrayRef[`a]>, can be made more specific with a type parameter. In
+fact, we can arbitrarily nest these types, producing something like
+C<HashRef[ArrayRef[Int]]>. However, you can also just use the type by
+itself, so C<ArrayRef> is legal. (2)
+
+If you jump down to the definition of the C<Employee> class, you will
+see that it has an C<employer> attribute.
+
+When we set the C<employees> for a C<Company> we want to make sure
+that each of these employee objects refers back to the right
+C<Company> in its C<employer> attribute.
+
+To do that, we need to hook into object construction. Moose lets us do
+this by writing a C<BUILD> method in our class. When your class
+defined a C<BUILD> method, it will be called immediately after an
+object construction, but before the object is returned to the caller
+(3).
+
+The C<Company> class uses the C<BUILD> method to ensure that each
+employee of a company has the proper C<Company> object in its
+C<employer> attribute:
 
   sub BUILD {
       my ( $self, $params ) = @_;
-      if ( $params->{employees} ) {
-          foreach my $employee ( @{ $params->{employees} } ) {
-              $employee->company($self);
-          }
+      foreach my $employee ( @{ $self->employees || [] } ) {
+          $employee->employer($self);
       }
   }
 
-The C<BUILD> method will be executed after the initial type constraint
-check, so we can simply perform a basic existential check on the C<employees>
-parameter here, and assume that if it does exist, it is both an ARRAY ref
-and contains I<only> instances of B<Employee>.
+The C<BUILD> method is executed after type constraints are checked, so it is
+safe to assume that if C<< $self->employees >> has a value, it will be an
+array reference, and that the elements of that array reference will be
+C<Employee> objects.
+
+We also want to make sure that whenever the C<employees> attribute for
+a C<Company> is changed, we also update the C<employer> for each
+employee.
 
-The next aspect we need to address is the C<employees> read/write
-accessor (see the C<employees> attribute declaration above). This
-accessor will correctly check the type constraint, but we need to extend it
-with some additional processing. For this we use an C<after> method modifier,
-like so:
+To do this we can use an C<after> modifier:
 
   after 'employees' => sub {
       my ( $self, $employees ) = @_;
-      if ( defined $employees ) {
-          foreach my $employee ( @{$employees} ) {
-              $employee->company($self);
-          }
+      foreach my $employee ( @{ $employees || [] } ) {
+          $employee->employer($self);
       }
   };
 
-Again, as with the C<BUILD> method, we know that the type constraint
-check has already happened, so we can just check for definedness on the
-C<$employees> argument.
-
-At this point, our B<Company> class is complete. Next comes our B<Person>
-class and its subclass, the previously mentioned B<Employee> class.
+Again, as with the C<BUILD> method, we know that the type constraint check has
+already happened, so we know that if C<$employees> is defined it will contain
+an array reference of C<Employee> objects..
 
-The B<Person> class should be obvious to you at this point. It has a few
-C<required> attributes, and the C<middle_initial> slot has an additional
-C<predicate> method (which we saw in the previous recipe with the
-B<BinaryTree> class).
+The B<Person> class does not really demonstrate anything new. It has several
+C<required> attributes. It also has a C<predicate> method, which we
+first used in L<recipe 3|Moose::Cookbook::Basics::Recipe3>.
 
-Next, the B<Employee> class, which should also be pretty obvious at this
-point. It requires a C<title>, and maintains a weakened 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:
+The only new feature in the C<Employee> class is the C<override>
+method modifier:
 
   override 'full_name' => sub {
       my $self = shift;
       super() . ', ' . $self->title;
   };
 
-This just tells Moose that I am intentionally 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.
+This is just a sugary alternative to Perl's built in C<SUPER::>
+feature. However, there is one difference. You cannot pass any
+arguments to C<super>. Instead, Moose simply passes the same
+parameters that were passed to the method.
 
-And that's 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/000_recipes/004_recipe.t>.
+A more detailed example of usage can be found in
+F<t/000_recipes/moose_cookbook_basics_recipe4.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 sheer 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, and so on).
+This recipe was intentionally longer and more complex. It illustrates
+how Moose classes can be used together with type constraints, as well
+as the density of information that you can get out of a small amount
+of typing when using Moose.
+
+This recipe also introduced the C<subtype> function, the C<required>
+attribute, and the C<override> method modifier.
 
-And of course, this recipe also introduced the C<subtype> keyword, and
-its usefulness within the Moose toolkit. In the next recipe we will
-focus more on subtypes, and introduce the idea of type coercion as well.
+We will revisit type constraints in future recipes, and cover type
+coercion as well.
 
 =head1 FOOTNOTES
 
@@ -268,29 +272,244 @@ focus more on subtypes, and introduce the idea of type coercion as well.
 =item (1)
 
 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.
+the C<where> block, so it can be accessed as C<$_[0]>.
 
 =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
-inheritance graph and call the appropriate C<BUILD> methods in the
-correct order.
+Note that C<ArrayRef[]> will not work. Moose will not parse this as a
+container type, and instead you will have a new type named
+"ArrayRef[]", which doesn't make any sense.
+
+=item (3)
+
+The C<BUILD> method is actually called by C<< Moose::Object->BUILDALL
+>>, which is called by C<< Moose::Object->new >>. The C<BUILDALL>
+method climbs the object inheritance graph and calls any C<BUILD>
+methods it finds in the correct order.
 
 =back
 
-=head1 AUTHOR
+=head1 AUTHORS
 
 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 
+Dave Rolsky E<lt>autarch@urth.orgE<gt>
+
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 2006-2009 by Infinity Interactive, Inc.
+Copyright 2006-2010 by Infinity Interactive, Inc.
 
 L<http://www.iinteractive.com>
 
 This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself.
 
+=begin testing
+
+{
+    package Company;
+
+    sub get_employee_count { scalar @{(shift)->employees} }
+}
+
+use Scalar::Util 'isweak';
+
+my $ii;
+lives_ok {
+    $ii = Company->new(
+        {
+            name    => 'Infinity Interactive',
+            address => Address->new(
+                street   => '565 Plandome Rd., Suite 307',
+                city     => 'Manhasset',
+                state    => 'NY',
+                zip_code => '11030'
+            ),
+            employees => [
+                Employee->new(
+                    first_name => 'Jeremy',
+                    last_name  => 'Shao',
+                    title      => 'President / Senior Consultant',
+                    address =>
+                        Address->new( city => 'Manhasset', state => 'NY' )
+                ),
+                Employee->new(
+                    first_name => 'Tommy',
+                    last_name  => 'Lee',
+                    title      => 'Vice President / Senior Developer',
+                    address =>
+                        Address->new( city => 'New York', state => 'NY' )
+                ),
+                Employee->new(
+                    first_name     => 'Stevan',
+                    middle_initial => 'C',
+                    last_name      => 'Little',
+                    title          => 'Senior Developer',
+                    address =>
+                        Address->new( city => 'Madison', state => 'CT' )
+                ),
+            ]
+        }
+    );
+}
+'... created the entire company successfully';
+isa_ok( $ii, 'Company' );
+
+is( $ii->name, 'Infinity Interactive',
+    '... got the right name for the company' );
+
+isa_ok( $ii->address, 'Address' );
+is( $ii->address->street, '565 Plandome Rd., Suite 307',
+    '... got the right street address' );
+is( $ii->address->city,     'Manhasset', '... got the right city' );
+is( $ii->address->state,    'NY',        '... got the right state' );
+is( $ii->address->zip_code, 11030,       '... got the zip code' );
+
+is( $ii->get_employee_count, 3, '... got the right employee count' );
+
+# employee #1
+
+isa_ok( $ii->employees->[0], 'Employee' );
+isa_ok( $ii->employees->[0], 'Person' );
+
+is( $ii->employees->[0]->first_name, 'Jeremy',
+    '... got the right first name' );
+is( $ii->employees->[0]->last_name, 'Shao', '... got the right last name' );
+ok( !$ii->employees->[0]->has_middle_initial, '... no middle initial' );
+is( $ii->employees->[0]->middle_initial, undef,
+    '... got the right middle initial value' );
+is( $ii->employees->[0]->full_name,
+    'Jeremy Shao, President / Senior Consultant',
+    '... got the right full name' );
+is( $ii->employees->[0]->title, 'President / Senior Consultant',
+    '... got the right title' );
+is( $ii->employees->[0]->employer, $ii, '... got the right company' );
+ok( isweak( $ii->employees->[0]->{employer} ),
+    '... the company is a weak-ref' );
+
+isa_ok( $ii->employees->[0]->address, 'Address' );
+is( $ii->employees->[0]->address->city, 'Manhasset',
+    '... got the right city' );
+is( $ii->employees->[0]->address->state, 'NY', '... got the right state' );
+
+# employee #2
+
+isa_ok( $ii->employees->[1], 'Employee' );
+isa_ok( $ii->employees->[1], 'Person' );
+
+is( $ii->employees->[1]->first_name, 'Tommy',
+    '... got the right first name' );
+is( $ii->employees->[1]->last_name, 'Lee', '... got the right last name' );
+ok( !$ii->employees->[1]->has_middle_initial, '... no middle initial' );
+is( $ii->employees->[1]->middle_initial, undef,
+    '... got the right middle initial value' );
+is( $ii->employees->[1]->full_name,
+    'Tommy Lee, Vice President / Senior Developer',
+    '... got the right full name' );
+is( $ii->employees->[1]->title, 'Vice President / Senior Developer',
+    '... got the right title' );
+is( $ii->employees->[1]->employer, $ii, '... got the right company' );
+ok( isweak( $ii->employees->[1]->{employer} ),
+    '... the company is a weak-ref' );
+
+isa_ok( $ii->employees->[1]->address, 'Address' );
+is( $ii->employees->[1]->address->city, 'New York',
+    '... got the right city' );
+is( $ii->employees->[1]->address->state, 'NY', '... got the right state' );
+
+# employee #3
+
+isa_ok( $ii->employees->[2], 'Employee' );
+isa_ok( $ii->employees->[2], 'Person' );
+
+is( $ii->employees->[2]->first_name, 'Stevan',
+    '... got the right first name' );
+is( $ii->employees->[2]->last_name, 'Little', '... got the right last name' );
+ok( $ii->employees->[2]->has_middle_initial, '... got middle initial' );
+is( $ii->employees->[2]->middle_initial, 'C',
+    '... got the right middle initial value' );
+is( $ii->employees->[2]->full_name, 'Stevan C. Little, Senior Developer',
+    '... got the right full name' );
+is( $ii->employees->[2]->title, 'Senior Developer',
+    '... got the right title' );
+is( $ii->employees->[2]->employer, $ii, '... got the right company' );
+ok( isweak( $ii->employees->[2]->{employer} ),
+    '... the company is a weak-ref' );
+
+isa_ok( $ii->employees->[2]->address, 'Address' );
+is( $ii->employees->[2]->address->city, 'Madison', '... got the right city' );
+is( $ii->employees->[2]->address->state, 'CT', '... 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->employer, $ii, '... has the ii company' );
+}
+
+$new_company->employees($ii_employees);
+
+foreach my $employee ( @{ $new_company->employees } ) {
+    is( $employee->employer, $new_company,
+        '... has the different company now' );
+}
+
+## check some error conditions for the subtypes
+
+dies_ok {
+    Address->new( street => {} ),;
+}
+'... we die correctly with bad args';
+
+dies_ok {
+    Address->new( city => {} ),;
+}
+'... we die correctly with bad args';
+
+dies_ok {
+    Address->new( state => 'British Columbia' ),;
+}
+'... we die correctly with bad args';
+
+lives_ok {
+    Address->new( state => 'Connecticut' ),;
+}
+'... we live correctly with good args';
+
+dies_ok {
+    Address->new( zip_code => 'AF5J6$' ),;
+}
+'... we die correctly with bad args';
+
+lives_ok {
+    Address->new( zip_code => '06443' ),;
+}
+'... we live correctly with good args';
+
+dies_ok {
+    Company->new(),;
+}
+'... we die correctly without good args';
+
+lives_ok {
+    Company->new( name => 'Foo' ),;
+}
+'... we live correctly without good args';
+
+dies_ok {
+    Company->new( name => 'Foo', employees => [ Person->new ] ),;
+}
+'... we die correctly with good args';
+
+lives_ok {
+    Company->new( name => 'Foo', employees => [] ),;
+}
+'... we live correctly with good args';
+
+=end testing
+
 =cut