add -role flag to Mojo::Base

mojolicious · Nov 6, 2017 · 82818ff · aferreira · Nov 6, 2017 · Grinnz
1 parent f136ae0
commit 82818ff
Show file tree

Hide file tree

Showing 3 changed files with 31 additions and 10 deletions.
diff --git a/lib/Mojo/Base.pm b/lib/Mojo/Base.pm
@@ -62,24 +62,30 @@ 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; 1" or die $@;
+  }
+
   # 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';
     Mojo::Util::monkey_patch($caller, 'has', sub { attr($caller, @_) });
   }
 
@@ -159,8 +165,9 @@ interfaces.
   use Mojo::Base -strict;
   use Mojo::Base -base;
   use Mojo::Base 'SomeBaseClass';
+  use Mojo::Base -role;
 
-All three forms save a lot of typing.
+All four forms save a lot of typing.
 
   # use Mojo::Base -strict;
   use strict;
@@ -188,13 +195,23 @@ All three forms save a lot of typing.
   push @ISA, 'SomeBaseClass';
   sub has { Mojo::Base::attr(__PACKAGE__, @_) }
 
+  # use Mojo::Base -role;
+  use strict;
+  use warnings;
+  use utf8;
+  use feature ':5.10';
+  use IO::Handle ();
+  use Role::Tiny;
+  sub has { Mojo::Base::attr(__PACKAGE__, @_) }
+
 On Perl 5.20+ you can also append a C<-signatures> flag to all three forms and
 enable support for L<subroutine signatures|perlsub/"Signatures">.
 
   # Also enable signatures
   use Mojo::Base -strict, -signatures;
   use Mojo::Base -base, -signatures;
   use Mojo::Base 'SomeBaseClass', -signatures;
+  use Mojo::Base -role, -signatures;
 
 This will also disable experimental warnings on versions of Perl where this
 feature was still experimental.

diff --git a/lib/Mojolicious/Guides/Testing.pod b/lib/Mojolicious/Guides/Testing.pod
@@ -664,8 +664,8 @@ the C<Location> header after a redirect. We'll create a new class with
 L<Role::Tiny> that implements a test assertion named C<location_is>:
 
   package Test::Mojo::Role::Location;
+  use Mojo::Base -role;
 
-  use Role::Tiny;
   use Test::More;
 
   sub location_is {

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!'}
 
@@ -69,8 +71,10 @@ is $obj4->yell,  'HEY!',        'another role method';
 # Multiple roles
 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';
+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)