Commit | Line | Data |
e185c027 |
1 | |
2 | package Moose::Role; |
3 | |
4 | use strict; |
5 | use warnings; |
6 | |
7 | use Scalar::Util (); |
8 | use Carp 'confess'; |
9 | use Sub::Name 'subname'; |
10 | |
11 | our $VERSION = '0.01'; |
12 | |
13 | use Moose::Meta::Role; |
14 | |
15 | sub import { |
16 | shift; |
17 | my $pkg = caller(); |
18 | |
19 | # we should never export to main |
20 | return if $pkg eq 'main'; |
21 | |
22 | Moose::Util::TypeConstraints->import($pkg); |
23 | |
24 | my $meta; |
25 | if ($pkg->can('meta')) { |
26 | $meta = $pkg->meta(); |
27 | (blessed($meta) && $meta->isa('Moose::Meta::Role')) |
28 | || confess "Whoops, not møøsey enough"; |
29 | } |
30 | else { |
78cd1d3b |
31 | $meta = Moose::Meta::Role->new(role_name => $pkg); |
e185c027 |
32 | $meta->role_meta->add_method('meta' => sub { $meta }) |
33 | } |
34 | |
35 | # NOTE: |
36 | # &alias_method will install the method, but it |
37 | # will not name it with |
38 | |
39 | # handle superclasses |
40 | $meta->role_meta->alias_method('extends' => subname 'Moose::Role::extends' => sub { |
41 | confess "Moose::Role does not currently support 'extends'" |
42 | }); |
43 | |
44 | # handle attributes |
45 | $meta->role_meta->alias_method('has' => subname 'Moose::Role::has' => sub { |
46 | my ($name, %options) = @_; |
47 | $meta->add_attribute($name, %options) |
48 | }); |
49 | |
50 | # handle method modifers |
51 | $meta->role_meta->alias_method('before' => subname 'Moose::Role::before' => sub { |
52 | my $code = pop @_; |
53 | $meta->add_method_modifier('before' => $_, $code) for @_; |
54 | }); |
55 | $meta->role_meta->alias_method('after' => subname 'Moose::Role::after' => sub { |
56 | my $code = pop @_; |
57 | $meta->add_method_modifier('after' => $_, $code) for @_; |
58 | }); |
59 | $meta->role_meta->alias_method('around' => subname 'Moose::Role::around' => sub { |
60 | my $code = pop @_; |
61 | $meta->add_method_modifier('around' => $_, $code) for @_; |
62 | }); |
63 | |
64 | $meta->role_meta->alias_method('super' => subname 'Moose::Role::super' => sub {}); |
65 | $meta->role_meta->alias_method('override' => subname 'Moose::Role::override' => sub { |
66 | my ($name, $code) = @_; |
67 | $meta->add_method_modifier('override' => $name, $code); |
68 | }); |
69 | |
78cd1d3b |
70 | $meta->role_meta->alias_method('inner' => subname 'Moose::Role::inner' => sub { |
71 | confess "Moose::Role does not currently support 'inner'"; |
72 | }); |
e185c027 |
73 | $meta->role_meta->alias_method('augment' => subname 'Moose::Role::augment' => sub { |
78cd1d3b |
74 | confess "Moose::Role does not currently support 'augment'"; |
e185c027 |
75 | }); |
76 | |
77 | # we recommend using these things |
78 | # so export them for them |
79 | $meta->role_meta->alias_method('confess' => \&Carp::confess); |
80 | $meta->role_meta->alias_method('blessed' => \&Scalar::Util::blessed); |
81 | } |
82 | |
83 | 1; |
84 | |
85 | __END__ |
86 | |
87 | =pod |
88 | |
89 | =head1 NAME |
90 | |
91 | Moose::Role - The Moose Role |
92 | |
93 | =head1 DESCRIPTION |
94 | |
95 | =head1 METHODS |
96 | |
97 | =over 4 |
98 | |
99 | =back |
100 | |
101 | =head1 BUGS |
102 | |
103 | All complex software has bugs lurking in it, and this module is no |
104 | exception. If you find a bug please either email me, or add the bug |
105 | to cpan-RT. |
106 | |
107 | =head1 AUTHOR |
108 | |
109 | Stevan Little E<lt>stevan@iinteractive.comE<gt> |
110 | |
111 | =head1 COPYRIGHT AND LICENSE |
112 | |
113 | Copyright 2006 by Infinity Interactive, Inc. |
114 | |
115 | L<http://www.iinteractive.com> |
116 | |
117 | This library is free software; you can redistribute it and/or modify |
118 | it under the same terms as Perl itself. |
119 | |
120 | =cut |