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.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 {
  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->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
  70         $meta->role_meta->alias_method('inner' => subname 'Moose::Role::inner' => sub {
  71         confess "Moose::Role does not currently support 'inner'";
  72         });
  73         $meta->role_meta->alias_method('augment' => subname 'Moose::Role::augment' => sub {
  74         confess "Moose::Role does not currently support 'augment'";
  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 SYNOPSIS
  94
  95   package Eq;
  96   use strict;
  97   use warnings;
  98   use Moose::Role;
  99
 100   sub equal { confess "equal must be implemented" }
 101
 102   sub no_equal {
 103       my ($self, $other) = @_;
 104       !$self->equal($other);
 105   }
 106
 107   # ... then in your classes
 108
 109   package Currency;
 110   use strict;
 111   use warnings;
 112   use Moose;
 113
 114   with 'Eq';
 115
 116   sub equal {
 117       my ($self, $other) = @_;
 118       $other->as_float == $other->as_float;
 119   }
 120
 121 =head1 DESCRIPTION
 122
 123 This is currently a very early release of Perl 6 style Roles for
 124 Moose, it should be considered experimental and incomplete.
 125
 126 This feature is being actively developed, but $work is currently
 127 preventing me from paying as much attention to it as I would like.
 128 So I am releasing it in hopes people will help me on this I<hint hint>.
 129
 130 If you are interested in helping, please come to #moose on irc.perl.org
 131 and we can talk.
 132
 133 =head1 CAVEATS
 134
 135 Currently, the role support has a number of caveats. They are as follows:
 136
 137 =over 4
 138
 139 =item *
 140
 141 There is no support for Roles consuming other Roles. The details of this
 142 are not totally worked out yet, but it will mostly follow what is set out
 143 in the Perl 6 Synopsis 12.
 144
 145 =item *
 146
 147 At this time classes I<can> consume more than one Role, but they are simply
 148 applied one after another in the order you ask for them. This is incorrect
 149 behavior, the roles should be merged first, and conflicts determined, etc.
 150 However, if your roles do not have any conflicts, then things will work just
 151 fine.
 152
 153 =item *
 154
 155 I want to have B<required> methods, which is unlike Perl 6 roles, and more
 156 like the original Traits on which roles are based. This would be similar
 157 in behavior to L<Class::Trait>. These are not yet implemented or course.
 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