X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F200_examples%2F006_example_Protomoose.t;h=8b3d3cf10fce140f3051ea1c77406147b7fde225;hb=d03bd989b97597428b460d7f9a021e2931893fa0;hp=123d78506eb24a3d6a97ad5e8145deb3fbead2b4;hpb=6a4a7c310ccaf4300113254461326415f74f93ac;p=gitmo%2FMoose.git

diff --git a/t/200_examples/006_example_Protomoose.t b/t/200_examples/006_example_Protomoose.t
index 123d785..8b3d3cf 100644
--- a/t/200_examples/006_example_Protomoose.t
+++ b/t/200_examples/006_example_Protomoose.t
@@ -7,10 +7,10 @@ use Test::More tests => 28;
 
 =pod
 
-This is an example of making Moose behave 
+This is an example of making Moose behave
 more like a prototype based object system.
 
-Why? 
+Why?
 
 Well cause merlyn asked if it could :)
 
@@ -22,9 +22,9 @@ Well cause merlyn asked if it could :)
 {
     package ProtoMoose::Meta::Instance;
     use Moose;
-    
+
     BEGIN { extends 'Moose::Meta::Instance' };
-    
+
     # NOTE:
     # do not let things be inlined by
     # the attribute or accessor generator
@@ -34,18 +34,18 @@ Well cause merlyn asked if it could :)
 {
     package ProtoMoose::Meta::Method::Accessor;
     use Moose;
-    
+
     BEGIN { extends 'Moose::Meta::Method::Accessor' };
-    
-    # customize the accessors to always grab 
+
+    # customize the accessors to always grab
     # the correct instance in the accessors
-    
+
     sub find_instance {
         my ($self, $candidate, $accessor_type) = @_;
-        
+
         my $instance = $candidate;
         my $attr     = $self->associated_attribute;
-        
+
         # if it is a class calling it ...
         unless (blessed($instance)) {
             # then grab the class prototype
@@ -53,49 +53,49 @@ Well cause merlyn asked if it could :)
         }
         # if its an instance ...
         else {
-            # and there is no value currently 
-            # associated with the instance and 
+            # and there is no value currently
+            # associated with the instance and
             # we are trying to read it, then ...
             if ($accessor_type eq 'r' && !defined($attr->get_value($instance))) {
-                # again, defer the prototype in 
+                # again, defer the prototype in
                 # the class in which is was defined
                 $instance = $attr->associated_class->prototype_instance;
             }
-            # otherwise, you want to assign 
+            # otherwise, you want to assign
             # to your local copy ...
         }
         return $instance;
     }
-    
+
     sub _generate_accessor_method {
         my $self = shift;
-        my $attr = $self->associated_attribute; 
+        my $attr = $self->associated_attribute;
         return sub {
             if (scalar(@_) == 2) {
                 $attr->set_value(
-                    $self->find_instance($_[0], 'w'), 
+                    $self->find_instance($_[0], 'w'),
                     $_[1]
                 );
-            }            
+            }
             $attr->get_value($self->find_instance($_[0], 'r'));
         };
     }
 
     sub _generate_reader_method {
         my $self = shift;
-        my $attr = $self->associated_attribute; 
+        my $attr = $self->associated_attribute;
         return sub {
             confess "Cannot assign a value to a read-only accessor" if @_ > 1;
             $attr->get_value($self->find_instance($_[0], 'r'));
-        };   
+        };
     }
 
     sub _generate_writer_method {
         my $self = shift;
-        my $attr = $self->associated_attribute; 
+        my $attr = $self->associated_attribute;
         return sub {
             $attr->set_value(
-                $self->find_instance($_[0], 'w'), 
+                $self->find_instance($_[0], 'w'),
                 $_[1]
             );
         };
@@ -103,14 +103,14 @@ Well cause merlyn asked if it could :)
 
     # deal with these later ...
     sub generate_predicate_method {}
-    sub generate_clearer_method {}    
-    
+    sub generate_clearer_method {}
+
 }
 
 {
     package ProtoMoose::Meta::Attribute;
     use Moose;
-    
+
     BEGIN { extends 'Moose::Meta::Attribute' };
 
     sub accessor_metaclass { 'ProtoMoose::Meta::Method::Accessor' }
@@ -119,9 +119,9 @@ Well cause merlyn asked if it could :)
 {
     package ProtoMoose::Meta::Class;
     use Moose;
-    
+
     BEGIN { extends 'Moose::Meta::Class' };
-    
+
     has 'prototype_instance' => (
         is        => 'rw',
         isa       => 'Object',
@@ -129,41 +129,41 @@ Well cause merlyn asked if it could :)
         lazy      => 1,
         default   => sub { (shift)->new_object }
     );
