lib/Mouse/Meta/Module.pm

   1 package Mouse::Meta::Module;
   2 use strict;
   3 use warnings;
   4
   5 use Scalar::Util qw/blessed weaken/;
   6 use Mouse::Util qw/version authority identifier get_code_info/;
   7 use Carp 'confess';
   8
   9 sub name { $_[0]->{package} }
  10 sub _method_map{ $_[0]->{methods} }
  11
  12 sub namespace{
  13     my $name = $_[0]->{package};
  14     no strict 'refs';
  15     return \%{ $name . '::' };
  16 }
  17
  18 sub add_method {
  19     my($self, $name, $code) = @_;
  20
  21     if(!defined $name){
  22         confess "You must pass a defined name";
  23     }
  24     if(ref($code) ne 'CODE'){
  25         confess "You must pass a CODE reference";
  26     }
  27
  28     $self->_method_map->{$name}++; # Moose stores meta object here.
  29
  30     my $pkg = $self->name;
  31     no strict 'refs';
  32     no warnings 'redefine';
  33     *{ $pkg . '::' . $name } = $code;
  34 }
  35
  36 sub _code_is_mine { # taken from Class::MOP::Class\r
  37     my ( $self, $code ) = @_;\r
  38 \r
  39     my ( $code_package, $code_name ) = get_code_info($code);\r
  40 \r
  41     return $code_package && $code_package eq $self->name\r
  42         || ( $code_package eq 'constant' && $code_name eq '__ANON__' );\r
  43 }
  44
  45 sub has_method {
  46     my($self, $method_name) = @_;
  47
  48     return 1 if $self->_method_map->{$method_name};
  49     my $code = $self->name->can($method_name);
  50
  51     return $code && $self->_code_is_mine($code);
  52 }
  53
  54
  55
  56 sub get_method_list {\r
  57     my($self) = @_;
  58 \r
  59     return grep { $self->has_method($_) } keys %{ $self->namespace };\r
  60 }
  61
  62 sub get_attribute_map { $_[0]->{attributes} }
  63 sub has_attribute     { exists $_[0]->{attributes}->{$_[1]} }
  64 sub get_attribute     { $_[0]->{attributes}->{$_[1]} }
  65 sub get_attribute_list {
  66     my $self = shift;
  67     keys %{$self->get_attribute_map};
  68 }
  69
  70
  71 1;
  72
  73 __END__
  74
  75 =head1 NAME
  76
  77 Mouse::Meta::Module - Common base class for Mouse::Meta::Class and Mouse::Meta::Role
  78
  79 =cut