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 DESCRIPTION
  94
  95 =head1 METHODS
  96
  97 =over 4
  98
  99 =back
 100
 101 =head1 BUGS
 102
 103 All complex software has bugs lurking in it, and this module is no
 104 exception. If you find a bug please either email me, or add the bug
 105 to cpan-RT.
 106
 107 =head1 AUTHOR
 108
 109 Stevan Little E<lt>stevan@iinteractive.comE<gt>
 110
 111 =head1 COPYRIGHT AND LICENSE
 112
 113 Copyright 2006 by Infinity Interactive, Inc.
 114
 115 L<http://www.iinteractive.com>
 116
 117 This library is free software; you can redistribute it and/or modify
 118 it under the same terms as Perl itself.
 119
 120 =cut