Skip to content

Commit

Permalink
Improve include time of Mojo::Base by extracting monkey_patch
Browse files Browse the repository at this point in the history
Commit 7e9a2ad introduced a "require Mojo::Util" causing a significant
chain of further dependencies being pulled in which IMHO should be
avoided for the very base module which is in particular being advertised
as useful for just enabling strictures and common import checks.

This commit moves out the function "monkey_patch" into its own module to
break or prevent the circular dependency between Mojo::Base and
Mojo::Util.

With that the import of Mojo::Base is more efficient,
`time perl -e 'use Mojo::Base`
on my system reduced from 224±12.08 ms to 52.0±2.3 ms which I consider a
considerable improvement for Mojo::Base which is used as a baseclass in
many cases.

Further minor changes included:
* Directly require MonkeyPatch for cleaner subclassing + POD
* Correct use of MonkeyPatch with empty import
* Combine monkey_patch and class_to_path in new Mojo::BaseUtil
  • Loading branch information
okurz committed May 10, 2024
1 parent aa96f58 commit 9299d31
Show file tree
Hide file tree
Showing 5 changed files with 107 additions and 21 deletions.
18 changes: 8 additions & 10 deletions lib/Mojo/Base.pm
Original file line number Diff line number Diff line change
Expand Up @@ -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 });
Expand Down Expand Up @@ -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;
}
Expand Down Expand Up @@ -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);
}
}

Expand All @@ -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 $@;
}

Expand All @@ -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" }
Expand Down
46 changes: 46 additions & 0 deletions lib/Mojo/BaseUtil.pm
Original file line number Diff line number Diff line change
@@ -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 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 a C<class_to_path> and the C<monkey_patch> function for L<Mojo>. The main purpose is to
provide functions to both C<Mojo::Base> and C<Mojo::Util> so that C<Mojo::Base> does not have to load the rest of
C<Mojo::Util>.
=head1 SEE ALSO
L<Mojolicious>, L<Mojolicious::Guides>, L<https://mojolicious.org>.
=cut
11 changes: 1 addition & 10 deletions lib/Mojo/Util.pm
Original file line number Diff line number Diff line change
Expand Up @@ -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 ();
Expand Down Expand Up @@ -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]/;
Expand Down Expand Up @@ -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;
Expand Down
48 changes: 48 additions & 0 deletions t/mojo/base_util.t
Original file line number Diff line number Diff line change
@@ -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();
5 changes: 4 additions & 1 deletion t/pod_coverage.t
Original file line number Diff line number Diff line change
Expand Up @@ -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']});

0 comments on commit 9299d31

Please sign in to comment.