From: Stevan Little Date: Sun, 20 Aug 2006 16:42:18 +0000 (+0000) Subject: adding the methods attribute X-Git-Tag: 0_34~2 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=c4260b45e76ce008e4c51987b243f2b0ae4313bb;p=gitmo%2FClass-MOP.git adding the methods attribute --- diff --git a/Changes b/Changes index 02bbe15..9f6b96d 100644 --- a/Changes +++ b/Changes @@ -1,5 +1,22 @@ Revision history for Perl extension Class-MOP. +0.34 + * Class::MOP::Class + - added the %:methods attribute, which like + the $:version and such just actually goes + to the symbol table to get it's stuff. + However, it makes the MOP more complete. + + * Class::MOP::Object + - added &dump method to easily Data::Dumper + an object + + * Class::MOP + - cleaned up the initialization of attributes + which do not store things in the instance + - added the %:methods attribute definition to + the bootstrap + 0.33 Sat. Aug. 19, 2006 * Class::MOP::Class - moved the metaclass cache out of here diff --git a/README b/README index 8b810ad..c65f87f 100644 --- a/README +++ b/README @@ -1,4 +1,4 @@ -Class::MOP version 0.33 +Class::MOP version 0.34 =========================== See the individual module documentation for more information diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index ed30abf..ef130fc 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -13,7 +13,7 @@ use Class::MOP::Method; use Class::MOP::Class::Immutable; -our $VERSION = '0.33'; +our $VERSION = '0.34'; our $AUTHORITY = 'cpan:STEVAN'; { @@ -98,6 +98,7 @@ Class::MOP::Package->meta->add_attribute( # NOTE: # protect this from silliness init_arg => '!............( DO NOT DO THIS )............!', + default => sub { \undef } )) ); @@ -134,6 +135,7 @@ Class::MOP::Module->meta->add_attribute( # NOTE: # protect this from silliness init_arg => '!............( DO NOT DO THIS )............!', + default => sub { \undef } )) ); @@ -154,6 +156,7 @@ Class::MOP::Module->meta->add_attribute( # NOTE: # protect this from silliness init_arg => '!............( DO NOT DO THIS )............!', + default => sub { \undef } )) ); @@ -174,6 +177,33 @@ Class::MOP::Class->meta->add_attribute( ); Class::MOP::Class->meta->add_attribute( + Class::MOP::Attribute->new('%:methods' => ( + reader => { + # NOTE: + # as with the $VERSION and $AUTHORITY above + # sometimes we don't/can't store directly + # inside the instance, so we need the accessor + # to just DWIM + 'get_method_map' => sub { + my $self = shift; + # FIXME: + # there is a faster/better way + # to do this, I am sure :) + return +{ + map { + $_ => $self->get_method($_) + } grep { + $self->has_method($_) + } $self->list_all_package_symbols + }; + } + }, + init_arg => '!............( DO NOT DO THIS )............!', + default => sub { \undef } + )) +); + +Class::MOP::Class->meta->add_attribute( Class::MOP::Attribute->new('$:attribute_metaclass' => ( reader => 'attribute_metaclass', init_arg => ':attribute_metaclass', diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index aca8a50..88842f3 100644 --- a/lib/Class/MOP/Class.pm +++ b/lib/Class/MOP/Class.pm @@ -9,7 +9,7 @@ use Scalar::Util 'blessed', 'reftype', 'weaken'; use Sub::Name 'subname'; use B 'svref_2object'; -our $VERSION = '0.18'; +our $VERSION = '0.19'; our $AUTHORITY = 'cpan:STEVAN'; use base 'Class::MOP::Module'; @@ -77,12 +77,23 @@ sub construct_class_instance { $meta = bless { # inherited from Class::MOP::Package '$:package' => $package_name, - '%:namespace' => \%{$package_name . '::'}, + + # NOTE: + # since the following attributes will + # actually be loaded from the symbol + # table, and actually bypass the instance + # entirely, we can just leave these things + # listed here for reference, because they + # should not actually have a value associated + # with the slot. + '%:namespace' => \undef, # 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' => {}, + '$:version' => \undef, + '$:authority' => \undef, + # defined in Class::MOP::Class + '%:methods' => \undef, + + '%:attributes' => {}, '$:attribute_metaclass' => $options{':attribute_metaclass'} || 'Class::MOP::Attribute', '$:method_metaclass' => $options{':method_metaclass'} || 'Class::MOP::Method', '$:instance_metaclass' => $options{':instance_metaclass'} || 'Class::MOP::Instance', @@ -238,6 +249,20 @@ sub attribute_metaclass { $_[0]->{'$:attribute_metaclass'} } sub method_metaclass { $_[0]->{'$:method_metaclass'} } sub instance_metaclass { $_[0]->{'$:instance_metaclass'} } +sub get_method_map { + my $self = shift; + # FIXME: + # there is a faster/better way + # to do this, I am sure :) + return +{ + map { + $_ => $self->get_method($_) + } grep { + $self->has_method($_) + } $self->list_all_package_symbols + }; +} + # Instance Construction & Cloning sub new_object { @@ -891,6 +916,8 @@ what B does, but we don't remove duplicate names. =over 4 +=item B + =item B =item B diff --git a/lib/Class/MOP/Object.pm b/lib/Class/MOP/Object.pm index b115ffa..1535cf7 100644 --- a/lib/Class/MOP/Object.pm +++ b/lib/Class/MOP/Object.pm @@ -6,7 +6,7 @@ use warnings; use Scalar::Util 'blessed'; -our $VERSION = '0.01'; +our $VERSION = '0.02'; our $AUTHORITY = 'cpan:STEVAN'; # introspection @@ -16,6 +16,22 @@ sub meta { Class::MOP::Class->initialize(blessed($_[0]) || $_[0]); } +# RANT: +# Cmon, how many times have you written +# the following code while debugging: +# +# use Data::Dumper; +# warn Dumper $obj; +# +# It can get seriously annoying, so why +# not just do this ... +sub dump { + my $self = shift; + require Data::Dumper; + $Data::Dumper::Maxdepth = shift || 1; + Data::Dumper::Dumper $self; +} + 1; __END__ @@ -61,6 +77,8 @@ this documenation. =item B +=item B + =back =head1 AUTHORS diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm index c932fdc..e5dbd4a 100644 --- a/lib/Class/MOP/Package.pm +++ b/lib/Class/MOP/Package.pm @@ -7,7 +7,7 @@ use warnings; use Scalar::Util 'blessed'; use Carp 'confess'; -our $VERSION = '0.03'; +our $VERSION = '0.04'; our $AUTHORITY = 'cpan:STEVAN'; use base 'Class::MOP::Object'; @@ -36,7 +36,7 @@ sub initialize { # reference to the hash in the accessor. # Ideally we could just store a ref and # it would Just Work, but oh well :\ - #'%:namespace' => \%{$package_name . '::'}, + '%:namespace' => \undef, } => $class; } diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t index 80db516..b102c2d 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 => 185; +use Test::More tests => 189; use Test::Exception; BEGIN { @@ -64,7 +64,7 @@ my @class_mop_class_methods = qw( superclasses class_precedence_list has_method get_method add_method remove_method alias_method - get_method_list compute_all_applicable_methods + get_method_list get_method_map compute_all_applicable_methods find_method_by_name find_all_methods_by_name find_next_method_by_name add_before_method_modifier add_after_method_modifier add_around_method_modifier @@ -143,6 +143,7 @@ my @class_mop_module_attributes = ( ); my @class_mop_class_attributes = ( + '%:methods', '%:attributes', '$:attribute_metaclass', '$:method_metaclass',