more-stuff
Stevan Little [Sun, 26 Mar 2006 02:52:13 +0000 (02:52 +0000)]
lib/Moose/Cookbook/Recipe3.pod
lib/Moose/Cookbook/Recipe4.pod
t/003_basic.t
t/004_basic.t

index 5ddd267..87ba270 100644 (file)
@@ -22,13 +22,17 @@ Moose::Cookbook::Recipe3
   has 'left' => (
          is        => 'rw',    
          isa       => 'BinaryTree',            
-      predicate => 'has_left',         
+      predicate => 'has_left',  
+      lazy      => 1,
+      default   => sub { BinaryTree->new(parent => $_[0]) },       
   );
   
   has 'right' => (
          is        => 'rw',    
          isa       => 'BinaryTree',            
-      predicate => 'has_right',           
+      predicate => 'has_right',   
+      lazy      => 1,       
+      default   => sub { BinaryTree->new(parent => $_[0]) },       
   );
   
   before 'right', 'left' => sub {
index 9bef18b..b4f38ed 100644 (file)
@@ -39,7 +39,7 @@ Moose::Cookbook::Recipe4
   use warnings;
   use Moose;
   
-  has 'name'      => (is => 'rw', isa => 'Str');
+  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 
@@ -61,8 +61,8 @@ Moose::Cookbook::Recipe4
   use warnings;
   use Moose;
   
-  has 'first_name'     => (is => 'rw', isa => 'Str');
-  has 'last_name'      => (is => 'rw', isa => 'Str');       
+  has 'first_name'     => (is => 'rw', isa => 'Str', required => 1);
+  has 'last_name'      => (is => 'rw', isa => 'Str', required => 1);       
   has 'middle_initial' => (is => 'rw', isa => 'Str', predicate => 'has_middle_initial');  
   has 'address'        => (is => 'rw', isa => 'Address');
   
@@ -80,14 +80,14 @@ Moose::Cookbook::Recipe4
   
   extends 'Person';
   
-  has 'title'   => (is => 'rw', isa => 'Str');
+  has 'title'   => (is => 'rw', isa => 'Str', required => 1);
   has 'company' => (is => 'rw', isa => 'Company', weak_ref => 1);  
   
   override 'full_name' => sub {
       my $self = shift;
       super() . ', ' . $self->title
   };
-  
+    
 =head1 DESCRIPTION
 
 =head1 AUTHOR
index 57d10dd..c558dc4 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 27;
+use Test::More tests => 25;
 use Test::Exception;
 
 use Scalar::Util 'isweak';
@@ -28,56 +28,39 @@ BEGIN {
     has 'left' => (
                is        => 'rw',      
                isa       => 'BinaryTree',              
-        predicate => 'has_left',         
+        predicate => 'has_left',  
+        lazy      => 1,
+        default   => sub { BinaryTree->new(parent => $_[0]) },       
     );
 
     has 'right' => (
                is        => 'rw',      
                isa       => 'BinaryTree',              
-        predicate => 'has_right',           
+        predicate => 'has_right',   
+        lazy      => 1,       
+        default   => sub { BinaryTree->new(parent => $_[0]) },       
     );
 
     before 'right', 'left' => sub {
         my ($self, $tree) = @_;
            $tree->parent($self) if defined $tree;   
        };
-       
-       sub BUILD {
-           my ($self, $params) = @_;
-           if ($params->{parent}) {
-               # yeah this is a little 
-               # weird I know, but I wanted
-               # to check the weaken stuff 
-               # in the constructor :)
-               if ($params->{parent}->has_left) {
-                   $params->{parent}->right($self);                
-               }
-               else {
-                   $params->{parent}->left($self);                 
-               }
-           }
-       }
 }
 
 my $root = BinaryTree->new();
 isa_ok($root, 'BinaryTree');
 
-is($root->left, undef, '... no left node yet');
-is($root->right, undef, '... no right node yet');
-
 ok(!$root->has_left, '... no left node yet');
 ok(!$root->has_right, '... no right node yet');
 
 ok(!$root->has_parent, '... no parent for root node');
 
-my $left = BinaryTree->new();
-isa_ok($left, 'BinaryTree');
-
-ok(!$left->has_parent, '... left does not have a parent');
+# make a left node
 
-$root->left($left);
+my $left = $root->left;
+isa_ok($left, 'BinaryTree');
 
-is($root->left, $left, '... got a left node now (and it is $left)');
+is($root->left, $left, '... got the same node (and it is $left)');
 ok($root->has_left, '... we have a left node now');
 
 ok($left->has_parent, '... lefts has a parent');
@@ -85,14 +68,15 @@ is($left->parent, $root, '... lefts parent is the root');
 
 ok(isweak($left->{parent}), '... parent is a weakened ref');
 
-my $right = BinaryTree->new();
-isa_ok($right, 'BinaryTree');
+ok(!$left->has_left, '... $left no left node yet');
+ok(!$left->has_right, '... $left no right node yet');
 
-ok(!$right->has_parent, '... right does not have a parent');
+# make a right node
 
-$root->right($right);
+my $right = $root->right;
+isa_ok($right, 'BinaryTree');
 
-is($root->right, $right, '... got a right node now (and it is $right)');
+is($root->right, $right, '... got the same node (and it is $right)');
 ok($root->has_right, '... we have a right node now');
 
 ok($right->has_parent, '... rights has a parent');
@@ -100,7 +84,7 @@ is($right->parent, $root, '... rights parent is the root');
 
 ok(isweak($right->{parent}), '... parent is a weakened ref');
 
-my $left_left = BinaryTree->new(parent => $left);
+my $left_left = $left->left;
 isa_ok($left_left, 'BinaryTree');
 
 ok($left_left->has_parent, '... left does have a parent');
index 4dd9fa3..0a69fab 100644 (file)
@@ -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 => 70;    
+    plan tests => 72;    
 }
 
 use Test::Exception;
@@ -51,7 +51,7 @@ BEGIN {
     use warnings;
     use Moose;
     
-    has 'name'      => (is => 'rw', isa => 'Str');
+    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 
@@ -73,8 +73,8 @@ BEGIN {
     use warnings;
     use Moose;
     
-    has 'first_name'     => (is => 'rw', isa => 'Str');
-    has 'last_name'      => (is => 'rw', isa => 'Str');       
+    has 'first_name'     => (is => 'rw', isa => 'Str', required => 1);
+    has 'last_name'      => (is => 'rw', isa => 'Str', required => 1);       
     has 'middle_initial' => (is => 'rw', isa => 'Str', predicate => 'has_middle_initial');  
     has 'address'        => (is => 'rw', isa => 'Address');
     
@@ -92,7 +92,7 @@ BEGIN {
     
     extends 'Person';
     
-    has 'title'   => (is => 'rw', isa => 'Str');
+    has 'title'   => (is => 'rw', isa => 'Str', required => 1);
     has 'company' => (is => 'rw', isa => 'Company', weak_ref => 1);  
     
     override 'full_name' => sub {
@@ -251,10 +251,18 @@ lives_ok {
 } '... we live correctly with good args';
 
 dies_ok {
-    Company->new(employees => [ Person->new ]),    
+    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(employees => []),    
+    Company->new(name => 'Foo', employees => []),    
 } '... we live correctly with good args';