add -role flag to Mojo::Base

mojolicious · Nov 6, 2017 · 2a8202f · 2a8202f
1 parent 23e65df
commit 2a8202f
Show file tree

Hide file tree

Showing 2 changed files with 18 additions and 8 deletions.
diff --git a/lib/Mojo/Base.pm b/lib/Mojo/Base.pm
@@ -69,24 +69,31 @@ sub attr {
 sub import {
   my $class = shift;
   return unless my @flags = @_;
+  my $caller = caller;
 
   # Base
   if ($flags[0] eq '-base') { $flags[0] = $class }
 
   # Strict
   elsif ($flags[0] eq '-strict') { $flags[0] = undef }
 
+  # Role
+  elsif ($flags[0] eq '-role') {
+    Carp::croak 'Role::Tiny 2.000001+ is required for roles' unless ROLES;
+    eval "package $caller; use Role::Tiny";
+    die $@ if $@;
+  }
+
   # Module
   elsif ((my $file = $flags[0]) && !$flags[0]->can('new')) {
     $file =~ s!::|'!/!g;
     require "$file.pm";
   }
 
-  # ISA
+  # has and possibly ISA
   if ($flags[0]) {
-    my $caller = caller;
     no strict 'refs';
-    push @{"${caller}::ISA"}, $flags[0];
+    push @{"${caller}::ISA"}, $flags[0] unless $flags[0] eq '-role';
     _monkey_patch $caller, 'has', sub { attr($caller, @_) };
   }
 
@@ -98,8 +105,7 @@ sub import {
   if (($flags[1] || '') eq '-signatures') {
     Carp::croak 'Subroutine signatures require Perl 5.20+' if $] < 5.020;
     require experimental;
-    @_ = ('warnings', 'signatures');
-    goto &experimental::import;
+    experimental->import('signatures');
   }
 }
 

diff --git a/t/mojo/roles.t b/t/mojo/roles.t
@@ -20,13 +20,15 @@ sub hello {
 }
 
 package Mojo::RoleTest::Role::quiet;
-use Role::Tiny;
+use Mojo::Base -role;
 
 requires 'name';
 
+has prefix => 'psst, ';
+
 sub whisper {
   my $self = shift;
-  return 'psst, ' . lc($self->name);
+  return $self->prefix . lc($self->name);
 }
 
 package Mojo::RoleTest;
@@ -40,7 +42,7 @@ sub hello {
 }
 
 package Mojo::RoleTest::Hello;
-use Role::Tiny;
+use Mojo::Base -role;
 
 sub hello {'hello mojo!'}
 
@@ -71,6 +73,8 @@ my $obj3 = Mojo::RoleTest->with_roles('Mojo::RoleTest::Role::quiet',
   'Mojo::RoleTest::Role::LOUD')->new(name => 'Joel');
 is $obj3->name,    'Joel',         'base attribute';
 is $obj3->whisper, 'psst, joel',   'method from first role';
+$obj3->prefix('psssst, ');
+is $obj3->whisper, 'psssst, joel',   'method from first role';
 is $obj3->hello,   'HEY! JOEL!!!', 'method from second role';
 
 # Multiple roles (shorthand)