/usr/lib/perl5/Class/MOP/Object.pm is in libmoose-perl 2.0401-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 | package Class::MOP::Object;
BEGIN {
$Class::MOP::Object::AUTHORITY = 'cpan:STEVAN';
}
{
$Class::MOP::Object::VERSION = '2.0401';
}
use strict;
use warnings;
use Carp qw(confess);
use Scalar::Util 'blessed';
# introspection
sub meta {
require Class::MOP::Class;
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:
#
# use Data::Dumper;
# warn Dumper $obj;
#
# It can get seriously annoying, so why
# not just do this ...
sub dump {
my $self = shift;
require Data::Dumper;
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;
# ABSTRACT: Base class for metaclasses
=pod
=head1 NAME
Class::MOP::Object - Base class for metaclasses
=head1 VERSION
version 2.0401
=head1 DESCRIPTION
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<< Class::MOP::???->meta >>
This returns a L<Class::MOP::Class> object.
=item B<< $metaobject->dump($max_depth) >>
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
=head1 AUTHOR
Moose is maintained by the Moose Cabal, along with the help of many contributors. See L<Moose/CABAL> and L<Moose/CONTRIBUTORS> for details.
=head1 COPYRIGHT AND LICENSE
This software is copyright (c) 2011 by Infinity Interactive, Inc..
This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=cut
__END__
|