lib/Moose/Meta/Method/Does.pm

   1 package Moose::Meta::Method::Does;
   2
   3 use strict;
   4 use warnings;
   5
   6 use Scalar::Util 'blessed', 'weaken', 'looks_like_number', 'refaddr';
   7
   8 our $VERSION   = '1.12';
   9 our $AUTHORITY = 'cpan:STEVAN';
  10
  11 use base 'Moose::Meta::Method',
  12          'Class::MOP::Method::Inlined';
  13
  14 sub new {
  15     my $class   = shift;
  16     my %options = @_;
  17
  18     my $meta = $options{metaclass};
  19
  20     ( ref $options{options} eq 'HASH' )
  21         || $class->throw_error( "You must pass a hash of options",
  22         data => $options{options} );
  23
  24     $options{package_name}
  25         || $class->throw_error(
  26         "You must supply the package_name parameter" );
  27
  28     my $self = bless {
  29         'body'                   => undef,
  30         'package_name'           => $options{package_name},
  31         'name'                   => 'does',
  32         'options'                => $options{options},
  33         'associated_metaclass'   => $meta,
  34         '_expected_method_class' => $options{_expected_method_class}
  35             || 'Moose::Object',
  36     } => $class;
  37
  38     weaken( $self->{'associated_metaclass'} );
  39
  40     $self->_initialize_body;
  41
  42     return $self;
  43 }
  44
  45 sub _initialize_body {
  46     my $self = shift;
  47
  48     my $source = 'sub {';
  49     $source
  50         .= "\n"
  51         . 'defined $_[1] || '
  52         . $self->_inline_throw_error(
  53         q{"You must supply a role name to does()"});
  54     $source .= ";\n" . 'my $name = Scalar::Util::blessed( $_[1] ) ? $_[1]->name : $_[1]';
  55     $source .= ";\n" . 'return $does{$name} || 0';
  56     $source .= ";\n" . '}';
  57
  58     my %does = map { $_->name => 1 }
  59         $self->associated_metaclass->calculate_all_roles_with_inheritance;
  60
  61     my ( $code, $e ) = $self->_compile_code(
  62         code        => $source,
  63         environment => {
  64             '%does' => \%does,
  65             '$meta' => \$self,
  66         },
  67     );
  68
  69     $self->throw_error(
  70         "Could not eval the does method :\n\n$source\n\nbecause :\n\n$e",
  71         error => $e,
  72         data  => $source,
  73     ) if $e;
  74
  75     $self->{'body'} = $code;
  76 }
  77
  78 1;
  79
  80 __END__
  81
  82 =pod
  83
  84 =head1 NAME
  85
  86 Moose::Meta::Method::Constructor - Method Meta Object for constructors
  87
  88 =head1 DESCRIPTION
  89
  90 This class is a subclass of L<Class::MOP::Method::Constructor> that
  91 provides additional Moose-specific functionality
  92
  93 To understand this class, you should read the the
  94 L<Class::MOP::Method::Constructor> documentation as well.
  95
  96 =head1 INHERITANCE
  97
  98 C<Moose::Meta::Method::Constructor> is a subclass of
  99 L<Moose::Meta::Method> I<and> L<Class::MOP::Method::Constructor>.
 100
 101 =head1 BUGS
 102
 103 See L<Moose/BUGS> for details on reporting bugs.
 104
 105 =head1 AUTHORS
 106
 107 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 108
 109 =head1 COPYRIGHT AND LICENSE
 110
 111 Copyright 2006-2010 by Infinity Interactive, Inc.
 112
 113 L<http://www.iinteractive.com>
 114
 115 This library is free software; you can redistribute it and/or modify
 116 it under the same terms as Perl itself.
 117
 118 =cut
 119