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