From 760a311c3da30fc1394c186b55ac01220171c18a Mon Sep 17 00:00:00 2001 From: Oliver Kurz Date: Fri, 5 Apr 2024 14:16:09 +0200 Subject: [PATCH] Improve include time of Mojo::Base by extracting monkey_patch MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit 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 --- lib/Mojo/Base.pm | 18 ++++++++--------- lib/Mojo/BaseUtil.pm | 45 +++++++++++++++++++++++++++++++++++++++++ lib/Mojo/Util.pm | 11 +--------- t/mojo/base_util.t | 48 ++++++++++++++++++++++++++++++++++++++++++++ t/pod_coverage.t | 5 ++++- 5 files changed, 106 insertions(+), 21 deletions(-) create mode 100644 lib/Mojo/BaseUtil.pm create mode 100644 t/mojo/base_util.t diff --git a/lib/Mojo/Base.pm b/lib/Mojo/Base.pm index 1801bc9158..70404329a4 100644 --- a/lib/Mojo/Base.pm +++ b/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" } diff --git a/lib/Mojo/BaseUtil.pm b/lib/Mojo/BaseUtil.pm new file mode 100644 index 0000000000..9330fcef08 --- /dev/null +++ b/lib/Mojo/BaseUtil.pm @@ -0,0 +1,45 @@ +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 provides functions to both C and C so that C does not have to load +the rest of C while preventing a circular dependency. + +=head1 SEE ALSO + +L, L, L. + +=cut diff --git a/lib/Mojo/Util.pm b/lib/Mojo/Util.pm index ee941fa8e7..069cf9cf9c 100644 --- a/lib/Mojo/Util.pm +++ b/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; diff --git a/t/mojo/base_util.t b/t/mojo/base_util.t new file mode 100644 index 0000000000..1daa0e4795 --- /dev/null +++ b/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(); diff --git a/t/pod_coverage.t b/t/pod_coverage.t index d8a81ebd38..05a65b60d3 100644 --- a/t/pod_coverage.t +++ b/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']});