lib/Class/MOP/Method.pm

   1
   2 package Class::MOP::Method;
   3
   4 use strict;
   5 use warnings;
   6
   7 use Carp         'confess';
   8 use Scalar::Util 'blessed';
   9
  10 our $VERSION   = '0.64';
  11 our $AUTHORITY = 'cpan:STEVAN';
  12
  13 use base 'Class::MOP::Object';
  14
  15 # NOTE:
  16 # if poked in the right way,
  17 # they should act like CODE refs.
  18 use overload '&{}' => sub { $_[0]->body }, fallback => 1;
  19
  20 our $UPGRADE_ERROR_TEXT = q{
  21 ---------------------------------------------------------
  22 NOTE: this error is likely not an error, but a regression
  23 caused by the latest upgrade to Moose/Class::MOP. Consider
  24 upgrading any MooseX::* modules to their latest versions
  25 before spending too much time chasing this one down.
  26 ---------------------------------------------------------
  27 };
  28
  29 # construction
  30
  31 sub wrap {
  32     my ( $class, $code, %params ) = @_;
  33
  34     ('CODE' eq ref($code))
  35         || confess "You must supply a CODE reference to bless, not (" . ($code || 'undef') . ")";
  36
  37     ($params{package_name} && $params{name})
  38         || confess "You must supply the package_name and name parameters $UPGRADE_ERROR_TEXT";
  39
  40     bless {
  41         '&!body'         => $code,
  42         '$!package_name' => $params{package_name},
  43         '$!name'         => $params{name},
  44     } => blessed($class) || $class;
  45 }
  46
  47 ## accessors
  48
  49 sub body { (shift)->{'&!body'} }
  50
  51 # TODO - add associated_class
  52
  53 # informational
  54
  55 sub package_name {
  56     my $self = shift;
  57     $self->{'$!package_name'} ||= (Class::MOP::get_code_info($self->body))[0];
  58 }
  59
  60 sub name {
  61     my $self = shift;
  62     $self->{'$!name'} ||= (Class::MOP::get_code_info($self->body))[1];
  63 }
  64
  65 sub fully_qualified_name {
  66     my $code = shift;
  67     $code->package_name . '::' . $code->name;
  68 }
  69
  70 # NOTE:
  71 # the Class::MOP bootstrap
  72 # will create this for us
  73 # - SL
  74 # sub clone { ... }
  75
  76 1;
  77
  78 __END__
  79
  80 =pod
  81
  82 =head1 NAME
  83
  84 Class::MOP::Method - Method Meta Object
  85
  86 =head1 DESCRIPTION
  87
  88 The Method Protocol is very small, since methods in Perl 5 are just
  89 subroutines within the particular package. We provide a very basic
  90 introspection interface.
  91
  92 =head1 METHODS
  93
  94 =head2 Introspection
  95
  96 =over 4
  97
  98 =item B<meta>
  99
 100 This will return a B<Class::MOP::Class> instance which is related
 101 to this class.
 102
 103 =back
 104
 105 =head2 Construction
 106
 107 =over 4
 108
 109 =item B<wrap ($code, %params)>
 110
 111 This is the basic constructor, it returns a B<Class::MOP::Method>
 112 instance which wraps the given C<$code> reference. You can also
 113 set the C<package_name> and C<name> attributes using the C<%params>.
 114 If these are not set, then thier accessors will attempt to figure
 115 it out using the C<Class::MOP::get_code_info> function.
 116
 117 =item B<clone (%params)>
 118
 119 This will make a copy of the object, allowing you to override
 120 any values by stuffing them in C<%params>.
 121
 122 =back
 123
 124 =head2 Informational
 125
 126 =over 4
 127
 128 =item B<body>
 129
 130 This returns the actual CODE reference of the particular instance.
 131
 132 =item B<name>
 133
 134 This returns the name of the CODE reference.
 135
 136 =item B<package_name>
 137
 138 This returns the package name that the CODE reference is attached to.
 139
 140 =item B<fully_qualified_name>
 141
 142 This returns the fully qualified name of the CODE reference.
 143
 144 =back
 145
 146 =head1 AUTHORS
 147
 148 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 149
 150 =head1 COPYRIGHT AND LICENSE
 151
 152 Copyright 2006-2008 by Infinity Interactive, Inc.
 153
 154 L<http://www.iinteractive.com>
 155
 156 This library is free software; you can redistribute it and/or modify
 157 it under the same terms as Perl itself.
 158
 159 =cut
 160