Merge branch 'master' into method_map_move
Hans Dieter Pearcey [Wed, 22 Jul 2009 23:02:54 +0000 (16:02 -0700)]
Conflicts:
lib/Class/MOP/Class.pm
t/010_self_introspection.t

1  2 
Changes
lib/Class/MOP.pm
lib/Class/MOP/Class.pm
lib/Class/MOP/Package.pm
t/010_self_introspection.t

diff --cc Changes
+++ b/Changes
@@@ -1,14 -1,33 +1,36 @@@
  Revision history for Perl extension Class-MOP.
  
- 0.90
+ 0.90 Tue Jul 21, 2009
+     Japan Perl Association has sponsored Goro Fuji to improve startup
+     performance of Class::MOP and Moose. These enhancements may break
+     backwards compatibility if you're doing (or using) complex
+     metaprogramming, so, as always, test your code!
+     http://blog.perlassociation.org/2009/07/jpa-sponsors-moose-class-mop-work.html
      * Class::MOP::Class
      * XS
-       - Anonymous classes were not destroyed properly when they went
-         out of scope, leading to a memory leak. RT #47480 (Goro Fuji).
+       - Anonymous classes were not completely destroyed when they went
+         out of scope, leading to a memory leak. RT #47480. (Goro
+         Fuji).
+     * Class::MOP::Class
+       - The get_method, has_method, and add_method methods no longer
+         use get_method_map. Method objects are instantiated
+         lazily. This significantly improves Class::MOP's load
+         time. (Goro Fuji)
+     * All classes
+       - Inline fewer metaclass-level constructors since the ones we
+         have are perfectly fine. This reduces the number of string
+         evals. (Goro Fuji)
+     * Class::MOP::Method::Wrapped
+       - If a method modifier set $_, this caused the modifier to blow
+         up, because of some weird internals. (Jeremy Stashewsky)
  
 +    * Class::MOP::Class
 +    * Class::MOP::Package
 +      - Move get_method_map and its various scaffolding into Package. (hdp)
  
  0.89 Fri Jul 3, 2009
      * Class::MOP::Class
Simple merge
@@@ -10,11 -10,11 +10,11 @@@ use Class::MOP::Method::Accessor
  use Class::MOP::Method::Constructor;
  
  use Carp         'confess';
- use Scalar::Util 'blessed', 'weaken';
+ use Scalar::Util 'blessed', 'reftype', 'weaken';
 -use Sub::Name 'subname';
 +use Sub::Name    'subname';
  use Devel::GlobalDestruction 'in_global_destruction';
  
- our $VERSION   = '0.89';
+ our $VERSION   = '0.90';
  $VERSION = eval $VERSION;
  our $AUTHORITY = 'cpan:STEVAN';
  
@@@ -4,11 -4,10 +4,11 @@@ package Class::MOP::Package
  use strict;
  use warnings;
  
- use Scalar::Util 'blessed';
+ use Scalar::Util 'blessed', 'reftype';
  use Carp         'confess';
 +use Sub::Name    'subname';
  
- our $VERSION   = '0.89';
+ our $VERSION   = '0.90';
  $VERSION = eval $VERSION;
  our $AUTHORITY = 'cpan:STEVAN';
  
@@@ -91,9 -98,6 +99,11 @@@ sub namespace 
      \%{$_[0]->{'package'} . '::'} 
  }
  
 +sub method_metaclass         { $_[0]->{'method_metaclass'}            }
 +sub wrapped_method_metaclass { $_[0]->{'wrapped_method_metaclass'}    }
 +
