X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FMouse%2FRole.pm;h=e905004c34f136d2cf4aff713c1e46b5de3846dc;hb=815f725aeff0bd44da8d75e7cd4ac456e9e60238;hp=057761a638abf076ad307bae3089d7ea1c34d91d;hpb=59089ec36675c7df1998945b1446c37794f88306;p=gitmo%2FMouse.git diff --git a/lib/Mouse/Role.pm b/lib/Mouse/Role.pm index 057761a..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,7 +48,15 @@ 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 { my $meta = Mouse::Meta::Role->initialize(caller); @@ -60,10 +67,19 @@ sub requires { 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';