From: Stevan Little <stevan.little@iinteractive.com>
Date: Fri, 11 Aug 2006 14:16:19 +0000 (+0000)
Subject: added the AUTHORITY into all classes, and support for it into Module
X-Git-Tag: 0_33~9
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=f0480c45f215203bc40abc794ac0c03622f02f1d;p=gitmo%2FClass-MOP.git

added the AUTHORITY into all classes, and support for it into Module
---

diff --git a/Changes b/Changes
index 898fefb..7263bec 100644
--- a/Changes
+++ b/Changes
@@ -10,11 +10,19 @@ Revision history for Perl extension Class-MOP.
     * Class::MOP::Class
       - refactored all symbol table access to 
         use Class::MOP::Package methods instead
+        
+    * Class::MOP::Module
+      - adding the $:version attribute in the bootstrap
+        so that Module has a version as an attribute
+        - see comment in Class::MOP for details
+      - added the $:authority attribute to this module 
+        as well as an &identifier method, to bring us 
+        ever closer to Perl 6 goodness 
       
-   * Class::MOP::Instance
-     - added &deinitialize_slot for removing slots 
-       from an instance
-       - added tests for this      
+    * Class::MOP::Instance
+      - added &deinitialize_slot for removing slots 
+        from an instance
+        - added tests for this      
       
     * Class::MOP::Attribute 
       - added support for &deinitialize_slot for removing
diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index dc46131..3c809e0 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -13,7 +13,8 @@ use Class::MOP::Method;
 
 use Class::MOP::Class::Immutable;
 
-our $VERSION = '0.32';
+our $VERSION   = '0.32';
+our $AUTHORITY = 'cpan:STEVAN';
 
 ## ----------------------------------------------------------------------------
 ## Setting up our environment ...
@@ -39,6 +40,7 @@ our $VERSION = '0.32';
 # any subclass of Class::MOP::* will be able to 
 # inherit them using &construct_instance
 
