From: Stevan Little <stevan.little@iinteractive.com>
Date: Thu, 2 Feb 2006 00:00:41 +0000 (+0000)
Subject: many docs additions and a new test
X-Git-Tag: 0_02~7
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=fe122940cbe91ce499fbe50ad706fe3dc7c44fdf;p=gitmo%2FClass-MOP.git

many docs additions and a new test
---

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index b1d7785..f77dc25 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -106,11 +106,7 @@ Class::MOP - A Meta Object Protocol for Perl 5
 
 =head1 SYNOPSIS
 
-  use Class::MOP ':universal';
-  
-  package Foo;
-  
-  Foo->meta->add_method('foo' => sub { ... });
+  # ... 
 
 =head1 DESCRIPTON
 
diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm
index ac09358..5548c7a 100644
--- a/lib/Class/MOP/Attribute.pm
+++ b/lib/Class/MOP/Attribute.pm
@@ -88,7 +88,6 @@ sub default {
             }},
             'writer' => qq{sub {
                 \$_[0]->{'$attr_name'} = \$_[1];
-                return;
             }},
             'predicate' => qq{sub {
                 return defined \$_[0]->{'$attr_name'} ? 1 : 0;
@@ -178,27 +177,31 @@ Class::MOP::Attribute - Attribute Meta Object
 =head1 SYNOPSIS
   
   Class::MOP::Attribute->new('$foo' => (
-      accessor => 'foo',        # dual purpose get/set accessor
-      init_arg => '-foo',       # class->new will look for a -foo key
-      default  => 'BAR IS BAZ!' # if no -foo key is provided, use this
+      accessor  => 'foo',        # dual purpose get/set accessor
+      predicate => 'has_foo'     # predicate check for defined-ness      
+      init_arg  => '-foo',       # class->new will look for a -foo key
+      default   => 'BAR IS BAZ!' # if no -foo key is provided, use this
   ));
   
   Class::MOP::Attribute->new('$.bar' => (
-      reader   => 'bar',        # getter
-      writer   => 'set_bar',    # setter      
-      init_arg => '-bar',       # class->new will look for a -bar key
+      reader    => 'bar',        # getter
+      writer    => 'set_bar',    # setter     
+      predicate => 'has_bar'     # predicate check for defined-ness      
+      init_arg  => ':bar',       # class->new will look for a :bar key
       # no default value means it is undef
   ));
 
 =head1 DESCRIPTION
 
-The Attribute Protocol is almost entirely an invention of this module. This is
-because Perl 5 does not have consistent notion of what is an attribute 
-of a class. There are so many ways in which this is done, and very few 
-(if any) are discoverable by this module.
+The Attribute Protocol is almost entirely an invention of this module,
+and is completely optional to this MOP. This is because Perl 5 does not 
+have consistent notion of what is an attribute of a class. There are 
+so many ways in which this is done, and very few (if any) are 
+easily discoverable by this module.
 
 So, all that said, this module attempts to inject some order into this 
-chaos, by introducing a more consistent approach.
+chaos, by introducing a consistent API which can be used to create 
+object attributes.
 
 =head1 METHODS
 
@@ -206,21 +209,116 @@ chaos, by introducing a more consistent approach.
 
 =over 4
 
-=item B<new ($name, %options)>
+=item B<new ($name, ?%options)>
+
+An attribute must (at the very least), have a C<$name>. All other 
+C<%options> are contained added as key-valeue pairs. Acceptable keys
+are as follows:
+
+=over 4
+
+=item I<init_arg>
+
+This should be a string value representing the expected key in 
+an initialization hash. For instance, if we have an I<init_arg> 
+value of C<-foo>, then the following code will Just Work.
+
+  MyClass->meta->construct_instance(-foo => "Hello There");
+
+=item I<default>
+
+The value of this key is the default value which 
+C<Class::MOP::Class::construct_instance> will initialize the 
+attribute to. 
+
+B<NOTE:>
+If the value is a simple scalar (string or number), then it can 
+be just passed as is. However, if you wish to initialize it with 
+a HASH or ARRAY ref, then you need to wrap that inside a CODE 
+reference, like so:
+
+  Class::MOP::Attribute->new('@foo' => (
+      default => sub { [] },
+  ));
+  
+  # or ...  
+  
+  Class::MOP::Attribute->new('%foo' => (
+      default => sub { {} },
+  ));  
+
+If you wish to initialize an attribute with a CODE reference 
+itself, then you need to wrap that in a subroutine as well, like
+so:
+  
+  Class::MOP::Attribute->new('&foo' => (
+      default => sub { sub { print "Hello World" } },
+  ));
+
+And lastly, if the value of your attribute is dependent upon 
+some other aspect of the instance structure, then you can take 
+advantage of the fact that when the I<default> value is a CODE 
+reference, it is passed the raw (unblessed) instance structure 
+as it's only argument. So you can do things like this:
+
+  Class::MOP::Attribute->new('$object_identity' => (
+      default => sub { Scalar::Util::refaddr($_[0]) },
+  ));
+
+This last feature is fairly limited as there is no gurantee of 
+the order of attribute initializations, so you cannot perform 
+any kind of dependent initializations. However, if this is 
+something you need, you could subclass B<Class::MOP::Class> and 
+this class to acheive it. However, this is currently left as 
+an exercise to the reader :).
+
+=back
+
+This I<accessor>, I<reader>, I<writer> and I<predicate> keys can 
+contain either; the name of the method and an appropriate default 
+one will be generated for you, B<or> a HASH ref containing exactly one 
+key (which will be used as the name of the method) and one value, 
+which should contain a CODE reference which will be installed as 
+the method itself.
 
 =over 4
 
 =item I<accessor>
 
+The I<accessor> is a standard perl-style read/write accessor. It will 
+return the value of the attribute, and if a value is passed as an argument, 
+it will assign that value to the attribute.
+
+B<NOTE:>
+This method will properly handle the following code, by assigning an 
+C<undef> value to the attribute.
+
+  $object->set_something(undef);
+
 =item I<reader>
 
+This is a basic read-only accessor, it will just return the value of 
+the attribute.
+
 =item I<writer>
 
-=item I<predicate>
+This is a basic write accessor, it accepts a single argument, and 
+assigns that value to the attribute. This method does not intentially 
+return a value, however perl will return the result of the last 
+expression in the subroutine, which returns in this returning the 
+same value that it was passed. 
 
-=item I<init_arg>
+B<NOTE:>
+This method will properly handle the following code, by assigning an 
+C<undef> value to the attribute.
 
-=item I<default>
+  $object->set_something();
+
+=item I<predicate>
+
+This is a basic test to see if the value of the attribute is not 
+C<undef>. It will return true (C<1>) if the attribute's value is 
+defined, and false (C<0>) otherwise.
 
 =back
 
@@ -228,6 +326,9 @@ chaos, by introducing a more consistent approach.
 
 =head2 Informational
 
+These are all basic read-only value accessors for the values 
+passed into C<new>. I think they are pretty much self-explanitory.
+
 =over 4
 
 =item B<name>
@@ -242,41 +343,32 @@ chaos, by introducing a more consistent approach.
 
 =item B<init_arg>
 
-=item B<default>
+=item B<default (?$instance)>
+
+As noted in the documentation for C<new> above, if the I<default> 
+value is a CODE reference, this accessor will pass a single additional
+argument C<$instance> into it and return the value.
 
 =back
 
 =head2 Informational predicates
 
+These are all basic predicate methodfor the values passed into C<new>.
+
 =over 4
 
 =item B<has_accessor>
 
-Returns true if this attribute uses a get/set accessor, and false 
-otherwise
-
 =item B<has_reader>
 
-Returns true if this attribute has a reader, and false otherwise
-
 =item B<has_writer>
 
-Returns true if this attribute has a writer, and false otherwise
-
 =item B<has_predicate>
 
-Returns true if this attribute has a predicate, and false otherwise
-
 =item B<has_init_arg>
 
-Returns true if this attribute has a class intialization argument, and 
-false otherwise
-
 =item B<has_default>
 
-Returns true if this attribute has a default value, and false 
-otherwise.
-
 =back
 
 =head2 Attribute Accessor generation
@@ -286,12 +378,14 @@ otherwise.
 =item B<install_accessors ($class)>
 
 This allows the attribute to generate and install code for it's own 
-accessor methods. This is called by C<Class::MOP::Class::add_attribute>.
+accessor/reader/writer/predicate methods. This is called by 
+C<Class::MOP::Class::add_attribute>.
 
 =item B<remove_accessors ($class)>
 
 This allows the attribute to remove the method for it's own 
-accessor. This is called by C<Class::MOP::Class::remove_attribute>.
+accessor/reader/writer/predicate. This is called by 
+C<Class::MOP::Class::remove_attribute>.
 
 =back
 
@@ -301,6 +395,14 @@ accessor. This is called by C<Class::MOP::Class::remove_attribute>.
 
 =item B<meta>
 
+This will return a B<Class::MOP::Class> instance which is related 
+to this class.
+
+It should also be noted that B<Class::MOP> will actually bootstrap 
+this module by installing a number of attribute meta-objects into 
+it's metaclass. This will allow this class to reap all the benifits 
+of the MOP when subclassing it. 
+
 =back
 
 =head1 AUTHOR
diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 15a9ae6..9a83438 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -337,8 +337,45 @@ Class::MOP::Class - Class Meta Object
 
 =head1 SYNOPSIS
 
+  # use this for introspection ...
+  
+  package Foo;
+  sub meta { Class::MOP::Class->initialize(__PACKAGE__) }
+  
+  # elsewhere in the code ...
+  
+  # add a method to Foo ...
+  Foo->meta->add_method('bar' => sub { ... })
+  
+  # get a list of all the classes searched 
+  # the method dispatcher in the correct order 
+  Foo->meta->class_precedence_list()
+  
+  # remove a method from Foo
+  Foo->meta->remove_method('bar');
+  
+  # or use this to actually create classes ...
+  
+  Class::MOP::Class->create('Bar' => '0.01' => (
+      superclasses => [ 'Foo' ],
+      attributes => [
+          Class::MOP:::Attribute->new('$bar'),
+          Class::MOP:::Attribute->new('$baz'),          
+      ],
+      methods => {
+          calculate_bar => sub { ... },
+          construct_baz => sub { ... }          
+      }
+  ));
+
 =head1 DESCRIPTION
 
+This is the largest and currently most complex part of the Perl 5 
+meta-object protocol. It controls the introspection and 
+manipulation of Perl 5 classes (and it can create them too). The 
+best way to understand what this module can do, is to read the 
+documentation for each of it's methods.
+
 =head1 METHODS
 
 =head2 Self Introspection
@@ -347,7 +384,14 @@ Class::MOP::Class - Class Meta Object
 
 =item B<meta>
 
-This allows Class::MOP::Class to actually introspect itself.
+This will return a B<Class::MOP::Class> instance which is related 
+to this class. Thereby allowing B<Class::MOP::Class> to actually 
+introspect itself.
+
+As with B<Class::MOP::Attribute>, B<Class::MOP> will actually 
+bootstrap this module by installing a number of attribute meta-objects 
+into it's metaclass. This will allow this class to reap all the benifits 
+of the MOP when subclassing it. 
 
 =back
 
diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm
index f049563..8db4bd3 100644
--- a/lib/Class/MOP/Method.pm
+++ b/lib/Class/MOP/Method.pm
@@ -36,12 +36,17 @@ Class::MOP::Method - Method Meta Object
 
 =head1 SYNOPSIS
 
+  # ... more to come later maybe
+
 =head1 DESCRIPTION
 
 The Method Protocol is very small, since methods in Perl 5 are just 
 subroutines within the particular package. Basically all we do is to 
-bless the subroutine and provide some very simple introspection 
-methods for it.
+bless the subroutine. 
+
+Currently this package is largely unused. Future plans are to provide 
+some very simple introspection methods for the methods themselves. 
+Suggestions for this are welcome. 
 
 =head1 METHODS
 
@@ -49,8 +54,13 @@ methods for it.
 
 =item B<wrap (&code)>
 
+This simply blesses the C<&code> reference passed to it.
+
 =item B<meta>
 
+This will return a B<Class::MOP::Class> instance which is related 
+to this class.
+
 =back
 
 =head1 AUTHOR
diff --git a/t/002_class_precedence_list.t b/t/002_class_precedence_list.t
index 686327b..aa0d367 100644
--- a/t/002_class_precedence_list.t
+++ b/t/002_class_precedence_list.t
@@ -84,3 +84,60 @@ is_deeply(
     [ Class::MOP::Class->initialize('My::3::D')->class_precedence_list ], 
     [ 'My::3::D', 'My::3::B', 'My::3::A', 'My::3::C', 'My::3::A', 'My::3::B', 'My::3::A' ], 
     '... My::3::D->meta->class_precedence_list == (D B A C A B A)');
+
+=pod
+
+Test all the class_precedence_lists 
+using Perl's own dispatcher to check 
+against.
+
+=cut
+
+my @CLASS_PRECEDENCE_LIST;
+
+{
+    package Foo;
+    
+    sub CPL { push @CLASS_PRECEDENCE_LIST => 'Foo' }    
+    
+    package Bar;
+    our @ISA = ('Foo');
+    
+    sub CPL { 
+        push @CLASS_PRECEDENCE_LIST => 'Bar';
+        $_[0]->SUPER::CPL();
+    }       
+    
+    package Baz;
+    our @ISA = ('Bar');
+    
+    sub CPL { 
+        push @CLASS_PRECEDENCE_LIST => 'Baz';
+        $_[0]->SUPER::CPL();
+    }       
+    
+    package Foo::Bar;
+    our @ISA = ('Baz');
+    
+    sub CPL { 
+        push @CLASS_PRECEDENCE_LIST => 'Foo::Bar';
+        $_[0]->SUPER::CPL();
+    }    
+    
+    package Foo::Bar::Baz;
+    our @ISA = ('Foo::Bar');
+    
+    sub CPL { 
+        push @CLASS_PRECEDENCE_LIST => 'Foo::Bar::Baz';
+        $_[0]->SUPER::CPL();
+    }    
+
+}
+
+Foo::Bar::Baz->CPL();
+
+is_deeply(
+    [ Class::MOP::Class->initialize('Foo::Bar::Baz')->class_precedence_list ], 
+    [ @CLASS_PRECEDENCE_LIST ], 
+    '... Foo::Bar::Baz->meta->class_precedence_list == @CLASS_PRECEDENCE_LIST');
+