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         my $meta;
  23         if ($pkg->can('meta')) {
  24                 $meta = $pkg->meta();
  25                 (blessed($meta) && $meta->isa('Moose::Meta::Role'))
  26                         || confess "Whoops, not møøsey enough";
  27         }
  28         else {
  29                 $meta = Moose::Meta::Role->new(role_name => $pkg);
  30                 $meta->_role_meta->add_method('meta' => sub { $meta })
  31         }
  32
  33         # NOTE:
  34         # &alias_method will install the method, but it
  35         # will not name it with
  36
  37         # handle superclasses
  38         $meta->alias_method('extends' => subname 'Moose::Role::extends' => sub {
  39         confess "Moose::Role does not currently support 'extends'"
  40         });
  41
  42         # handle roles
  43         $meta->alias_method('with' => subname 'Moose::with' => sub {
  44             my ($role) = @_;
  45         Moose::_load_all_classes($role);
  46         $role->meta->apply($meta);
  47         });
  48
  49         # required methods
  50         $meta->alias_method('requires' => subname 'Moose::requires' => sub {
  51         $meta->add_required_methods(@_);
  52         });
  53
  54         # handle attributes
  55         $meta->alias_method('has' => subname 'Moose::Role::has' => sub {
  56                 my ($name, %options) = @_;
  57                 $meta->add_attribute($name, %options)
  58         });
  59
  60         # handle method modifers
  61         $meta->alias_method('before' => subname 'Moose::Role::before' => sub {
  62                 my $code = pop @_;
  63                 $meta->add_before_method_modifier($_, $code) for @_;
  64         });
  65         $meta->alias_method('after'  => subname 'Moose::Role::after' => sub {
  66                 my $code = pop @_;
  67                 $meta->add_after_method_modifier($_, $code) for @_;
  68         });
  69         $meta->alias_method('around' => subname 'Moose::Role::around' => sub {
  70                 my $code = pop @_;
  71                 $meta->add_around_method_modifier($_, $code) for @_;
  72         });
  73
  74         $meta->alias_method('super' => subname 'Moose::Role::super' => sub {});
  75         $meta->alias_method('override' => subname 'Moose::Role::override' => sub {
  76         my ($name, $code) = @_;
  77                 $meta->add_override_method_modifier($name, $code);
  78         });
  79
  80         $meta->alias_method('inner' => subname 'Moose::Role::inner' => sub {
  81         confess "Moose::Role does not currently support 'inner'";
  82         });
  83         $meta->alias_method('augment' => subname 'Moose::Role::augment' => sub {
  84         confess "Moose::Role does not currently support 'augment'";
  85         });
  86
  87         # we recommend using these things
  88         # so export them for them
  89         $meta->alias_method('confess' => \&Carp::confess);
  90         $meta->alias_method('blessed' => \&Scalar::Util::blessed);
  91 }
  92
  93 1;
  94
  95 __END__
  96
  97 =pod
  98
  99 =head1 NAME
 100
 101 Moose::Role - The Moose Role
 102
 103 =head1 SYNOPSIS
 104
 105   package Eq;
 106   use strict;
 107   use warnings;
 108   use Moose::Role;
 109
 110   requires 'equal';
 111
 112   sub no_equal {
 113       my ($self, $other) = @_;
 114       !$self->equal($other);
 115   }
 116
 117   # ... then in your classes
 118
 119   package Currency;
 120   use strict;
 121   use warnings;
 122   use Moose;
 123
 124   with 'Eq';
 125
 126   sub equal {
 127       my ($self, $other) = @_;
 128       $self->as_float == $other->as_float;
 129   }
 130
 131 =head1 DESCRIPTION
 132
 133 This is currently a very early release of Perl 6 style Roles for
 134 Moose, it is still incomplete, but getting much closer. If you are
 135 interested in helping move this feature along, please come to
 136 #moose on irc.perl.org and we can talk.
 137
 138 =head1 CAVEATS
 139
 140 Currently, the role support has a few of caveats. They are as follows:
 141
 142 =over 4
 143
 144 =item *
 145
 146 At this time classes I<cannot> correctly consume more than one role. The
 147 role composition process, and it's conflict detection has not been added
 148 yet. While this should be considered a major feature, it can easily be
 149 worked around, and in many cases, is not needed at all.
 150
 151 A class can actually consume multiple roles, they are just applied one
 152 after another in the order you ask for them. This is incorrect behavior,
 153 the roles should be merged first, and conflicts determined, etc. However,
 154 if your roles do not have any conflicts, then things will work just
 155 fine. This actually tends to be quite sufficient for basic roles.
 156
 157 =item *
 158
 159 Roles cannot use the C<extends> keyword, it will throw an exception for now.
 160 The same is true of the C<augment> and C<inner> keywords (not sure those
 161 really make sense for roles). All other Moose keywords will be I<deferred>
 162 so that they can be applied to the consuming class.
 163
 164 =back
 165
 166 =head1 BUGS
 167
 168 All complex software has bugs lurking in it, and this module is no
 169 exception. If you find a bug please either email me, or add the bug
 170 to cpan-RT.
 171
 172 =head1 AUTHOR
 173
 174 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 175
 176 =head1 COPYRIGHT AND LICENSE
 177
 178 Copyright 2006 by Infinity Interactive, Inc.
 179
 180 L<http://www.iinteractive.com>
 181
 182 This library is free software; you can redistribute it and/or modify
 183 it under the same terms as Perl itself.
 184
 185 =cut