From b7002c70cbb8140580d388e2917ac501e3a83edb Mon Sep 17 00:00:00 2001 From: Oliver Kurz Date: Fri, 5 Apr 2024 22:28:38 +0200 Subject: [PATCH] Combine monkey_patch and class_to_path in new Mojo::BaseUtil --- lib/Mojo/Base.pm | 18 ++--- lib/Mojo/BaseUtil.pm | 77 +++++++++++++++++++ lib/Mojo/Home.pm | 4 +- lib/Mojo/Loader.pm | 4 +- lib/Mojo/MonkeyPatch.pm | 56 -------------- lib/Mojo/Util.pm | 4 +- .../Command/Author/generate/app.pm | 6 +- .../Command/Author/generate/plugin.pm | 4 +- t/mojo/base.t | 9 --- t/mojo/{monkey_patch.t => base_util.t} | 13 +++- 10 files changed, 108 insertions(+), 87 deletions(-) create mode 100644 lib/Mojo/BaseUtil.pm delete mode 100644 lib/Mojo/MonkeyPatch.pm rename t/mojo/{monkey_patch.t => base_util.t} (69%) diff --git a/lib/Mojo/Base.pm b/lib/Mojo/Base.pm index 38f4d9b67b..70404329a4 100644 --- a/lib/Mojo/Base.pm +++ b/lib/Mojo/Base.pm @@ -7,9 +7,9 @@ use feature ':5.16'; use mro; # No imports because we get subclassed, a lot! -use Carp (); -use Scalar::Util (); -use Mojo::MonkeyPatch (); +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 }); @@ -22,8 +22,6 @@ use constant ASYNC => $ENV{MOJO_NO_ASYNC} # Protect subclasses using AUTOLOAD sub DESTROY { } -sub class_to_path { join '.', join('/', split(/::|'/, shift)), 'pm' } - sub attr { my ($self, $attrs, $value, %kv) = @_; return unless (my $class = ref $self || $self) && $attrs; @@ -41,7 +39,7 @@ sub attr { ref $self->{$_} and Scalar::Util::weaken $self->{$_} for @$names; return $self; }; - Mojo::MonkeyPatch::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::MonkeyPatch::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::MonkeyPatch::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(class_to_path($flag)) unless $flag->can('new'); + require(Mojo::BaseUtil::class_to_path($flag)) unless $flag->can('new'); push @{"${caller}::ISA"}, $flag; - Mojo::MonkeyPatch::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..a25983b156 --- /dev/null +++ b/lib/Mojo/BaseUtil.pm @@ -0,0 +1,77 @@ +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 a C and the C function +for L. The main purpose is to provide functions to both C +and C so that C does not have to load the rest of +C. + +=head1 FUNCTIONS + +L only implements a limited number of functions. For forward +compatibility it should still be imported individually. + +=head2 class_to_path + + my $path = class_to_path 'Foo::Bar'; + +Convert class name to path, as used by C<%INC>. + + # "Foo/Bar.pm" + class_to_path 'Foo::Bar'; + + # "FooBar.pm" + class_to_path 'FooBar'; + +=head2 monkey_patch + + monkey_patch $package, foo => sub {...}; + monkey_patch $package, foo => sub {...}, bar => sub {...}; + +Monkey patch functions into package. + + monkey_patch 'MyApp', + one => sub { say 'One!' }, + two => sub { say 'Two!' }, + three => sub { say 'Three!' }; + +=head1 SEE ALSO + +L, L, L. + +=cut diff --git a/lib/Mojo/Home.pm b/lib/Mojo/Home.pm index 04f7d1e267..1454a9b2c9 100644 --- a/lib/Mojo/Home.pm +++ b/lib/Mojo/Home.pm @@ -1,6 +1,8 @@ package Mojo::Home; use Mojo::Base 'Mojo::File'; +use Mojo::Util qw(class_to_path); + sub detect { my ($self, $class) = @_; @@ -9,7 +11,7 @@ sub detect { if ($ENV{MOJO_HOME}) { $home = Mojo::File->new($ENV{MOJO_HOME})->to_array } # Location of the application class (Windows mixes backslash and slash) - elsif ($class && (my $path = $INC{my $file = Mojo::Base::class_to_path $class})) { + elsif ($class && (my $path = $INC{my $file = class_to_path $class})) { $home = Mojo::File->new($path)->to_array; splice @$home, (my @dummy = split(/\//, $file)) * -1; @$home && $home->[-1] eq $_ && pop @$home for qw(lib blib); diff --git a/lib/Mojo/Loader.pm b/lib/Mojo/Loader.pm index 357afd73fe..1331dc633f 100644 --- a/lib/Mojo/Loader.pm +++ b/lib/Mojo/Loader.pm @@ -4,7 +4,7 @@ use Mojo::Base -strict; use Exporter qw(import); use Mojo::Exception; use Mojo::File qw(path); -use Mojo::Util qw(b64_decode); +use Mojo::Util qw(b64_decode class_to_path); our @EXPORT_OK = qw(data_section file_is_binary find_modules find_packages load_class load_classes); @@ -47,7 +47,7 @@ sub load_class { return undef if $class->can('new') || eval "require $class; 1"; # Does not exist - return 1 if $@ =~ /^Can't locate \Q@{[Mojo::Base::class_to_path $class]}\E in \@INC/; + return 1 if $@ =~ /^Can't locate \Q@{[class_to_path $class]}\E in \@INC/; # Real error return Mojo::Exception->new($@)->inspect; diff --git a/lib/Mojo/MonkeyPatch.pm b/lib/Mojo/MonkeyPatch.pm deleted file mode 100644 index 694012da47..0000000000 --- a/lib/Mojo/MonkeyPatch.pm +++ /dev/null @@ -1,56 +0,0 @@ -package Mojo::MonkeyPatch; -use Mojo::Base -strict; - -use Exporter qw(import); -use Sub::Util qw(set_subname); - -our @EXPORT_OK = (qw(monkey_patch)); - - -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::MonkeyPatch - Portable monkey_patch function. - -=head1 SYNOPSIS - - use Mojo::MonkeyPatch qw(monkey_patch); - - monkey_patch 'MyApp', foo => sub { say 'Foo!' }; - -=head1 DESCRIPTION - -L provides a C function for L. - -=head1 FUNCTIONS - -L only implements the function C. For forward -compatibility it should still be imported individually. - -=head2 monkey_patch - - monkey_patch $package, foo => sub {...}; - monkey_patch $package, foo => sub {...}, bar => sub {...}; - -Monkey patch functions into package. - - monkey_patch 'MyApp', - one => sub { say 'One!' }, - two => sub { say 'Two!' }, - three => sub { say 'Three!' }; - -=head1 SEE ALSO - -L, L, L. - -=cut diff --git a/lib/Mojo/Util.pm b/lib/Mojo/Util.pm index 0f4ba4172e..de2a8a42c1 100644 --- a/lib/Mojo/Util.pm +++ b/lib/Mojo/Util.pm @@ -14,7 +14,7 @@ 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::MonkeyPatch qw(monkey_patch); +use Mojo::BaseUtil qw(class_to_path monkey_patch); use Pod::Usage qw(pod2usage); use Socket qw(inet_pton AF_INET6 AF_INET); use Symbol qw(delete_package); @@ -67,7 +67,7 @@ my $ENTITY_RE = qr/&(?:\#((?:[0-9]{1,7}|x[0-9a-fA-F]{1,6}));|(\w+[;=]?))/; # Encoding and pattern cache my (%ENCODING, %PATTERN); -# re-exporting MonkeyPatch::monkey_patch and Mojo::Base::class_to_path for backward compatibility +# re-exporting BaseUtil functions for backward compatibility our @EXPORT_OK = ( qw(b64_decode b64_encode camelize class_to_file class_to_path decamelize decode deprecated dumper encode), qw(extract_usage getopt gunzip gzip header_params hmac_sha1_sum html_attr_unescape html_unescape humanize_bytes), diff --git a/lib/Mojolicious/Command/Author/generate/app.pm b/lib/Mojolicious/Command/Author/generate/app.pm index c6671650f2..7e42ccfb03 100644 --- a/lib/Mojolicious/Command/Author/generate/app.pm +++ b/lib/Mojolicious/Command/Author/generate/app.pm @@ -1,7 +1,7 @@ package Mojolicious::Command::Author::generate::app; use Mojo::Base 'Mojolicious::Command'; -use Mojo::Util qw(class_to_file decamelize); +use Mojo::Util qw(class_to_file class_to_path decamelize); has description => 'Generate Mojolicious application directory structure'; has usage => sub { shift->extract_usage }; @@ -15,7 +15,7 @@ sub run { $self->chmod_rel_file("$name/script/$name", 0744); # Application class - my $app = Mojo::Base::class_to_path $class; + my $app = class_to_path $class; $self->render_to_rel_file('appclass', "$name/lib/$app", {class => $class}); # Config file (using the default moniker) @@ -23,7 +23,7 @@ sub run { # Controller my $controller = "${class}::Controller::Example"; - my $path = Mojo::Base::class_to_path $controller; + my $path = class_to_path $controller; $self->render_to_rel_file('controller', "$name/lib/$path", {class => $controller}); # Test diff --git a/lib/Mojolicious/Command/Author/generate/plugin.pm b/lib/Mojolicious/Command/Author/generate/plugin.pm index bce6e61765..be96d2a4ba 100644 --- a/lib/Mojolicious/Command/Author/generate/plugin.pm +++ b/lib/Mojolicious/Command/Author/generate/plugin.pm @@ -1,7 +1,7 @@ package Mojolicious::Command::Author::generate::plugin; use Mojo::Base 'Mojolicious::Command'; -use Mojo::Util qw(camelize getopt); +use Mojo::Util qw(camelize class_to_path getopt); has description => 'Generate Mojolicious plugin directory structure'; has usage => sub { shift->extract_usage }; @@ -15,7 +15,7 @@ sub run { my $name = $args[0] // 'MyPlugin'; my $class = $full ? $name : "Mojolicious::Plugin::$name"; my $dir = join '-', split(/::/, $class); - my $app = Mojo::Base::class_to_path $class; + my $app = class_to_path $class; $self->render_to_rel_file('class', "$dir/lib/$app", {class => $class, name => $name}); # Test diff --git a/t/mojo/base.t b/t/mojo/base.t index c06518ddd9..106c8526d8 100644 --- a/t/mojo/base.t +++ b/t/mojo/base.t @@ -143,13 +143,4 @@ subtest 'Weaken' => sub { is $weak->four(25)->four, 25, 'right value'; }; -subtest 'class_to_path' => sub { - is Mojo::Base::class_to_path('Foo::Bar'), 'Foo/Bar.pm', 'right path'; - is Mojo::Base::class_to_path("Foo'Bar"), 'Foo/Bar.pm', 'right path'; - is Mojo::Base::class_to_path("Foo'Bar::Baz"), 'Foo/Bar/Baz.pm', 'right path'; - is Mojo::Base::class_to_path("Foo::Bar'Baz"), 'Foo/Bar/Baz.pm', 'right path'; - is Mojo::Base::class_to_path("Foo::Bar::Baz"), 'Foo/Bar/Baz.pm', 'right path'; - is Mojo::Base::class_to_path("Foo'Bar'Baz"), 'Foo/Bar/Baz.pm', 'right path'; -}; - done_testing(); diff --git a/t/mojo/monkey_patch.t b/t/mojo/base_util.t similarity index 69% rename from t/mojo/monkey_patch.t rename to t/mojo/base_util.t index d7956c452f..13fbd64780 100644 --- a/t/mojo/monkey_patch.t +++ b/t/mojo/base_util.t @@ -3,7 +3,17 @@ use Mojo::Base -strict; use Test::More; use Sub::Util qw(subname); -use Mojo::MonkeyPatch qw(monkey_patch); +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 { { @@ -37,4 +47,3 @@ subtest 'monkey_patch (with name)' => sub { }; done_testing(); -