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