X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP.pm;h=e70592ea865c00a4e1d236bb554a95691458aeda;hb=9c8cda9011b019e4876183222b8793b66bab7546;hp=adbccfa920223763f336fd9b52712a6d8795d6e7;hpb=817c7cd51b8e7a9509c43428f47e231d0e21ff43;p=gitmo%2FClass-MOP.git diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index adbccfa..e70592e 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -11,9 +11,9 @@ use Class::MOP::Class; use Class::MOP::Attribute; use Class::MOP::Method; -use Class::MOP::Class::Immutable; +use Class::MOP::Immutable; -our $VERSION = '0.35'; +our $VERSION = '0.38'; our $AUTHORITY = 'cpan:STEVAN'; { @@ -41,6 +41,35 @@ our $AUTHORITY = 'cpan:STEVAN'; # because I don't yet see a good reason to do so. } +sub load_class { + my $class = shift; + # see if this is already + # loaded in the symbol table + return 1 if is_class_loaded($class); + # otherwise require it ... + my $file = $class . '.pm'; + $file =~ s{::}{/}g; + eval { CORE::require($file) }; + confess "Could not load class ($class) because : $@" if $@; + unless (does_metaclass_exist($class)) { + eval { Class::MOP::Class->initialize($class) }; + confess "Could not initialize class ($class) because : $@" if $@; + } + 1; # return true if it worked +} + +sub is_class_loaded { + my $class = shift; + no strict 'refs'; + return 1 if defined ${"${class}::VERSION"} || defined @{"${class}::ISA"}; + foreach (keys %{"${class}::"}) { + next if substr($_, -2, 2) eq '::'; + return 1 if defined &{"${class}::$_"}; + } + return 0; +} + + ## ---------------------------------------------------------------------------- ## Setting up our environment ... ## ---------------------------------------------------------------------------- @@ -69,7 +98,7 @@ our $AUTHORITY = 'cpan:STEVAN'; ## Class::MOP::Package Class::MOP::Package->meta->add_attribute( - Class::MOP::Attribute->new('$:package' => ( + Class::MOP::Attribute->new('$!package' => ( reader => { # NOTE: we need to do this in order # for the instance meta-object to @@ -79,12 +108,12 @@ Class::MOP::Package->meta->add_attribute( # rather than re-produce it here 'name' => \&Class::MOP::Package::name }, - init_arg => ':package', + init_arg => 'package', )) ); Class::MOP::Package->meta->add_attribute( - Class::MOP::Attribute->new('%:namespace' => ( + Class::MOP::Attribute->new('%!namespace' => ( reader => { # NOTE: # we just alias the original method @@ -104,7 +133,7 @@ Class::MOP::Package->meta->add_attribute( Class::MOP::Package->meta->add_method('initialize' => sub { my $class = shift; my $package_name = shift; - $class->meta->new_object(':package' => $package_name, @_); + $class->meta->new_object('package' => $package_name, @_); }); ## -------------------------------------------------------- @@ -121,7 +150,7 @@ Class::MOP::Package->meta->add_method('initialize' => sub { # the metaclass, isn't abstraction great :) Class::MOP::Module->meta->add_attribute( - Class::MOP::Attribute->new('$:version' => ( + Class::MOP::Attribute->new('$!version' => ( reader => { # NOTE: # we just alias the original method @@ -142,7 +171,7 @@ Class::MOP::Module->meta->add_attribute( # well. Class::MOP::Module->meta->add_attribute( - Class::MOP::Attribute->new('$:authority' => ( + Class::MOP::Attribute->new('$!authority' => ( reader => { # NOTE: # we just alias the original method @@ -160,7 +189,7 @@ Class::MOP::Module->meta->add_attribute( ## Class::MOP::Class Class::MOP::Class->meta->add_attribute( - Class::MOP::Attribute->new('%:attributes' => ( + Class::MOP::Attribute->new('%!attributes' => ( reader => { # NOTE: we need to do this in order # for the instance meta-object to @@ -170,13 +199,14 @@ Class::MOP::Class->meta->add_attribute( # rather than re-produce it here 'get_attribute_map' => \&Class::MOP::Class::get_attribute_map }, - init_arg => ':attributes', + init_arg => 'attributes', default => sub { {} } )) ); Class::MOP::Class->meta->add_attribute( - Class::MOP::Attribute->new('%:methods' => ( + Class::MOP::Attribute->new('%!methods' => ( + init_arg => 'methods', reader => { # NOTE: # we just alias the original method @@ -188,33 +218,48 @@ Class::MOP::Class->meta->add_attribute( ); Class::MOP::Class->meta->add_attribute( - Class::MOP::Attribute->new('$:attribute_metaclass' => ( + Class::MOP::Attribute->new('@!superclasses' => ( + accessor => { + # NOTE: + # we just alias the original method + # rather than re-produce it here + 'superclasses' => \&Class::MOP::Class::superclasses + }, + # NOTE: + # protect this from silliness + init_arg => '!............( DO NOT DO THIS )............!', + default => sub { \undef } + )) +); + +Class::MOP::Class->meta->add_attribute( + Class::MOP::Attribute->new('$!attribute_metaclass' => ( reader => { # NOTE: # we just alias the original method # rather than re-produce it here 'attribute_metaclass' => \&Class::MOP::Class::attribute_metaclass }, - init_arg => ':attribute_metaclass', + init_arg => 'attribute_metaclass', default => 'Class::MOP::Attribute', )) ); Class::MOP::Class->meta->add_attribute( - Class::MOP::Attribute->new('$:method_metaclass' => ( + Class::MOP::Attribute->new('$!method_metaclass' => ( reader => { # NOTE: # we just alias the original method # rather than re-produce it here 'method_metaclass' => \&Class::MOP::Class::method_metaclass }, - init_arg => ':method_metaclass', + init_arg => 'method_metaclass', default => 'Class::MOP::Method', )) ); Class::MOP::Class->meta->add_attribute( - Class::MOP::Attribute->new('$:instance_metaclass' => ( + Class::MOP::Attribute->new('$!instance_metaclass' => ( reader => { # NOTE: we need to do this in order # for the instance meta-object to @@ -224,7 +269,7 @@ Class::MOP::Class->meta->add_attribute( # rather than re-produce it here 'instance_metaclass' => \&Class::MOP::Class::instance_metaclass }, - init_arg => ':instance_metaclass', + init_arg => 'instance_metaclass', default => 'Class::MOP::Instance', )) ); @@ -239,8 +284,9 @@ Class::MOP::Class->meta->add_attribute( ## Class::MOP::Attribute Class::MOP::Attribute->meta->add_attribute( - Class::MOP::Attribute->new('name' => ( - reader => { + Class::MOP::Attribute->new('$!name' => ( + init_arg => 'name', + reader => { # NOTE: we need to do this in order # for the instance meta-object to # not fall into meta-circular death @@ -253,8 +299,9 @@ Class::MOP::Attribute->meta->add_attribute( ); Class::MOP::Attribute->meta->add_attribute( - Class::MOP::Attribute->new('associated_class' => ( - reader => { + Class::MOP::Attribute->new('$!associated_class' => ( + init_arg => 'associated_class', + reader => { # NOTE: we need to do this in order # for the instance meta-object to # not fall into meta-circular death @@ -267,58 +314,66 @@ Class::MOP::Attribute->meta->add_attribute( ); Class::MOP::Attribute->meta->add_attribute( - Class::MOP::Attribute->new('accessor' => ( + Class::MOP::Attribute->new('$!accessor' => ( + init_arg => 'accessor', reader => { 'accessor' => \&Class::MOP::Attribute::accessor }, predicate => { 'has_accessor' => \&Class::MOP::Attribute::has_accessor }, )) ); Class::MOP::Attribute->meta->add_attribute( - Class::MOP::Attribute->new('reader' => ( + Class::MOP::Attribute->new('$!reader' => ( + init_arg => 'reader', reader => { 'reader' => \&Class::MOP::Attribute::reader }, predicate => { 'has_reader' => \&Class::MOP::Attribute::has_reader }, )) ); Class::MOP::Attribute->meta->add_attribute( - Class::MOP::Attribute->new('writer' => ( + Class::MOP::Attribute->new('$!writer' => ( + init_arg => 'writer', reader => { 'writer' => \&Class::MOP::Attribute::writer }, predicate => { 'has_writer' => \&Class::MOP::Attribute::has_writer }, )) ); Class::MOP::Attribute->meta->add_attribute( - Class::MOP::Attribute->new('predicate' => ( + Class::MOP::Attribute->new('$!predicate' => ( + init_arg => 'predicate', reader => { 'predicate' => \&Class::MOP::Attribute::predicate }, predicate => { 'has_predicate' => \&Class::MOP::Attribute::has_predicate }, )) ); Class::MOP::Attribute->meta->add_attribute( - Class::MOP::Attribute->new('clearer' => ( + Class::MOP::Attribute->new('$!clearer' => ( + init_arg => 'clearer', reader => { 'clearer' => \&Class::MOP::Attribute::clearer }, predicate => { 'has_clearer' => \&Class::MOP::Attribute::has_clearer }, )) ); Class::MOP::Attribute->meta->add_attribute( - Class::MOP::Attribute->new('init_arg' => ( + Class::MOP::Attribute->new('$!init_arg' => ( + init_arg => 'init_arg', reader => { 'init_arg' => \&Class::MOP::Attribute::init_arg }, predicate => { 'has_init_arg' => \&Class::MOP::Attribute::has_init_arg }, )) ); Class::MOP::Attribute->meta->add_attribute( - Class::MOP::Attribute->new('default' => ( + Class::MOP::Attribute->new('$!default' => ( + init_arg => 'default', # default has a custom 'reader' method ... predicate => { 'has_default' => \&Class::MOP::Attribute::has_default }, )) ); Class::MOP::Attribute->meta->add_attribute( - Class::MOP::Attribute->new('associated_methods' => ( - reader => { 'associated_methods' => \&Class::MOP::Attribute::associated_methods }, - default => sub { [] } + Class::MOP::Attribute->new('@!associated_methods' => ( + init_arg => 'associated_methods', + reader => { 'associated_methods' => \&Class::MOP::Attribute::associated_methods }, + default => sub { [] } )) ); @@ -355,8 +410,9 @@ Class::MOP::Attribute->meta->add_method('clone' => sub { ## Class::MOP::Method Class::MOP::Method->meta->add_attribute( - Class::MOP::Attribute->new('body' => ( - reader => { 'body' => \&Class::MOP::Method::body }, + Class::MOP::Attribute->new('&!body' => ( + init_arg => 'body', + reader => { 'body' => \&Class::MOP::Method::body }, )) ); @@ -369,29 +425,32 @@ Class::MOP::Method->meta->add_attribute( # practices of attributes, but we put # it here for completeness Class::MOP::Method::Wrapped->meta->add_attribute( - Class::MOP::Attribute->new('modifier_table') + Class::MOP::Attribute->new('%!modifier_table') ); ## -------------------------------------------------------- ## Class::MOP::Method::Accessor Class::MOP::Method::Accessor->meta->add_attribute( - Class::MOP::Attribute->new('attribute' => ( - reader => { + Class::MOP::Attribute->new('$!attribute' => ( + init_arg => 'attribute', + reader => { 'associated_attribute' => \&Class::MOP::Method::Accessor::associated_attribute }, )) ); Class::MOP::Method::Accessor->meta->add_attribute( - Class::MOP::Attribute->new('accessor_type' => ( - reader => { 'accessor_type' => \&Class::MOP::Method::Accessor::accessor_type }, + Class::MOP::Attribute->new('$!accessor_type' => ( + init_arg => 'accessor_type', + reader => { 'accessor_type' => \&Class::MOP::Method::Accessor::accessor_type }, )) ); Class::MOP::Method::Accessor->meta->add_attribute( - Class::MOP::Attribute->new('is_inline' => ( - reader => { 'is_inline' => \&Class::MOP::Method::Accessor::is_inline }, + Class::MOP::Attribute->new('$!is_inline' => ( + init_arg => 'is_inline', + reader => { 'is_inline' => \&Class::MOP::Method::Accessor::is_inline }, )) ); @@ -399,26 +458,20 @@ Class::MOP::Method::Accessor->meta->add_attribute( ## Class::MOP::Method::Constructor Class::MOP::Method::Constructor->meta->add_attribute( - Class::MOP::Attribute->new('options' => ( - reader => { + Class::MOP::Attribute->new('%!options' => ( + init_arg => 'options', + reader => { 'options' => \&Class::MOP::Method::Constructor::options }, )) ); Class::MOP::Method::Constructor->meta->add_attribute( - Class::MOP::Attribute->new('meta_instance' => ( - reader => { - 'meta_instance' => \&Class::MOP::Method::Constructor::meta_instance - }, - )) -); - -Class::MOP::Method::Constructor->meta->add_attribute( - Class::MOP::Attribute->new('attributes' => ( - reader => { - 'attributes' => \&Class::MOP::Method::Constructor::attributes - }, + Class::MOP::Attribute->new('$!associated_metaclass' => ( + init_arg => 'metaclass', + reader => { + 'associated_metaclass' => \&Class::MOP::Method::Constructor::associated_metaclass + }, )) ); @@ -430,11 +483,11 @@ Class::MOP::Method::Constructor->meta->add_attribute( # included for completeness Class::MOP::Instance->meta->add_attribute( - Class::MOP::Attribute->new('meta') + Class::MOP::Attribute->new('$!meta') ); Class::MOP::Instance->meta->add_attribute( - Class::MOP::Attribute->new('slots') + Class::MOP::Attribute->new('@!slots') ); ## -------------------------------------------------------- @@ -476,11 +529,6 @@ __END__ Class::MOP - A Meta Object Protocol for Perl 5 -=head1 SYNOPSIS - - # ... This will come later, for now see - # the other SYNOPSIS for more information - =head1 DESCRIPTON This module is an attempt to create a meta object protocol for the @@ -646,6 +694,28 @@ See L for more details. =head1 FUNCTIONS +=head2 Utility functions + +=over 4 + +=item B + +This will load a given C<$class_name> and if it does not have an +already initialized metaclass, then it will intialize one for it. + +=item B + +This will return a boolean depending on if the C<$class_name> has +been loaded. + +NOTE: This does a basic check of the symbol table to try and +determine as best it can if the C<$class_name> is loaded, it +is probably correct about 99% of the time. + +=back + +=head2 Metaclass cache functions + Class::MOP holds a cache of metaclasses, the following are functions (B) which can be used to access that cache. It is not recommended that you mess with this, bad things could happen. But if @@ -740,7 +810,7 @@ L =back -=head2 Article +=head2 Articles =over 4 @@ -765,28 +835,6 @@ All complex software has bugs lurking in it, and this module is no exception. If you find a bug please either email me, or add the bug to cpan-RT. -=head1 CODE COVERAGE - -I use L to test the code coverage of my tests, below is the -L report on this module's test suite. - - ---------------------------- ------ ------ ------ ------ ------ ------ ------ - File stmt bran cond sub pod time total - ---------------------------- ------ ------ ------ ------ ------ ------ ------ - Class/MOP.pm 97.7 100.0 88.9 94.7 100.0 3.2 96.6 - Class/MOP/Attribute.pm 75.5 77.9 82.4 88.3 100.0 4.0 81.5 - Class/MOP/Class.pm 96.9 88.8 72.1 98.2 100.0 35.8 91.4 - Class/MOP/Class/Immutable.pm 88.2 60.0 n/a 95.5 100.0 0.5 84.6 - Class/MOP/Instance.pm 86.4 75.0 33.3 86.2 100.0 1.2 87.5 - Class/MOP/Method.pm 97.5 75.0 61.5 80.6 100.0 12.7 89.7 - Class/MOP/Module.pm 100.0 n/a 55.6 100.0 100.0 0.1 90.7 - Class/MOP/Object.pm 73.3 n/a 20.0 80.0 100.0 0.1 66.7 - Class/MOP/Package.pm 94.6 71.7 33.3 100.0 100.0 42.2 87.0 - metaclass.pm 100.0 100.0 83.3 100.0 n/a 0.2 97.7 - ---------------------------- ------ ------ ------ ------ ------ ------ ------ - Total 91.3 80.4 69.8 91.9 100.0 100.0 88.1 - ---------------------------- ------ ------ ------ ------ ------ ------ ------ - =head1 ACKNOWLEDGEMENTS =over 4 @@ -801,11 +849,19 @@ Thanks to Rob for actually getting the development of this module kick-started. Stevan Little Estevan@iinteractive.comE -Yuval Kogman Enothingmuch@woobling.comE +B + +Brandon (blblack) Black + +Guillermo (groditi) Roditi + +Rob (robkinyon) Kinyon + +Yuval (nothingmuch) Kogman =head1 COPYRIGHT AND LICENSE -Copyright 2006 by Infinity Interactive, Inc. +Copyright 2006, 2007 by Infinity Interactive, Inc. L