Merge pull request #2173 from okurz/feature/optimize_mojo_base

Improve include time of Mojo::Base by extracting monkey_patch

lib/Mojo/Base.pm

@@ -7,11 +7,9 @@ use feature ':5.16';
 use mro;
 
 # No imports because we get subclassed, a lot!
-use Carp         ();
-use Scalar::Util ();
-
-# Defer to runtime so Mojo::Util can use "-strict"
-require Mojo::Util;
+use Carp           ();
+use Scalar::Util   ();
+use Mojo::BaseUtil ();
 
 # Role support requires Role::Tiny 2.000001+
 use constant ROLES => !!(eval { require Role::Tiny; Role::Tiny->VERSION('2.000001'); 1 });
@@ -41,7 +39,7 @@ sub attr {
         ref $self->{$_} and Scalar::Util::weaken $self->{$_} for @$names;
         return $self;
       };
-      Mojo::Util::monkey_patch(my $base = $class . '::_Base', 'new', $sub);
+      Mojo::BaseUtil::monkey_patch(my $base = $class . '::_Base', 'new', $sub);
       no strict 'refs';
       unshift @{"${class}::ISA"}, $base;
     }
@@ -90,7 +88,7 @@ sub attr {
     else {
       $sub = sub { return $_[0]{$attr} if @_ == 1; $_[0]{$attr} = $_[1]; $_[0] };
     }
-    Mojo::Util::monkey_patch($class, $attr, $sub);
+    Mojo::BaseUtil::monkey_patch($class, $attr, $sub);
   }
 }
 
