Add tool for extracting inline tests.
[gitmo/Moose.git] / lib / Moose / Cookbook / Basics / Recipe4.pod
index f6748f7..6e150f5 100644 (file)
@@ -1,6 +1,19 @@
 
 =pod
 
+=begin testing SETUP
+
+BEGIN {
+    eval 'use Regexp::Common; use Locale::US;';
+    if ($@) {
+        diag 'Regexp::Common & Locale::US required for this test';
+        ok(1);
+        exit 0;
+    }
+}
+
+=end testing
+
 =head1 NAME
 
 Moose::Cookbook::Basics::Recipe4 - Subtypes, and modeling a simple B<Company> class hierarchy
@@ -43,9 +56,9 @@ Moose::Cookbook::Basics::Recipe4 - Subtypes, and modeling a simple B<Company> cl
 
   sub BUILD {
       my ( $self, $params ) = @_;
-      if ( @{ $self->employees } ) {
+      if ( @{ $self->employees || [] } ) {
           foreach my $employee ( @{ $self->employees } ) {
-              $employee->company($self);
+              $employee->employer($self);
           }
       }
   }
@@ -54,7 +67,7 @@ Moose::Cookbook::Basics::Recipe4 - Subtypes, and modeling a simple B<Company> cl
       my ( $self, $employees ) = @_;
       if ($employees) {
           foreach my $employee ( @{$employees} ) {
-              $employee->company($self);
+              $employee->employer($self);
           }
       }
   };
@@ -202,7 +215,7 @@ C<employer> attribute:
       my ( $self, $params ) = @_;
       if ( $self->employees ) {
           foreach my $employee ( @{ $self->employees } ) {
-              $employee->company($self);
+              $employee->employer($self);
           }
       }
   }
@@ -222,7 +235,7 @@ To do this we can use an C<after> modifier:
       my ( $self, $employees ) = @_;
       if ($employees) {
           foreach my $employee ( @{$employees} ) {
-              $employee->company($self);
+              $employee->employer($self);
           }
       }
   };
@@ -249,7 +262,7 @@ arguments to C<super>. Instead, Moose simply passes the same
 parameters that were passed to the method.
 
 A more detailed example of usage can be found in
-F<t/000_recipes/004_recipe.t>.
+F<t/000_recipes/moose_cookbook_basics_recipe4.t>.
 
 =head1 CONCLUSION
 
@@ -303,4 +316,212 @@ 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