lib/Moose/Role.pm

   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.02';
  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 {
  31                 $meta = Moose::Meta::Role->new(role_name => $pkg);
  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->alias_method('extends' => subname 'Moose::Role::extends' => sub {
  41         confess "Moose::Role does not currently support 'extends'"
  42         });
  43
  44         # handle roles
  45         $meta->alias_method('with' => subname 'Moose::with' => sub {
  46             my ($role) = @_;
  47         Moose::_load_all_classes($role);
  48         $role->meta->apply($meta);
  49         });
  50
  51         # handle attributes
  52         $meta->alias_method('has' => subname 'Moose::Role::has' => sub {
  53                 my ($name, %options) = @_;
  54                 $meta->add_attribute($name, %options)
  55         });
  56
  57         # handle method modifers
  58         $meta->alias_method('before' => subname 'Moose::Role::before' => sub {
  59                 my $code = pop @_;
  60                 $meta->add_before_method_modifier($_, $code) for @_;
  61         });
  62         $meta->alias_method('after'  => subname 'Moose::Role::after' => sub {
  63                 my $code = pop @_;
  64                 $meta->add_after_method_modifier($_, $code) for @_;
  65         });
  66         $meta->alias_method('around' => subname 'Moose::Role::around' => sub {
  67                 my $code = pop @_;
  68                 $meta->add_around_method_modifier($_, $code) for @_;
  69         });
  70
  71         $meta->alias_method('super' => subname 'Moose::Role::super' => sub {});
  72         $meta->alias_method('override' => subname 'Moose::Role::override' => sub {
  73         my ($name, $code) = @_;
  74                 $meta->add_override_method_modifier($name, $code);
  75         });
  76
  77         $meta->alias_method('inner' => subname 'Moose::Role::inner' => sub {
  78         confess "Moose::Role does not currently support 'inner'";
  79         });
  80         $meta->alias_method('augment' => subname 'Moose::Role::augment' => sub {
  81         confess "Moose::Role does not currently support 'augment'";
  82         });
  83
  84         # we recommend using these things
  85         # so export them for them
  86         $meta->alias_method('confess' => \&Carp::confess);
  87         $meta->alias_method('blessed' => \&Scalar::Util::blessed);
  88 }
  89
  90 1;
  91
  92 __END__
  93
  94 =pod
  95
  96 =head1 NAME
  97
  98 Moose::Role - The Moose Role
  99
 100 =head1 SYNOPSIS
 101
 102   package Eq;
 103   use strict;
 104   use warnings;
 105   use Moose::Role;
 106
 107   sub equal { confess "equal must be implemented" }
 108
 109   sub no_equal {
 110       my ($self, $other) = @_;
 111       !$self->equal($other);
 112   }
 113
 114   # ... then in your classes
 115
 116   package Currency;
 117   use strict;
 118   use warnings;
 119   use Moose;
 120
 121   with 'Eq';
 122
 123   sub equal {
 124       my ($self, $other) = @_;
 125       $self->as_float == $other->as_float;
 126   }
 127
 128 =head1 DESCRIPTION
 129
 130 This is currently a very early release of Perl 6 style Roles for
 131 Moose, it should be considered experimental and incomplete.
 132
 133 This feature is being actively developed, but $work is currently
 134 preventing me from paying as much attention to it as I would like.
 135 So I am releasing it in hopes people will help me on this I<hint hint>.
 136
 137 If you are interested in helping, please come to #moose on irc.perl.org
 138 and we can talk.
 139
 140 =head1 CAVEATS
 141
 142 Currently, the role support has a number of caveats. They are as follows:
 143
 144 =over 4
 145
 146 =item *
 147
 148 There is no support for Roles consuming other Roles. The details of this
 149 are not totally worked out yet, but it will mostly follow what is set out
 150 in the Perl 6 Synopsis 12.
 151
 152 =item *
 153
 154 At this time classes I<can> consume more than one Role, but they are simply
 155 applied one after another in the order you ask for them. This is incorrect
 156 behavior, the roles should be merged first, and conflicts determined, etc.
 157 However, if your roles do not have any conflicts, then things will work just
 158 fine.
 159
 160 =item *
 161
 162 I want to have B<required> methods, which is unlike Perl 6 roles, and more
 163 like the original Traits on which roles are based. This would be similar
 164 in behavior to L<Class::Trait>. These are not yet implemented or course.
 165
 166 =item *
 167
 168 Roles cannot use the C<extends> keyword, it will throw an exception for now.
 169 The same is true of the C<augment> and C<inner> keywords (not sure those
 170 really make sense for roles). All other Moose keywords will be I<deferred>
 171 so that they can be applied to the consuming class.
 172
 173 =back
 174
 175 Basically thats all I can think of for now, I am sure there are more though.
 176
 177 =head1 BUGS
 178
 179 All complex software has bugs lurking in it, and this module is no
 180 exception. If you find a bug please either email me, or add the bug
 181 to cpan-RT.
 182
 183 =head1 AUTHOR
 184
 185 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 186
 187 =head1 COPYRIGHT AND LICENSE
 188
 189 Copyright 2006 by Infinity Interactive, Inc.
 190
 191 L<http://www.iinteractive.com>
 192
 193 This library is free software; you can redistribute it and/or modify
 194 it under the same terms as Perl itself.
 195
 196 =cut