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