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         svref_2object($code)->GV->STASH->NAME;
  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         svref_2object($code)->GV->NAME;
  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 SYNOPSIS
  84
  85   # ... more to come later maybe
  86
  87 =head1 DESCRIPTION
  88
  89 The Method Protocol is very small, since methods in Perl 5 are just
  90 subroutines within the particular package. We provide a very basic
  91 introspection interface.
  92
  93 =head1 METHODS
  94
  95 =head2 Introspection
  96
  97 =over 4
  98
  99 =item B<meta>
 100
 101 This will return a B<Class::MOP::Class> instance which is related
 102 to this class.
 103
 104 =back
 105
 106 =head2 Construction
 107
 108 =over 4
 109
 110 =item B<wrap (&code)>
 111
 112 =back
 113
 114 =head2 Informational
 115
 116 =over 4
 117
 118 =item B<body>
 119
 120 =item B<name>
 121
 122 =item B<package_name>
 123
 124 =item B<fully_qualified_name>
 125
 126 =back
 127
 128 =head1 AUTHORS
 129
 130 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 131
 132 Yuval Kogman E<lt>nothingmuch@woobling.comE<gt>
 133
 134 =head1 COPYRIGHT AND LICENSE
 135
 136 Copyright 2006, 2007 by Infinity Interactive, Inc.
 137
 138 L<http://www.iinteractive.com>
 139
 140 This library is free software; you can redistribute it and/or modify
 141 it under the same terms as Perl itself.
 142
 143 =cut
 144