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