++sub _method_map              { $_[0]->{'methods'}                     }
++
  # utility methods
  
  {
@@@ -278,97 -282,6 +288,129 @@@ sub list_all_package_symbols 
      }
  }
  
 +## Methods
 +
 +sub wrap_method_body {
 +    my ( $self, %args ) = @_;
 +
 +    ('CODE' eq ref $args{body})
 +        || confess "Your code block must be a CODE reference";
 +
 +    $self->method_metaclass->wrap(
 +        package_name => $self->name,
 +        %args,
 +    );
 +}
 +
 +sub add_method {
 +    my ($self, $method_name, $method) = @_;
 +    (defined $method_name && $method_name)
 +        || confess "You must define a method name";
 +
 +    my $body;
 +    if (blessed($method)) {
 +        $body = $method->body;
 +        if ($method->package_name ne $self->name) {
 +            $method = $method->clone(
 +                package_name => $self->name,
-                 name         => $method_name
++                name         => $method_name            
 +            ) if $method->can('clone');
 +        }
++
++        $method->attach_to_class($self);
++        $self->_method_map->{$method_name} = $method;
 +    }
 +    else {
++        # If a raw code reference is supplied, its method object is not created.
++        # The method object won't be created until required.
 +        $body = $method;
-         $method = $self->wrap_method_body( body => $body, name => $method_name );
 +    }
 +
-     $method->attach_to_class($self);
-     $self->get_method_map->{$method_name} = $method;
 +
 +    my ( $current_package, $current_name ) = Class::MOP::get_code_info($body);
 +
 +    if ( !defined $current_name || $current_name eq '__ANON__' ) {
 +        my $full_method_name = ($self->name . '::' . $method_name);
 +        subname($full_method_name => $body);
 +    }
 +
 +    $self->add_package_symbol(
 +        { sigil => '&', type => 'CODE', name => $method_name },
 +        $body,
 +    );
 +}
 +
++sub _code_is_mine {
++    my ( $self, $code ) = @_;
++
++    my ( $code_package, $code_name ) = Class::MOP::get_code_info($code);
++
++    return $code_package && $code_package eq $self->name
++        || ( $code_package eq 'constant' && $code_name eq '__ANON__' );
++}
++
 +sub has_method {
 +    my ($self, $method_name) = @_;
 +    (defined $method_name && $method_name)
 +        || confess "You must define a method name";
 +
-     exists $self->get_method_map->{$method_name};
++    return defined($self->get_method($method_name));
 +}
 +
 +sub get_method {
 +    my ($self, $method_name) = @_;
 +    (defined $method_name && $method_name)
 +        || confess "You must define a method name";
 +
-     return $self->get_method_map->{$method_name};
++    my $method_map    = $self->_method_map;
++    my $method_object = $method_map->{$method_name};
++    my $code = $self->get_package_symbol({
++        name  => $method_name,
++        sigil => '&',
++        type  => 'CODE',
++    });
++
++    unless ( $method_object && $method_object->body == ( $code || 0 ) ) {
++        if ( $code && $self->_code_is_mine($code) ) {
++            $method_object = $method_map->{$method_name}
++                = $self->wrap_method_body(
++                body                 => $code,
++                name                 => $method_name,
++                associated_metaclass => $self,
++                );
++        }
++        else {
++            delete $method_map->{$method_name};
++            return undef;
++        }
++    }
++
++    return $method_object;
 +}
 +
 +sub remove_method {
 +    my ($self, $method_name) = @_;
 +    (defined $method_name && $method_name)
 +        || confess "You must define a method name";
 +
 +    my $removed_method = delete $self->get_method_map->{$method_name};
++    
 +    $self->remove_package_symbol(
 +        { sigil => '&', type => 'CODE', name => $method_name }
 +    );
 +
 +    $removed_method->detach_from_class if $removed_method;
 +
 +    $self->update_package_cache_flag; # still valid, since we just removed the method from the map
 +
 +    return $removed_method;
 +}
 +
 +sub get_method_list {
 +    my $self = shift;
-     keys %{$self->get_method_map};
++    return grep { $self->has_method($_) } keys %{ $self->namespace };
 +}
 +
  1;
  
  __END__
@@@ -34,11 -34,6 +34,13 @@@ my @class_mop_package_methods = qw
      add_package_symbol get_package_symbol has_package_symbol remove_package_symbol
      list_all_package_symbols get_all_package_symbols remove_package_glob
  
 +    method_metaclass wrapped_method_metaclass
 +
++    _method_map
++    _code_is_mine
 +    has_method get_method add_method remove_method wrap_method_body
 +    get_method_list get_method_map
 +
      _deconstruct_variable_name
  );