lib/Mouse/Meta/Class.pm

   1 #!/usr/bin/env perl
   2 package Mouse::Class;
   3 use strict;
   4 use warnings;
   5
   6 use MRO::Compat;
   7
   8 do {
   9     my %METACLASS_CACHE;
  10     sub initialize {
  11         my $class = shift;
  12         my $name  = shift;
  13         $METACLASS_CACHE{$name} = $class->new(name => $name)
  14             if !exists($METACLASS_CACHE{$name});
  15         return $METACLASS_CACHE{$name};
  16     }
  17 };
  18
  19 sub new {
  20     my $class = shift;
  21     my %args = @_;
  22
  23     $args{attributes} = {};
  24     $args{superclasses} = do {
  25         no strict 'refs';
  26         \@{ $args{name} . '::ISA' };
  27     };
  28
  29     bless \%args, $class;
  30 }
  31
  32 sub name { $_[0]->{name} }
  33
  34 sub superclasses {
  35     my $self = shift;
  36
  37     if (@_) {
  38         Mouse::load_class($_) for @_;
  39         @{ $self->{superclasses} } = @_;
  40     }
  41
  42     @{ $self->{superclasses} };
  43 }
  44
  45 sub add_attribute {
  46     my $self = shift;
  47     my $attr = shift;
  48
  49     $self->{'attributes'}{$attr->name} = $attr;
  50 }
  51
  52 sub get_attribute_map { $_[0]->{attributes} }
  53 sub get_attribute     { $_[0]->{attributes}->{$_[1]} }
  54
  55 sub linearized_isa { @{ mro::get_linear_isa($_[0]->name) } }
  56
  57 1;
  58
  59 __END__
  60
  61 =head1 NAME
  62
  63 Mouse::Class - hook into the Mouse MOP
  64
  65 =head1 METHODS
  66
  67 =head2 initialize ClassName -> Mouse::Class
  68
  69 Finds or creates a Mouse::Class instance for the given ClassName. Only one
  70 instance should exist for a given class.
  71
  72 =head2 new %args -> Mouse::Class
  73
  74 Creates a new Mouse::Class. Don't call this directly.
  75
  76 =head2 name -> ClassName
  77
  78 Returns the name of the owner class.
  79
  80 =head2 superclasses -> [ClassName]
  81
  82 Gets (or sets) the list of superclasses of the owner class.
  83
  84 =head2 add_attribute Mouse::Attribute
  85
  86 Begins keeping track of the existing L<Mouse::Attribute> for the owner class.
  87
  88 =head2 get_attribute_map -> { name => Mouse::Attribute }
  89
  90 Returns a mapping of attribute names to their corresponding
  91 L<Mouse::Attribute> objects.
  92
  93 =head2 get_attribute Name -> Mouse::Attribute | undef
  94
  95 Returns the L<Mouse::Attribute> with the given name.
  96
  97 =head2 linearized_isa -> [ClassNames]
  98
  99 Returns the list of classes in method dispatch order, with duplicates removed.
 100
 101 =cut
 102