bump version # for next release

[gitmo/Class-MOP.git] / lib / Class / MOP / Class.pm

diff --git a/lib/Class/MOP/Class.pm b/lib/Class/MOP/Class.pm
index e8cf77f..62cfb67 100644 (file)
--- a/lib/Class/MOP/Class.pm
+++ b/lib/Class/MOP/Class.pm
@@ -11,7 +11,8 @@ use Class::MOP::Method::Wrapped;
 use Carp         'confess';
 use Scalar::Util 'blessed', 'weaken';
 
-our $VERSION   = '0.65';
+our $VERSION   = '0.64_02';
+$VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
 use base 'Class::MOP::Module';
@@ -37,15 +38,6 @@ sub initialize {
         || $class->construct_class_instance(package => $package_name, @_);
 }
 
-sub reinitialize {
-    my $class        = shift;
-    my $package_name = shift;
-    (defined $package_name && $package_name && !blessed($package_name))
-        || confess "You must pass a package name and it cannot be blessed";
-    Class::MOP::remove_metaclass_by_name($package_name);
-    $class->construct_class_instance('package' => $package_name, @_);
-}
-
 # NOTE: (meta-circularity)
 # this is a special form of &construct_instance
 # (see below), which is used to construct class
@@ -596,6 +588,20 @@ sub class_precedence_list {
 
 ## Methods
 
+sub wrap_method_body {
+    my ( $self, %args ) = @_;
+
+    my $body = delete $args{body}; # delete is for compat
+
+    ('CODE' eq ref($body))
+        || confess "Your code block must be a CODE reference";
+
+    $self->method_metaclass->wrap( $body => (
+        package_name => $self->name,
+        %args,
+    ));
+}
+
 sub add_method {
     my ($self, $method_name, $method) = @_;
     (defined $method_name && $method_name)
@@ -617,14 +623,7 @@ sub add_method {
     }
     else {
         $body = $method;
-        ('CODE' eq ref($body))
-            || confess "Your code block must be a CODE reference";
-        $method = $self->method_metaclass->wrap(
-            $body => (
-                package_name => $self->name,
-                name         => $method_name
-            )
-        );
+        $method = $self->wrap_method_body( body => $body, name => $method_name );
     }
 
     $method->attach_to_class($self);
@@ -722,6 +721,8 @@ sub alias_method {
     $self->add_package_symbol(
         { sigil => '&', type => 'CODE', name => $method_name } => $body
     );
+
+    $self->update_package_cache_flag; # the method map will not list aliased methods
 }
 
 sub has_method {
@@ -729,8 +730,7 @@ sub has_method {
     (defined $method_name && $method_name)
         || confess "You must define a method name";
 
-    return 0 unless exists $self->get_method_map->{$method_name};
-    return 1;
+    exists $self->get_method_map->{$method_name};
 }
 
 sub get_method {
@@ -989,6 +989,25 @@ sub find_attribute_by_name {
     return;
 }
 
+# check if we can reinitialize
+sub is_pristine {
+    my $self = shift;
+
+    # if any local attr is defined
+    return if $self->get_attribute_list;
+
+    # or any non-declared methods
+    if ( my @methods = values %{ $self->get_method_map } ) {
+        my $metaclass = $self->method_metaclass;
+        foreach my $method ( @methods ) {
+            return if $method->isa("Class::MOP::Method::Generated");
+            # FIXME do we need to enforce this too? return unless $method->isa($metaclass);
+        }
+    }
+
+    return 1;
+}
+
 ## Class closing
 
 sub is_mutable   { 1 }
@@ -1080,7 +1099,9 @@ sub create_immutable_transformer {
         /],
         memoize     => {
            class_precedence_list             => 'ARRAY',
-           linearized_isa                    => 'ARRAY',
+           linearized_isa                    => 'ARRAY', # FIXME perl 5.10 memoizes this on its own, no need?
+           get_all_methods                   => 'ARRAY',
+           #get_all_attributes               => 'ARRAY', # it's an alias, no need, but maybe in the future
            compute_all_applicable_attributes => 'ARRAY',
            get_meta_instance                 => 'SCALAR',
            get_method_map                    => 'SCALAR',
@@ -1217,12 +1238,6 @@ as we use a special reserved slot (C<__MOP__>) to store this.
 This initializes and returns returns a B<Class::MOP::Class> object
 for a given a C<$package_name>.
 
-=item B<reinitialize ($package_name, %options)>
-
-This removes the old metaclass, and creates a new one in it's place.
-Do B<not> use this unless you really know what you are doing, it could
-very easily make a very large mess of your program.
-
 =item B<construct_class_instance (%options)>
 
 This will construct an instance of B<Class::MOP::Class>, it is
@@ -1390,6 +1405,11 @@ This returns true if the class is still mutable.
 
 This returns true if the class has been made immutable.
 
+=item B<is_pristine>
+
+Checks whether the class has any data that will be lost if C<reinitialize> is
+called.
+
 =back
 
 =head2 Inheritance Relationships
@@ -1432,7 +1452,11 @@ Returns a HASH ref of name to CODE reference mapping for this class.
 Returns the class name of the method metaclass, see L<Class::MOP::Method> 
 for more information on the method metaclasses.
 
-=item B<add_method ($method_name, $method)>
+=item B<wrap_method_body(%attrs)>
+
+Wrap a code ref (C<$attrs{body>) with C<method_metaclass>.
+
+=item B<add_method ($method_name, $method, %attrs)>
 
 This will take a C<$method_name> and CODE reference to that
 C<$method> and install it into the class's package.