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