+## --------------------------------------------------------
 ## Class::MOP::Package
 
 Class::MOP::Package->meta->add_attribute(
@@ -78,6 +80,54 @@ Class::MOP::Package->meta->add_method('initialize' => sub {
     $class->meta->new_object(':package' => $package_name, @_);  
 });
 
+## --------------------------------------------------------
+## Class::MOP::Module
+
+# NOTE:
+# yeah this is kind of stretching things a bit, 
+# but truthfully the version should be an attribute
+# of the Module, the weirdness comes from having to 
+# stick to Perl 5 convention and store it in the 
+# $VERSION package variable. Basically if you just 
+# squint at it, it will look how you want it to look. 
+# Either as a package variable, or as a attribute of
+# the metaclass, isn't abstraction great :)
+
+Class::MOP::Module->meta->add_attribute(
+    Class::MOP::Attribute->new('$:version' => (
+        reader => {
+            'version' => sub {  
+                my $self = shift;
+                ${$self->get_package_symbol('$VERSION')};
+            }
+        },
+        # NOTE:
+        # protect this from silliness 
+        init_arg => '!............( DO NOT DO THIS )............!',
+    ))
+);
+
+# NOTE:
+# By following the same conventions as version here, 
+# we are opening up the possibility that people can 
+# use the $AUTHORITY in non-Class::MOP modules as 
+# well.  
+
+Class::MOP::Module->meta->add_attribute(
+    Class::MOP::Attribute->new('$:authority' => (
+        reader => {
+            'authority' => sub {  
+                my $self = shift;
+                ${$self->get_package_symbol('$AUTHORITY')};
+            }
+        },       
+        # NOTE:
+        # protect this from silliness 
+        init_arg => '!............( DO NOT DO THIS )............!',
+    ))
+);
+
+## --------------------------------------------------------
 ## Class::MOP::Class
 
 Class::MOP::Class->meta->add_attribute(
@@ -128,6 +178,7 @@ Class::MOP::Class->meta->add_attribute(
 # within Class::MOP::Class itself in the 
 # construct_class_instance method. 
 
+## --------------------------------------------------------
 ## Class::MOP::Attribute
 
 Class::MOP::Attribute->meta->add_attribute(
@@ -226,7 +277,8 @@ Class::MOP::Attribute->meta->add_method('clone' => sub {
     $self->meta->clone_object($self, @_);  
 });
 
-## Try and close Class::MOP::*
+## --------------------------------------------------------
+## Now close all the Class::MOP::* classes
 
 Class::MOP::Package  ->meta->make_immutable(inline_constructor => 0);
 Class::MOP::Module   ->meta->make_immutable(inline_constructor => 0);
@@ -235,7 +287,6 @@ Class::MOP::Attribute->meta->make_immutable(inline_constructor => 0);
 Class::MOP::Method   ->meta->make_immutable(inline_constructor => 0);
 Class::MOP::Instance ->meta->make_immutable(inline_constructor => 0);
 
-
 1;
 
 __END__
diff --git a/lib/Class/MOP/Attribute.pm b/lib/Class/MOP/Attribute.pm
index 8650818..ca93efe 100644
--- a/lib/Class/MOP/Attribute.pm
+++ b/lib/Class/MOP/Attribute.pm
@@ -7,7 +7,8 @@ use warnings;
 use Carp         'confess';
 use Scalar::Util 'blessed', 'reftype', 'weaken';
 
-our $VERSION = '0.11';
+our $VERSION   = '0.11';
+our $AUTHORITY = 'cpan:STEVAN';
 
 sub meta { 
     require Class::MOP::Class;
diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 8ec890a..f5e8ca7 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -9,7 +9,8 @@ use Scalar::Util 'blessed', 'reftype', 'weaken';
 use Sub::Name    'subname';
 use B            'svref_2object';
 
-our $VERSION = '0.17';
+our $VERSION   = '0.17';
+our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Module';
 
@@ -96,8 +97,13 @@ my $ANON_CLASS_PREFIX = 'Class::MOP::Class::__ANON__::SERIAL::';
         if ($class =~ /^Class::MOP::Class$/) {
             no strict 'refs';                
             $meta = bless { 
+                # inherited from Class::MOP::Package
                 '$:package'             => $package_name, 
                 '%:namespace'           => \%{$package_name . '::'},                
+                # inherited from Class::MOP::Module
+                '$:version'             => (exists ${$package_name . '::'}{'VERSION'}   ? ${$package_name . '::VERSION'}   : undef),
+                '$:authority'           => (exists ${$package_name . '::'}{'AUTHORITY'} ? ${$package_name . '::AUTHORITY'} : undef),
+                # defined here ...
                 '%:attributes'          => {},
                 '$:attribute_metaclass' => $options{':attribute_metaclass'} || 'Class::MOP::Attribute',
                 '$:method_metaclass'    => $options{':method_metaclass'}    || 'Class::MOP::Method',
diff --git a/lib/Class/MOP/Class/Immutable.pm b/lib/Class/MOP/Class/Immutable.pm
index 9dca7fa..2baab34 100644
--- a/lib/Class/MOP/Class/Immutable.pm
+++ b/lib/Class/MOP/Class/Immutable.pm
@@ -7,7 +7,8 @@ use warnings;
 use Carp         'confess';
 use Scalar::Util 'blessed', 'looks_like_number';
 
-our $VERSION = '0.02';
+our $VERSION   = '0.02';
+our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Class';
 
diff --git a/lib/Class/MOP/Instance.pm b/lib/Class/MOP/Instance.pm
index 44cfb54..b2e406a 100644
--- a/lib/Class/MOP/Instance.pm
+++ b/lib/Class/MOP/Instance.pm
@@ -6,7 +6,8 @@ use warnings;
 
 use Scalar::Util 'weaken', 'blessed';
 
-our $VERSION = '0.03';
+our $VERSION   = '0.03';
+our $AUTHORITY = 'cpan:STEVAN';
 
 sub meta { 
     require Class::MOP::Class;
diff --git a/lib/Class/MOP/Method.pm b/lib/Class/MOP/Method.pm
index 30f2c2e..ac966f9 100644
--- a/lib/Class/MOP/Method.pm
+++ b/lib/Class/MOP/Method.pm
@@ -8,7 +8,8 @@ use Carp         'confess';
 use Scalar::Util 'reftype', 'blessed';
 use B            'svref_2object';
 
-our $VERSION = '0.03';
+our $VERSION   = '0.03';
+our $AUTHORITY = 'cpan:STEVAN';
 
 # introspection
 
diff --git a/lib/Class/MOP/Module.pm b/lib/Class/MOP/Module.pm
index 7e18bdc..c373bd8 100644
--- a/lib/Class/MOP/Module.pm
+++ b/lib/Class/MOP/Module.pm
@@ -7,11 +7,7 @@ use warnings;
 use Scalar::Util 'blessed';
 
 our $VERSION   = '0.02';
-#our $AUTHORITY = {
-#    cpan   => 'STEVAN',
-#    mailto => 'stevan@iinteractive.com',
-#    http   => '//www.iinteractive.com/'
-#};
+our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Package';
 
@@ -22,23 +18,24 @@ sub meta {
     Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
 }
 
-# QUESTION:
-# can the version be an attribute of the 
-# module? I think it should be, but we need
-# to somehow assure that it always is stored
-# in the symbol table instead of being stored 
-# into the instance structure itself
-
 sub version {  
     my $self = shift;
     ${$self->get_package_symbol('$VERSION')};
 }
 
-#sub authority {  
-#    my $self = shift;
-#    $self->get_package_symbol('$AUTHORITY');
-#}
+sub authority {  
+    my $self = shift;
+    ${$self->get_package_symbol('$AUTHORITY')};
+}
 
+sub identifier {
+    my $self = shift;
+    join '-' => (
+        $self->name,
+        ($self->version   || ()),
+        ($self->authority || ()),
+    );
+}
 
 1;
 
@@ -62,6 +59,10 @@ Class::MOP::Module - Module Meta Object
 
 =item B<version>
 
+=item B<authority>
+
+=item B<identifier>
+
 =back
 
 =head1 AUTHORS
diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm
index 88df8d5..297ee82 100644
--- a/lib/Class/MOP/Package.pm
+++ b/lib/Class/MOP/Package.pm
@@ -7,7 +7,8 @@ use warnings;
 use Scalar::Util 'blessed';
 use Carp         'confess';
 
-our $VERSION = '0.02';
+our $VERSION   = '0.02';
+our $AUTHORITY = 'cpan:STEVAN';
 
 # introspection
 
diff --git a/lib/metaclass.pm b/lib/metaclass.pm
index 111ecae..a66b323 100644
--- a/lib/metaclass.pm
+++ b/lib/metaclass.pm
@@ -7,7 +7,8 @@ use warnings;
 use Carp         'confess';
 use Scalar::Util 'blessed';
 
-our $VERSION = '0.03';
+our $VERSION   = '0.03';
+our $AUTHORITY = 'cpan:STEVAN';
 
 use Class::MOP;
 
diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t
index ee87164..ec0533c 100644
--- a/t/010_self_introspection.t
+++ b/t/010_self_introspection.t
@@ -3,7 +3,7 @@
 use strict;
 use warnings;
 
-use Test::More tests => 181;
+use Test::More tests => 189;
 use Test::Exception;
 
 BEGIN {
@@ -44,7 +44,7 @@ my @class_mop_package_methods = qw(
 my @class_mop_module_methods = qw(
     meta 
 
-    version
+    version authority identifier
 );
 
 my @class_mop_class_methods = qw(
@@ -139,6 +139,7 @@ my @class_mop_package_attributes = (
 );
 
 my @class_mop_module_attributes = (
+    '$:version', '$:authority'
 );
 
 my @class_mop_class_attributes = (