lib/Mouse/Role.pm

   1 #!/usr/bin/env perl
   2 package Mouse::Role;
   3 use strict;
   4 use warnings;
   5
   6 use Sub::Exporter;
   7 use Carp 'confess';
   8 use Scalar::Util;
   9
  10 use Mouse::Meta::Role;
  11
  12 do {
  13     my $CALLER;
  14
  15     my %exports = (
  16         meta => sub {
  17             my $meta = Mouse::Meta::Role->initialize($CALLER);
  18             return sub { $meta };
  19         },
  20         extends => sub {
  21             return sub {
  22                 confess "Role does not currently support 'extends'";
  23             }
  24         },
  25         before => sub {
  26             return sub { }
  27         },
  28         after => sub {
  29             return sub { }
  30         },
  31         around => sub {
  32             return sub { }
  33         },
  34         has => sub {
  35             my $caller = $CALLER;
  36             return sub {
  37                 my $name = shift;
  38                 my %opts = @_;
  39
  40                 $caller->meta->add_attribute($name => \%opts);
  41             }
  42         },
  43         with => sub {
  44             return sub {
  45                 confess "Role does not currently support 'with'";
  46             }
  47         },
  48         requires => sub {
  49             return sub { }
  50         },
  51         excludes => sub {
  52             return sub { }
  53         },
  54         blessed => sub {
  55             return \&Scalar::Util::blessed;
  56         },
  57         confess => sub {
  58             return \&Carp::confess;
  59         },
  60     );
  61
  62     my $exporter = Sub::Exporter::build_exporter({
  63         exports => \%exports,
  64         groups  => { default => [':all'] },
  65     });
  66
  67     sub import {
  68         $CALLER = caller;
  69
  70         strict->import;
  71         warnings->import;
  72
  73         goto $exporter;
  74     }
  75
  76     sub unimport {
  77         my $caller = caller;
  78
  79         no strict 'refs';
  80         for my $keyword (keys %exports) {
  81             next if $keyword eq 'meta'; # we don't delete this one
  82             delete ${ $caller . '::' }{$keyword};
  83         }
  84     }
  85 };
  86
  87 1;
  88
  89 __END__
  90
  91 =head1 NAME
  92
  93 Mouse::Role
  94
  95 =head1 KEYWORDS
  96
  97 =head2 meta -> Mouse::Meta::Role
  98
  99 Returns this role's metaclass instance.
 100
 101 =head2 before (method|methods) => Code
 102
 103 Sets up a "before" method modifier. See L<Moose/before> or
 104 L<Class::Method::Modifiers/before>.
 105
 106 =head2 after (method|methods) => Code
 107
 108 Sets up an "after" method modifier. See L<Moose/after> or
 109 L<Class::Method::Modifiers/after>.
 110
 111 =head2 around (method|methods) => Code
 112
 113 Sets up an "around" method modifier. See L<Moose/around> or
 114 L<Class::Method::Modifiers/around>.
 115
 116 =head2 has (name|names) => parameters
 117
 118 Sets up an attribute (or if passed an arrayref of names, multiple attributes) to
 119 this role. See L<Mouse/has>.
 120
 121 =head2 confess error -> BOOM
 122
 123 L<Carp/confess> for your convenience.
 124
 125 =head2 blessed value -> ClassName | undef
 126
 127 L<Scalar::Util/blessed> for your convenience.
 128
 129 =head1 MISC
 130
 131 =head2 import
 132
 133 Importing Mouse::Role will give you sugar.
 134
 135 =head2 unimport
 136
 137 Please unimport Mouse (C<no Mouse::Role>) so that if someone calls one of the
 138 keywords (such as L</has>) it will break loudly instead breaking subtly.
 139
 140 =cut
 141