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