From: Stevan Little <stevan.little@iinteractive.com>
Date: Mon, 28 Aug 2006 18:14:06 +0000 (+0000)
Subject: slight speed improvements
X-Git-Tag: 0_35~13^2~4
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=92330ee202d6c3d1291e562bb392a1903a062a7e;p=gitmo%2FClass-MOP.git

slight speed improvements
---

diff --git a/lib/Class/MOP.pm b/lib/Class/MOP.pm
index 0ef8e87..5ed90a1 100644
--- a/lib/Class/MOP.pm
+++ b/lib/Class/MOP.pm
@@ -178,29 +178,23 @@ Class::MOP::Class->meta->add_attribute(
 
 Class::MOP::Class->meta->add_attribute(
     Class::MOP::Attribute->new('%:methods' => (
-        #reader => 'get_method_map',
-        #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->method_metaclass->wrap($self->get_package_symbol('&' . $_)) 
-        #            } grep { 
-        #                $self->has_package_symbol('&' . $_) 
-        #            } $self->list_all_package_symbols
-        #        };            
-        #    }
-        #},
-        #init_arg => '!............( DO NOT DO THIS )............!',
-        #default  => sub { \undef }
+        reader   => {          
+            'get_method_map' => sub {
+                my $self = shift;
+                my $map  = $self->{'%:methods'}; 
+
+                foreach my $symbol ($self->list_all_package_symbols('CODE')) {
+                    my $code = $self->get_package_symbol('&' . $symbol);
+                    
+                    next if exists $map->{$symbol} && 
+                            $map->{$symbol}->body == $code;
+
+                    $map->{$symbol} = $self->method_metaclass->wrap($code);
+                }
+
+                return $map;           
+            }
+        },
         default => sub { {} }
     ))
 );
diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index 332f832..b33acd6 100644
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -266,7 +266,7 @@ sub get_method_map {
     my $self = shift;
     my $map  = $self->{'%:methods'}; 
     
-    foreach my $symbol (grep { $self->has_package_symbol('&' . $_) } $self->list_all_package_symbols) {
+    foreach my $symbol ($self->list_all_package_symbols('CODE')) {
         next if exists $map->{$symbol} && 
                 $map->{$symbol}->body == $self->get_package_symbol('&' . $symbol);
         
@@ -377,28 +377,17 @@ sub add_method {
     my ($self, $method_name, $method) = @_;
     (defined $method_name && $method_name)
         || confess "You must define a method name";
-    # use reftype here to allow for blessed subs ...
     
     my $body;
-    
     if (blessed($method)) {
-     
-        $body = $method->body;     
-     
-        ('CODE' eq (reftype($body) || ''))
-            || confess "Your code block must be a CODE reference";        
-        
+        $body = $method->body;           
         $self->get_method_map->{$method_name} = $method;
     }
-    else {
-        
+    else {        
         $body = $method;
-        
         ('CODE' eq (reftype($body) || ''))
             || confess "Your code block must be a CODE reference";        
-        
         $self->get_method_map->{$method_name} = $self->method_metaclass->wrap($body);        
-        
     }
     
     my $full_method_name = ($self->name . '::' . $method_name);        
@@ -475,25 +464,15 @@ sub alias_method {
         || confess "You must define a method name";
 
     my $body;
-
     if (blessed($method)) {
-
         $body = $method->body;     
-
-        ('CODE' eq (reftype($body) || ''))
-            || confess "Your code block must be a CODE reference";        
-
         $self->get_method_map->{$method_name} = $method;
     }
     else {
-
         $body = $method;
-
         ('CODE' eq (reftype($body) || ''))
             || confess "Your code block must be a CODE reference";        
-
         $self->get_method_map->{$method_name} = $self->method_metaclass->wrap($body);        
-
     }
         
     $self->add_package_symbol("&${method_name}" => $body);
diff --git a/lib/Class/MOP/Package.pm b/lib/Class/MOP/Package.pm
index e5dbd4a..9116050 100644
--- a/lib/Class/MOP/Package.pm
+++ b/lib/Class/MOP/Package.pm
@@ -187,8 +187,12 @@ sub remove_package_symbol {
 }
 
 sub list_all_package_symbols {
-    my ($self) = @_;
-    return keys %{$self->namespace};
+    my ($self, $type_filter) = @_;
+    return keys %{$self->namespace} unless defined $type_filter;
+    # or we can filter based on 
+    # type (SCALAR|ARRAY|HASH|CODE)
+    my $namespace = $self->namespace;
+    return grep { defined(*{$namespace->{$_}}{$type_filter}) } keys %{$namespace};
 }
 
 1;
@@ -250,12 +254,15 @@ This will attempt to remove the package variable at C<$variable_name>.
 This will attempt to remove the entire typeglob associated with 
 C<$glob_name> from the package. 
 
-=item B<list_all_package_symbols>
+=item B<list_all_package_symbols (?$type_filter)>
 
 This will list all the glob names associated with the current package. 
 By inspecting the globs returned you can discern all the variables in 
 the package.
 
+By passing a C<$type_filter>, you can limit the list to only those 
+which match the filter (either SCALAR, ARRAY, HASH or CODE).
+
 =back
 
 =head1 AUTHORS