lib/Class/MOP/Method/Inlined.pm

   1 package Class::MOP::Method::Inlined;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Carp         'confess';
   7 use Scalar::Util 'blessed', 'weaken', 'looks_like_number', 'refaddr';
   8
   9 our $AUTHORITY = 'cpan:STEVAN';
  10
  11 use base 'Class::MOP::Method::Generated';
  12
  13 sub _uninlined_body {
  14     my $self = shift;
  15
  16     my $super_method
  17         = $self->associated_metaclass->find_next_method_by_name( $self->name )
  18         or return;
  19
  20     if ( $super_method->isa(__PACKAGE__) ) {
  21         return $super_method->_uninlined_body;
  22     }
  23     else {
  24         return $super_method->body;
  25     }
  26 }
  27
  28 sub can_be_inlined {
  29     my $self      = shift;
  30     my $metaclass = $self->associated_metaclass;
  31     my $class     = $metaclass->name;
  32
  33     # If we don't find an inherited method, this is a rather weird
  34     # case where we have no method in the inheritance chain even
  35     # though we're expecting one to be there
  36     my $inherited_method
  37         = $metaclass->find_next_method_by_name( $self->name );
  38
  39     if (   $inherited_method
  40         && $inherited_method->isa('Class::MOP::Method::Wrapped') ) {
  41         warn "Not inlining '"
  42             . $self->name
  43             . "' for $class since it "
  44             . "has method modifiers which would be lost if it were inlined\n";
  45
  46         return 0;
  47     }
  48
  49     my $expected_class = $self->_expected_method_class
  50         or return 1;
  51
  52     # if we are shadowing a method we first verify that it is
  53     # compatible with the definition we are replacing it with
  54     my $expected_method = $expected_class->can( $self->name );
  55
  56     if ( ! $expected_method ) {
  57         warn "Not inlining '"
  58             . $self->name
  59             . "' for $class since ${expected_class}::"
  60             . $self->name
  61             . " is not defined\n";
  62
  63         return 0;
  64     }
  65
  66     my $actual_method = $class->can( $self->name )
  67         or return 1;
  68
  69     # the method is what we wanted (probably Moose::Object::new)
  70     return 1
  71         if refaddr($expected_method) == refaddr($actual_method);
  72
  73     # otherwise we have to check that the actual method is an inlined
  74     # version of what we're expecting
  75     if ( $inherited_method->isa(__PACKAGE__) ) {
  76         if ( $inherited_method->_uninlined_body
  77              && refaddr( $inherited_method->_uninlined_body )
  78              == refaddr($expected_method) ) {
  79             return 1;
  80         }
  81     }
  82     elsif ( refaddr( $inherited_method->body )
  83             == refaddr($expected_method) ) {
  84         return 1;
  85     }
  86
  87     my $warning
  88         = "Not inlining '"
  89         . $self->name
  90         . "' for $class since it is not"
  91         . " inheriting the default ${expected_class}::"
  92         . $self->name . "\n";
  93
  94     if ( $self->isa("Class::MOP::Method::Constructor") ) {
  95
  96         # FIXME kludge, refactor warning generation to a method
  97         $warning
  98             .= "If you are certain you don't need to inline your"
  99             . " constructor, specify inline_constructor => 0 in your"
 100             . " call to $class->meta->make_immutable\n";
 101     }
 102
 103     warn $warning;
 104
 105     return 0;
 106 }
 107
 108 1;
 109
 110 # ABSTRACT: Method base class for methods which have been inlined
 111
 112 __END__
 113
 114 =pod
 115
 116 =head1 DESCRIPTION
 117
 118 This is a L<Class::MOP::Method::Generated> subclass for methods which
 119 can be inlined.
 120
 121 =head1 METHODS
 122
 123 =over 4
 124
 125 =item B<< $metamethod->can_be_inlined >>
 126
 127 This method returns true if the method in question can be inlined in
 128 the associated metaclass.
 129
 130 If it cannot be inlined, it spits out a warning and returns false.
 131
 132 =back
 133
 134 =cut
 135