X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FClass%2FMOP%2FObject.pm;h=02fd6e20a50319e2c8c927fd29ffd1970f858113;hb=5efa6a46982d17e1ff642e8b97673c6618fa7e6d;hp=e20e29998cab12a19deb1e102ca14b512c906ed4;hpb=88dd563c8b2edea359b8500535b8b46a8bbe6340;p=gitmo%2FClass-MOP.git

diff --git a/lib/Class/MOP/Object.pm b/lib/Class/MOP/Object.pm
index e20e299..02fd6e2 100644
--- a/lib/Class/MOP/Object.pm
+++ b/lib/Class/MOP/Object.pm
@@ -4,9 +4,11 @@ package Class::MOP::Object;
 use strict;
 use warnings;
 
+use Carp qw(confess);
 use Scalar::Util 'blessed';
 
-our $VERSION   = '0.02';
+our $VERSION   = '1.11';
+$VERSION = eval $VERSION;
 our $AUTHORITY = 'cpan:STEVAN';
 
 # introspection
@@ -16,6 +18,10 @@ sub meta {
     Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
 }
 
+sub _new {
+    Class::MOP::class_of(shift)->new_object(@_);
+}
+
 # RANT:
 # Cmon, how many times have you written 
 # the following code while debugging:
@@ -28,10 +34,67 @@ sub meta {
 sub dump { 
     my $self = shift;
     require Data::Dumper;
-    $Data::Dumper::Maxdepth = shift || 1;
+    local $Data::Dumper::Maxdepth = shift || 1;
     Data::Dumper::Dumper $self;
 }
 
+sub _real_ref_name {
+    my $self = shift;
+    return blessed($self);
+}
+
+sub _is_compatible_with {
+    my $self = shift;
+    my ($other_name) = @_;
+
+    return $self->isa($other_name);
+}
+
+sub _can_be_made_compatible_with {
+    my $self = shift;
+    return !$self->_is_compatible_with(@_)
+        && defined($self->_get_compatible_metaclass(@_));
+}
+
+sub _make_compatible_with {
+    my $self = shift;
+    my ($other_name) = @_;
+
+    my $new_metaclass = $self->_get_compatible_metaclass($other_name);
+
+    confess "Can't make $self compatible with metaclass $other_name"
+        unless defined $new_metaclass;
+
+    # can't use rebless_instance here, because it might not be an actual
+    # subclass in the case of, e.g. moose role reconciliation
+    $new_metaclass->meta->_force_rebless_instance($self)
+        if blessed($self) ne $new_metaclass;
+
+    return $self;
+}
+
+sub _get_compatible_metaclass {
+    my $self = shift;
+    my ($other_name) = @_;
+
+    return $self->_get_compatible_metaclass_by_subclassing($other_name);
+}
+
+sub _get_compatible_metaclass_by_subclassing {
+    my $self = shift;
+    my ($other_name) = @_;
+    my $meta_name = blessed($self) ? $self->_real_ref_name : $self;
+
+    if ($meta_name->isa($other_name)) {
+        return $meta_name;
+    }
+    elsif ($other_name->isa($meta_name)) {
+        return $other_name;
+    }
+
+    return;
+}
+
 1;
 
 __END__
@@ -40,50 +103,27 @@ __END__
 
 =head1 NAME 
 
-Class::MOP::Object - Object Meta Object
+Class::MOP::Object - Base class for metaclasses
 
 =head1 DESCRIPTION
 
-This class is basically a stub, it provides no functionality at all, 
-and really just exists to make the Class::MOP metamodel complete.
-
-                         ......
-                        :      :                  
-                        :      v
-                  +-------------------+
-            +-----| Class::MOP::Class |
-            |     +-------------------+
-            |        ^      ^       ^
-            v        :      :       :
-  +--------------------+    :      +--------------------+
-  | Class::MOP::Module |    :      | Class::MOP::Object |
-  +--------------------+    :      +--------------------+
-            |               :                ^
-            |               :                |
-            |    +---------------------+     |
-            +--->| Class::MOP::Package |-----+
-                 +---------------------+
-                 
-  legend:
-    ..(is an instance of)..>
-    --(is a subclass of)--->
-
-A deeper discussion of this model is currently beyond the scope of 
-this documenation. 
-  
+This class is a very minimal base class for metaclasses.
+
 =head1 METHODS
 
+This class provides a few methods which are useful in all metaclasses.
+
 =over 4
 
-=item B<meta>
+=item B<< Class::MOP::???->meta >>
+
+This returns a L<Class::MOP::Class> object.
 
-=item B<dump (?$max_depth)>
+=item B<< $metaobject->dump($max_depth) >>
 
-This will C<require> the L<Data::Dumper> module and then dump a 
-representation of your object. It passed the C<$max_depth> arg 
-to C<$Data::Dumper::Maxdepth>. The default C<$max_depth> is 1, 
-so it will not go crazy and print a massive bunch of stuff. 
-Adjust this as nessecary.
+This method uses L<Data::Dumper> to dump the object. You can pass an
+optional maximum depth, which will set C<$Data::Dumper::Maxdepth>. The
+default maximum depth is 1.
 
 =back
 
@@ -93,7 +133,7 @@ Stevan Little E<lt>stevan@iinteractive.comE<gt>
 
 =head1 COPYRIGHT AND LICENSE
 
-Copyright 2006 by Infinity Interactive, Inc.
+Copyright 2006-2010 by Infinity Interactive, Inc.
 
 L<http://www.iinteractive.com>