From: Stevan Little Date: Thu, 3 Aug 2006 19:54:18 +0000 (+0000) Subject: encapsulated-package-features X-Git-Tag: 0_33~11^2~6 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9d6dce77cd867d92c418eb4fcfd199eaca6efc10;p=gitmo%2FClass-MOP.git encapsulated-package-features --- diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm index af04c94..05176ef 100644 --- a/lib/Class/MOP.pm +++ b/lib/Class/MOP.pm @@ -53,6 +53,15 @@ Class::MOP::Package->meta->add_attribute( )) ); +# NOTE: +# use the metaclass to construct the meta-package +# which is a superclass of the metaclass itself :P +Class::MOP::Package->meta->add_method('initialize' => sub { + my $class = shift; + my $package_name = shift; + $class->meta->new_object(':package' => $package_name, @_); +}); + ## Class::MOP::Class Class::MOP::Class->meta->add_attribute( @@ -97,6 +106,12 @@ Class::MOP::Class->meta->add_attribute( )) ); +# NOTE: +# we don't actually need to tie the knot with +# Class::MOP::Class here, it is actually handled +# within Class::MOP::Class itself in the +# construct_class_instance method. + ## Class::MOP::Attribute Class::MOP::Attribute->meta->add_attribute( diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm index f881534..b2cb51d 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.16'; +our $VERSION = '0.17'; use base 'Class::MOP::Module'; @@ -93,7 +93,7 @@ my $ANON_CLASS_PREFIX = 'Class::MOP::Class::__ANON__::SERIAL::'; $class = blessed($class) || $class; # now create the metaclass my $meta; - if ($class =~ /^Class::MOP::/) { + if ($class =~ /^Class::MOP::Class$/) { $meta = bless { '$:package' => $package_name, '%:attributes' => {}, @@ -299,10 +299,9 @@ sub clone_instance { sub superclasses { my $self = shift; - no strict 'refs'; if (@_) { my @supers = @_; - @{$self->name . '::ISA'} = @supers; + @{$self->get_package_symbol('@ISA')} = @supers; # NOTE: # we need to check the metaclass # compatability here so that we can @@ -311,7 +310,7 @@ sub superclasses { # we don't know about $self->check_metaclass_compatability(); } - @{$self->name . '::ISA'}; + @{$self->get_package_symbol('@ISA')}; } sub class_precedence_list { @@ -342,11 +341,11 @@ sub add_method { || confess "Your code block must be a CODE reference"; my $full_method_name = ($self->name . '::' . $method_name); + # FIXME: + # dont bless subs, its bad mkay $method = $self->method_metaclass->wrap($method) unless blessed($method); - no strict 'refs'; - no warnings 'redefine'; - *{$full_method_name} = subname $full_method_name => $method; + $self->add_package_symbol("&${method_name}" => subname $full_method_name => $method); } { @@ -420,41 +419,33 @@ sub alias_method { # use reftype here to allow for blessed subs ... ('CODE' eq (reftype($method) || '')) || confess "Your code block must be a CODE reference"; - my $full_method_name = ($self->name . '::' . $method_name); + # FIXME: + # dont bless subs, its bad mkay $method = $self->method_metaclass->wrap($method) unless blessed($method); - no strict 'refs'; - no warnings 'redefine'; - *{$full_method_name} = $method; + $self->add_package_symbol("&${method_name}" => $method); } sub find_method_by_name { - my ( $self, $method_name ) = @_; - - return $self->name->can( $method_name ); + my ($self, $method_name) = @_; + return $self->name->can($method_name); } sub has_method { my ($self, $method_name) = @_; (defined $method_name && $method_name) || confess "You must define a method name"; - - my $sub_name = ($self->name . '::' . $method_name); - no strict 'refs'; - return 0 if !defined(&{$sub_name}); - my $method = \&{$sub_name}; + return 0 if !$self->has_package_symbol("&${method_name}"); + my $method = $self->get_package_symbol("&${method_name}"); return 0 if (svref_2object($method)->GV->STASH->NAME || '') ne $self->name && (svref_2object($method)->GV->NAME || '') ne '__ANON__'; - #if ( $self->name->can("meta") ) { - # don't bless (destructive operation) classes that didn't ask for it - - # at this point we are relatively sure - # it is our method, so we bless/wrap it - $self->method_metaclass->wrap($method) unless blessed($method); - #} + # FIXME: + # dont bless subs, its bad mkay + $self->method_metaclass->wrap($method) unless blessed($method); + return 1; } @@ -464,9 +455,8 @@ sub get_method { || confess "You must define a method name"; return unless $self->has_method($method_name); - - no strict 'refs'; - return \&{$self->name . '::' . $method_name}; + + return $self->get_package_symbol("&${method_name}"); } sub remove_method { @@ -476,8 +466,7 @@ sub remove_method { my $removed_method = $self->get_method($method_name); - no strict 'refs'; - delete ${$self->name . '::'}{$method_name} + $self->remove_package_symbol("&${method_name}") if defined $removed_method; return $removed_method; @@ -485,8 +474,7 @@ sub remove_method { sub get_method_list { my $self = shift; - no strict 'refs'; - grep { $self->has_method($_) } keys %{$self->name . '::'}; + grep { $self->has_method($_) } $self->list_all_package_symbols; } sub compute_all_applicable_methods { @@ -574,9 +562,6 @@ sub add_attribute { $attribute->attach_to_class($self); $attribute->install_accessors(); $self->get_attribute_map->{$attribute->name} = $attribute; - - # FIXME - # in theory we have to tell everyone the slot structure may have changed } sub has_attribute { diff --git a/lib/Class/MOP/Module.pm b/lib/Class/MOP/Module.pm index eee05f5..7e18bdc 100644 --- a/lib/Class/MOP/Module.pm +++ b/lib/Class/MOP/Module.pm @@ -6,7 +6,12 @@ use warnings; use Scalar::Util 'blessed'; -our $VERSION = '0.01'; +our $VERSION = '0.02'; +#our $AUTHORITY = { +# cpan => 'STEVAN', +# mailto => 'stevan@iinteractive.com', +# http => '//www.iinteractive.com/' +#}; use base 'Class::MOP::Package'; @@ -17,11 +22,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'); +#} + + 1; __END__ diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm index 0f9849d..82a7324 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.01'; +our $VERSION = '0.02'; # introspection @@ -19,8 +19,11 @@ sub meta { # creation ... sub initialize { - my ($class, $package) = @_; - bless { '$:package' => $package } => $class; + my $class = shift; + my $package_name = shift; + # we hand-construct the class + # until we can bootstrap it + return bless { '$:package' => $package_name } => $class; } # Attributes @@ -56,7 +59,7 @@ sub name { $_[0]->{'$:package'} } || confess "I do not recognize that sigil '$sigil'"; no strict 'refs'; - no warnings 'misc'; + no warnings 'misc', 'redefine'; *{$self->name . '::' . $name} = $initial_value; } @@ -121,13 +124,29 @@ sub name { $_[0]->{'$:package'} } undef %{$self->name . '::' . $name}; } elsif ($SIGIL_MAP{$sigil} eq 'CODE') { - undef &{$self->name . '::' . $name}; + # FIXME: + # this is crap, it is probably much + # easier to write this in XS. + my ($scalar, @array, %hash); + $scalar = ${$self->name . '::' . $name} if defined *{$self->name . '::' . $name}{SCALAR}; + @array = @{$self->name . '::' . $name} if defined *{$self->name . '::' . $name}{ARRAY}; + %hash = %{$self->name . '::' . $name} if defined *{$self->name . '::' . $name}{HASH}; + delete ${$self->name . '::'}{$name}; + ${$self->name . '::' . $name} = $scalar if defined $scalar; + @{$self->name . '::' . $name} = @array if scalar @array; + %{$self->name . '::' . $name} = %hash if keys %hash; } else { confess "This should never ever ever happen"; } } + +} +sub list_all_package_symbols { + my ($self) = @_; + no strict 'refs'; + return keys %{$self->name . '::'}; } 1; @@ -162,6 +181,8 @@ Class::MOP::Package - Package Meta Object =item B +=item B + =back =head1 AUTHORS diff --git a/t/010_self_introspection.t b/t/010_self_introspection.t index 018b7c2..5972bdb 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 => 171; +use Test::More tests => 173; use Test::Exception; BEGIN { @@ -34,7 +34,7 @@ my @class_mop_package_methods = qw( name - add_package_symbol get_package_symbol has_package_symbol remove_package_symbol + add_package_symbol get_package_symbol has_package_symbol remove_package_symbol list_all_package_symbols ); my @class_mop_module_methods = qw(