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..7d8ce9973f --- /dev/null +++ b/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 provides functions to both L and L so that C does not have to load +the rest of L 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']});