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