lib/Mouse/Meta/Role.pm

   1 #!/usr/bin/env perl
   2 package Mouse::Meta::Role;
   3 use strict;
   4 use warnings;
   5
   6 do {
   7     my %METACLASS_CACHE;
   8
   9     # because Mouse doesn't introspect existing classes, we're forced to
  10     # only pay attention to other Mouse classes
  11     sub _metaclass_cache {
  12         my $class = shift;
  13         my $name  = shift;
  14         return $METACLASS_CACHE{$name};
  15     }
  16
  17     sub initialize {
  18         my $class = shift;
  19         my $name  = shift;
  20         $METACLASS_CACHE{$name} = $class->new(name => $name)
  21             if !exists($METACLASS_CACHE{$name});
  22         return $METACLASS_CACHE{$name};
  23     }
  24 };
  25
  26 sub new {
  27     my $class = shift;
  28     my %args  = @_;
  29
  30     bless \%args, $class;
  31 }
  32
  33 sub name { $_[0]->{name} }
  34
  35 sub has_attribute { exists $_[0]->{attributes}->{$_[1]}  }
  36 sub add_attribute { $_[0]->{attributes}->{$_[1]} = $_[2] }
  37
  38 1;
  39