lib/Moose/Meta/Method/Augmented.pm

   1 package Moose::Meta::Method::Augmented;
   2
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION   = '0.01';
   7 our $AUTHORITY = 'cpan:STEVAN';
   8
   9 use base 'Moose::Meta::Method';
  10
  11 use Sub::Name;
  12
  13 use Carp qw(confess);
  14
  15 sub new {
  16     my ( $class, %args ) = @_;
  17
  18     # the package can be overridden by roles
  19     # it is really more like body's compilation stash
  20     # this is where we need to override the definition of super() so that the
  21     # body of the code can call the right overridden version
  22     my $name = $args{name};
  23     my $meta = $args{class};
  24
  25     my $super = $meta->find_next_method_by_name($name);
  26
  27     (defined $super)
  28         || confess "You cannot augment '$name' because it has no super method";
  29
  30     my $_super_package = $super->package_name;
  31     # BUT!,... if this is an overriden method ....
  32     if ($super->isa('Moose::Meta::Method::Overriden')) {
  33         # we need to be sure that we actually
  34         # find the next method, which is not
  35         # an 'override' method, the reason is
  36         # that an 'override' method will not
  37         # be the one calling inner()
  38         my $real_super = $meta->_find_next_method_by_name_which_is_not_overridden($name);
  39         $_super_package = $real_super->package_name;
  40     }
  41
  42     my $super_body = $super->body;
  43
  44     my $method = $args{method};
  45
  46     my $body = sub {
  47         local $Moose::INNER_ARGS{$_super_package} = [ @_ ];
  48         local $Moose::INNER_BODY{$_super_package} = $method;
  49         $super_body->(@_);
  50     };
  51
  52     # FIXME store additional attrs
  53     $class->wrap($body);
  54 }
  55
  56 1;
  57
  58 __END__
  59
  60 =pod
  61
  62 =head1 NAME
  63
  64 Moose::Meta::Method::Augmented - A Moose Method metaclass for augmented methods
  65
  66 =head1 DESCRIPTION
  67
  68 This class implements method augmenting logic for the L<Moose> C<augment> keyword.
  69
  70 This involves setting up C<inner> for the superclass body, and dispatching to
  71 the superclass from the normal body.
  72
  73 The subclass definition (the augmentation itself) will be invoked explicitly
  74 using the C<inner> keyword from the parent class's method definition.
  75
  76 =head1 METHODS
  77
  78 =over 4
  79
  80 =item B<new>
  81
  82 =back
  83
  84 =head1 BUGS
  85
  86 All complex software has bugs lurking in it, and this module is no
  87 exception. If you find a bug please either email me, or add the bug
  88 to cpan-RT.
  89
  90 =head1 AUTHOR
  91
  92 Yuval Kogman E<lt>nothingmuch@cpan.orgE<gt>
  93
  94 =head1 COPYRIGHT AND LICENSE
  95
  96 Copyright 2006-2008 by Infinity Interactive, Inc.
  97
  98 L<http://www.iinteractive.com>
  99
 100 This library is free software; you can redistribute it and/or modify
 101 it under the same terms as Perl itself.
 102
 103 =cut