X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FRole.pm;h=e905004c34f136d2cf4aff713c1e46b5de3846dc;hb=f91c9c099c234823ea992198c845e5bb066fdc7a;hp=2f44a75447a131eed3db17d88a8022ce280590f6;hpb=8fcbe7fb24ac710b860595ae1ecea066c3add1f5;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Role.pm b/lib/Mouse/Role.pm index 2f44a75..e905004 100644 --- a/lib/Mouse/Role.pm +++ b/lib/Mouse/Role.pm @@ -1,11 +1,10 @@ -#!/usr/bin/env perl package Mouse::Role; use strict; use warnings; use base 'Exporter'; use Carp 'confess'; -use Mouse::Util 'blessed'; +use Scalar::Util 'blessed'; use Mouse::Meta::Role; @@ -49,17 +48,38 @@ sub has { sub extends { confess "Roles do not support 'extends'" } -sub with { confess "Mouse::Role does not currently support 'with'" } +sub with { + my $meta = Mouse::Meta::Role->initialize(caller); + my $role = shift; + my $args = shift || {}; + confess "Mouse::Role only supports 'with' on individual roles at a time" if @_ || !ref $args; + + Mouse::load_class($role); + $role->meta->apply($meta, %$args); +} -sub requires { confess "Mouse::Role does not currently support 'requires'" } +sub requires { + my $meta = Mouse::Meta::Role->initialize(caller); + Carp::croak "Must specify at least one method" unless @_; + $meta->add_required_methods(@_); +} sub excludes { confess "Mouse::Role does not currently support 'excludes'" } sub import { + my $class = shift; + strict->import; warnings->import; my $caller = caller; + + # we should never export to main + if ($caller eq 'main') { + warn qq{$class does not export its sugar to the 'main' package.\n}; + return; + } + my $meta = Mouse::Meta::Role->initialize(caller); no strict 'refs';