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(
  32                     role_name => $pkg
  33                 );
  34                 $meta->role_meta->add_method('meta' => sub { $meta })
  35         }
  36
  37         # NOTE:
  38         # &alias_method will install the method, but it
  39         # will not name it with
  40
  41         # handle superclasses
  42         $meta->role_meta->alias_method('extends' => subname 'Moose::Role::extends' => sub {
  43         confess "Moose::Role does not currently support 'extends'"
  44         });
  45
  46         # handle attributes
  47         $meta->role_meta->alias_method('has' => subname 'Moose::Role::has' => sub {
  48                 my ($name, %options) = @_;
  49                 $meta->add_attribute($name, %options)
  50         });
  51
  52         # handle method modifers
  53         $meta->role_meta->alias_method('before' => subname 'Moose::Role::before' => sub {
  54                 my $code = pop @_;
  55                 $meta->add_method_modifier('before' => $_, $code) for @_;
  56         });
  57         $meta->role_meta->alias_method('after'  => subname 'Moose::Role::after' => sub {
  58                 my $code = pop @_;
  59                 $meta->add_method_modifier('after' => $_, $code) for @_;
  60         });
  61         $meta->role_meta->alias_method('around' => subname 'Moose::Role::around' => sub {
  62                 my $code = pop @_;
  63                 $meta->add_method_modifier('around' => $_, $code) for @_;
  64         });
  65
  66         $meta->role_meta->alias_method('super' => subname 'Moose::Role::super' => sub {});
  67         $meta->role_meta->alias_method('override' => subname 'Moose::Role::override' => sub {
  68         my ($name, $code) = @_;
  69                 $meta->add_method_modifier('override' => $name, $code);
  70         });
  71
  72         $meta->role_meta->alias_method('inner' => subname 'Moose::Role::inner' => sub {});
  73         $meta->role_meta->alias_method('augment' => subname 'Moose::Role::augment' => sub {
  74         my ($name, $code) = @_;
  75                 $meta->add_method_modifier('augment' => $name, $code);
  76         });
  77
  78         # we recommend using these things
  79         # so export them for them
  80         $meta->role_meta->alias_method('confess' => \&Carp::confess);
  81         $meta->role_meta->alias_method('blessed' => \&Scalar::Util::blessed);
  82 }
  83
  84 1;
  85
  86 __END__
  87
  88 =pod
  89
  90 =head1 NAME
  91
  92 Moose::Role - The Moose Role
  93
  94 =head1 DESCRIPTION
  95
  96 =head1 METHODS
  97
  98 =over 4
  99
 100 =back
 101
 102 =head1 BUGS
 103
 104 All complex software has bugs lurking in it, and this module is no
 105 exception. If you find a bug please either email me, or add the bug
 106 to cpan-RT.
 107
 108 =head1 AUTHOR
 109
 110 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 111
 112 =head1 COPYRIGHT AND LICENSE
 113
 114 Copyright 2006 by Infinity Interactive, Inc.
 115
 116 L<http://www.iinteractive.com>
 117
 118 This library is free software; you can redistribute it and/or modify
 119 it under the same terms as Perl itself.
 120
 121 =cut