lib/Class/MOP/Object.pm

   1
   2 package Class::MOP::Object;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Carp qw(confess);
   8 use Moose::Util;
   9 use Scalar::Util 'blessed';
  10
  11 # introspection
  12
  13 sub meta {
  14     require Class::MOP::Class;
  15     Class::MOP::Class->initialize(blessed($_[0]) || $_[0]);
  16 }
  17
  18 sub _new {
  19     Class::MOP::class_of(shift)->new_object(@_);
  20 }
  21
  22 # RANT:
  23 # Cmon, how many times have you written
  24 # the following code while debugging:
  25 #
  26 #  use Data::Dumper;
  27 #  warn Dumper $obj;
  28 #
  29 # It can get seriously annoying, so why
  30 # not just do this ...
  31 sub dump {
  32     my $self = shift;
  33     require Data::Dumper;
  34     local $Data::Dumper::Maxdepth = shift || 1;
  35     Data::Dumper::Dumper $self;
  36 }
  37
  38 sub _real_ref_name {
  39     my $self = shift;
  40     return blessed($self);
  41 }
  42
  43 sub _is_compatible_with {
  44     my $self = shift;
  45     my ($other_name) = @_;
  46
  47     return $self->isa($other_name);
  48 }
  49
  50 sub _can_be_made_compatible_with {
  51     my $self = shift;
  52     return !$self->_is_compatible_with(@_)
  53         && defined($self->_get_compatible_metaclass(@_));
  54 }
  55
  56 sub _make_compatible_with {
  57     my $self = shift;
  58     my ($other_name) = @_;
  59
  60     my $new_metaclass = $self->_get_compatible_metaclass($other_name);
  61
  62     confess "Can't make $self compatible with metaclass $other_name"
  63         unless defined $new_metaclass;
  64
  65     # can't use rebless_instance here, because it might not be an actual
  66     # subclass in the case of, e.g. moose role reconciliation
  67     $new_metaclass->meta->_force_rebless_instance($self)
  68         if blessed($self) ne $new_metaclass;
  69
  70     return $self;
  71 }
  72
  73 sub _get_compatible_metaclass {
  74     my $self = shift;
  75     my ($other_name) = @_;
  76
  77     return $self->_get_compatible_metaclass_by_subclassing($other_name)
  78         || $self->_get_compatible_metaclass_by_role_reconciliation(@_);
  79 }
  80
  81 sub _get_compatible_metaclass_by_subclassing {
  82     my $self = shift;
  83     my ($other_name) = @_;
  84     my $meta_name = blessed($self) ? $self->_real_ref_name : $self;
  85
  86     if ($meta_name->isa($other_name)) {
  87         return $meta_name;
  88     }
  89     elsif ($other_name->isa($meta_name)) {
  90         return $other_name;
  91     }
  92
  93     return;
  94 }
  95
  96 sub _get_compatible_metaclass_by_role_reconciliation {
  97     my $self = shift;
  98     my ($other_name) = @_;
  99     my $meta_name = blessed($self) ? $self->_real_ref_name : $self;
 100
 101     return unless Moose::Util::_classes_differ_by_roles_only(
 102         $meta_name, $other_name
 103     );
 104
 105     return Moose::Util::_reconcile_roles_for_metaclass(
 106         $meta_name, $other_name
 107     );
 108 }
 109
 110 1;
 111
 112 # ABSTRACT: Base class for metaclasses
 113
 114 __END__
 115
 116 =pod
 117
 118 =head1 DESCRIPTION
 119
 120 This class is a very minimal base class for metaclasses.
 121
 122 =head1 METHODS
 123
 124 This class provides a few methods which are useful in all metaclasses.
 125
 126 =over 4
 127
 128 =item B<< Class::MOP::???->meta >>
 129
 130 This returns a L<Class::MOP::Class> object.
 131
 132 =item B<< $metaobject->dump($max_depth) >>
 133
 134 This method uses L<Data::Dumper> to dump the object. You can pass an
 135 optional maximum depth, which will set C<$Data::Dumper::Maxdepth>. The
 136 default maximum depth is 1.
 137
 138 =back
 139
 140 =cut