@@ -110,7 +108,7 @@ sub import {
     # Role
     elsif ($flag eq '-role') {
       Carp::croak 'Role::Tiny 2.000001+ is required for roles' unless ROLES;
-      Mojo::Util::monkey_patch($caller, 'has', sub { attr($caller, @_) });
+      Mojo::BaseUtil::monkey_patch($caller, 'has', sub { attr($caller, @_) });
       eval "package $caller; use Role::Tiny; 1" or die $@;
     }
 
@@ -131,9 +129,9 @@ sub import {
     # Module
     elsif ($flag !~ /^-/) {
       no strict 'refs';
-      require(Mojo::Util::class_to_path($flag)) unless $flag->can('new');
+      require(Mojo::BaseUtil::class_to_path($flag)) unless $flag->can('new');
       push @{"${caller}::ISA"}, $flag;
-      Mojo::Util::monkey_patch($caller, 'has', sub { attr($caller, @_) });
+      Mojo::BaseUtil::monkey_patch($caller, 'has', sub { attr($caller, @_) });
     }
 
     elsif ($flag ne '-strict') { Carp::croak "Unsupported flag: $flag" }

lib/Mojo/BaseUtil.pm

@@ -0,0 +1,46 @@
+package Mojo::BaseUtil;
+
+# Only using pure Perl as the only purpose of this module is to break a circular dependency involving Mojo::Base
+use strict;
+use warnings;
+use feature ':5.16';
+
+use Exporter  qw(import);
+use Sub::Util qw(set_subname);
+
+our @EXPORT_OK = (qw(class_to_path monkey_patch));
+
+sub class_to_path { join '.', join('/', split(/::|'/, shift)), 'pm' }
+
+sub monkey_patch {
+  my ($class, %patch) = @_;
+  no strict 'refs';
+  no warnings 'redefine';
+  *{"${class}::$_"} = set_subname("${class}::$_", $patch{$_}) for keys %patch;
+}
+
+1;
+
+=encoding utf8
+
+=head1 NAME
+
+Mojo::BaseUtil - Common utility functions used in Mojo::Base, re-exported in Mojo::Util
+
+=head1 SYNOPSIS
+
+  use Mojo::BaseUtil qw(class_to_patch monkey_path);
+
+  my $path = class_to_path 'Foo::Bar';
+  monkey_patch 'MyApp', foo => sub { say 'Foo!' };
+
+=head1 DESCRIPTION
+
+L<Mojo::BaseUtil> provides functions to both L<Mojo::Base> and L<Mojo::Util> so that C<Mojo::Base> does not have to load
+the rest of L<Mojo::Util> while preventing a circular dependency.
+
+=head1 SEE ALSO
+
+L<Mojolicious>, L<Mojolicious::Guides>, L<https://mojolicious.org>.
+
+=cut

lib/Mojo/Util.pm

@@ -14,9 +14,9 @@ use IO::Poll qw(POLLIN POLLPRI);
 use IO::Uncompress::Gunzip;
 use List::Util         qw(min);
 use MIME::Base64       qw(decode_base64 encode_base64);
+use Mojo::BaseUtil     qw(class_to_path monkey_patch);
 use Pod::Usage         qw(pod2usage);
 use Socket             qw(inet_pton AF_INET6 AF_INET);
-use Sub::Util          qw(set_subname);
 use Symbol             qw(delete_package);
 use Time::HiRes        ();
 use Unicode::Normalize ();
@@ -105,8 +105,6 @@ sub class_to_file {
   return decamelize($class);
 }
 
-sub class_to_path { join '.', join('/', split(/::|'/, shift)), 'pm' }
-
 sub decamelize {
   my $str = shift;
   return $str if $str !~ /^[A-Z]/;
@@ -198,13 +196,6 @@ sub humanize_bytes {
   return $prefix . _round($size /= 1024) . 'TiB';
 }
 
-sub monkey_patch {
-  my ($class, %patch) = @_;
-  no strict 'refs';
-  no warnings 'redefine';
-  *{"${class}::$_"} = set_subname("${class}::$_", $patch{$_}) for keys %patch;
-}
-
 sub network_contains {
   my ($cidr, $addr) = @_;
   return undef unless length $cidr && length $addr;

t/mojo/base_util.t

@@ -0,0 +1,48 @@
+use Mojo::Base -strict;
+
+use Test::More;
+use Sub::Util qw(subname);
+
+use Mojo::BaseUtil qw(class_to_path monkey_patch);
+
+subtest 'class_to_path' => sub {
+  is Mojo::BaseUtil::class_to_path('Foo::Bar'),      'Foo/Bar.pm',     'right path';
+  is Mojo::BaseUtil::class_to_path("Foo'Bar"),       'Foo/Bar.pm',     'right path';
+  is Mojo::BaseUtil::class_to_path("Foo'Bar::Baz"),  'Foo/Bar/Baz.pm', 'right path';
+  is Mojo::BaseUtil::class_to_path("Foo::Bar'Baz"),  'Foo/Bar/Baz.pm', 'right path';
+  is Mojo::BaseUtil::class_to_path("Foo::Bar::Baz"), 'Foo/Bar/Baz.pm', 'right path';
+  is Mojo::BaseUtil::class_to_path("Foo'Bar'Baz"),   'Foo/Bar/Baz.pm', 'right path';
+};
+
+subtest 'monkey_patch' => sub {
+  {
+
+    package MojoMonkeyTest;
+    sub foo {'foo'}
+  }
+  ok !!MojoMonkeyTest->can('foo'), 'function "foo" exists';
+  is MojoMonkeyTest::foo(), 'foo', 'right result';
+  ok !MojoMonkeyTest->can('bar'), 'function "bar" does not exist';
+  monkey_patch 'MojoMonkeyTest', bar => sub {'bar'};
+  ok !!MojoMonkeyTest->can('bar'), 'function "bar" exists';
+  is MojoMonkeyTest::bar(), 'bar', 'right result';
+  monkey_patch 'MojoMonkeyTest', foo => sub {'baz'};
+  ok !!MojoMonkeyTest->can('foo'), 'function "foo" exists';
+  is MojoMonkeyTest::foo(), 'baz', 'right result';
+  ok !MojoMonkeyTest->can('yin'),  'function "yin" does not exist';
+  ok !MojoMonkeyTest->can('yang'), 'function "yang" does not exist';
+  monkey_patch 'MojoMonkeyTest',
+    yin  => sub {'yin'},
+    yang => sub {'yang'};
+  ok !!MojoMonkeyTest->can('yin'), 'function "yin" exists';
+  is MojoMonkeyTest::yin(), 'yin', 'right result';
+  ok !!MojoMonkeyTest->can('yang'), 'function "yang" exists';
+  is MojoMonkeyTest::yang(), 'yang', 'right result';
+};
+
+subtest 'monkey_patch (with name)' => sub {
+  is subname(MojoMonkeyTest->can('foo')), 'MojoMonkeyTest::foo', 'right name';
+  is subname(MojoMonkeyTest->can('bar')), 'MojoMonkeyTest::bar', 'right name';
+};
+
+done_testing();

t/pod_coverage.t

@@ -11,4 +11,7 @@ my @await = (
   qw(AWAIT_NEW_FAIL AWAIT_ON_CANCEL AWAIT_ON_READY AWAIT_WAIT)
 );
 
-all_pod_coverage_ok({also_private => ['BUILD_DYNAMIC', @await, 'spurt']});
+# These are base utils only to be used in Mojo::Base and not elsewhere
+my @base_utils = (qw(class_to_path monkey_patch));
+
+all_pod_coverage_ok({also_private => ['BUILD_DYNAMIC', @await, @base_utils, 'spurt']});