-    
+
     sub initialize {
         # NOTE:
-        # I am not sure why 'around' does 
+        # I am not sure why 'around' does
         # not work here, have to investigate
         # it later - SL
-        (shift)->SUPER::initialize(@_, 
+        (shift)->SUPER::initialize(@_,
             instance_metaclass  => 'ProtoMoose::Meta::Instance',
-            attribute_metaclass => 'ProtoMoose::Meta::Attribute',            
+            attribute_metaclass => 'ProtoMoose::Meta::Attribute',
         );
     }
-    
+
     around 'construct_instance' => sub {
         my $next = shift;
         my $self = shift;
         # NOTE:
         # we actually have to do this here
-        # to tie-the-knot, if you take it 
-        # out, then you get deep recursion 
+        # to tie-the-knot, if you take it
+        # out, then you get deep recursion
         # several levels deep :)
-        $self->prototype_instance($next->($self, @_)) 
+        $self->prototype_instance($next->($self, @_))
             unless $self->has_prototypical_instance;
         return $self->prototype_instance;
     };
- 
+
 }
 
 {
     package ProtoMoose::Object;
     use metaclass 'ProtoMoose::Meta::Class';
     use Moose;
-    
+
     sub new {
-        my $prototype = blessed($_[0]) 
-            ? $_[0] 
+        my $prototype = blessed($_[0])
+            ? $_[0]
             : $_[0]->meta->prototype_instance;
         my (undef, %params) = @_;
     	my $self = $prototype->meta->clone_object($prototype, %params);
@@ -178,18 +178,18 @@ Well cause merlyn asked if it could :)
 {
     package Foo;
     use Moose;
-    
+
     extends 'ProtoMoose::Object';
-    
+
     has 'bar' => (is => 'rw');
 }
 
 {
     package Bar;
     use Moose;
-    
+
     extends 'Foo';
-    
+
     has 'baz' => (is => 'rw');
 }
 
@@ -199,16 +199,16 @@ Well cause merlyn asked if it could :)
 ## Check that metaclasses are working/inheriting properly
 
 foreach my $class (qw/ProtoMoose::Object Foo Bar/) {
-    isa_ok($class->meta, 
-    'ProtoMoose::Meta::Class', 
+    isa_ok($class->meta,
+    'ProtoMoose::Meta::Class',
     '... got the right metaclass for ' . $class . ' ->');
 
-    is($class->meta->instance_metaclass, 
-    'ProtoMoose::Meta::Instance', 
+    is($class->meta->instance_metaclass,
+    'ProtoMoose::Meta::Instance',
     '... got the right instance meta for ' . $class);
 
-    is($class->meta->attribute_metaclass, 
-    'ProtoMoose::Meta::Attribute', 
+    is($class->meta->attribute_metaclass,
+    'ProtoMoose::Meta::Attribute',
     '... got the right attribute meta for ' . $class);
 }
 
@@ -222,13 +222,13 @@ isa_ok($foo_prototype, 'Foo');
 $foo_prototype->bar(100);
 is($foo_prototype->bar, 100, '... got the value stored in the prototype');
 
-# the "class" defers to the 
-# the prototype when asked 
+# the "class" defers to the
+# the prototype when asked
 # about attributes
 is(Foo->bar, 100, '... got the value stored in the prototype (through the Foo class)');
 
-# now make an instance, which 
-# is basically a clone of the 
+# now make an instance, which
+# is basically a clone of the
 # prototype
 my $foo = Foo->new;
 isa_ok($foo, 'Foo');
@@ -239,8 +239,8 @@ isnt($foo, $foo_prototype, '... got a new instance of Foo');
 # but it has the same values ...
 is($foo->bar, 100, '... got the value stored in the instance (inherited from the prototype)');
 
-# we can even change the values 
-# in the instance 
+# we can even change the values
+# in the instance
 $foo->bar(300);
 is($foo->bar, 300, '... got the value stored in the instance (overwriting the one inherited from the prototype)');
 
@@ -248,10 +248,10 @@ is($foo->bar, 300, '... got the value stored in the instance (overwriting the on
 is($foo_prototype->bar, 100, '... got the value stored in the prototype');
 is(Foo->bar, 100, '... got the value stored in the prototype (through the Foo class)');
 
-## subclasses 
+## subclasses
 
 # now we can check that the subclass
-# will seek out the correct prototypical 
+# will seek out the correct prototypical
 # value from it's "parent"
 is(Bar->bar, 100, '... got the value stored in the Foo prototype (through the Bar class)');
 
@@ -273,8 +273,8 @@ is($bar->baz, 50, '... got the value stored in the instance (inherited from the
 $bar->bar(200);
 is($bar->bar, 200, '... got the value stored in the instance (overriding the one inherited from the Foo prototype)');
 
-# and all our original and 
-# prototypical values are still 
+# and all our original and
+# prototypical values are still
 # the same
 is($foo->bar, 300, '... still got the original value stored in the instance (inherited from the prototype)');
 is(Foo->bar, 100, '... still got the original value stored in the prototype (through the Foo class)');