Allright, so I am hacking on a module that needs to load plugins. There is the Pluggable-module which attempts to do that. But I needed additional functionality like being able to get a list of plugins without loading them, and load a list of plugins I give it. And so I looked at the code and found it to be deeply entangled in two big functions, which somehow included already what I needed. So instead of c&p the pieces I needed into new code, I ended up refactoring the whole thing. The thing with refactoring and staying DRY is, that it is often hard to judge where to stop tearing the functionality into smaller and smaller components. At some point, oversight is lost. That idea was reinforced by some talk I watched this week and so I am asking myself wether my judgement in this matter is as good as I think it is.
Long story short, here are the original version and the refactored version. Keep in mind the refactored version has a greater functionality. Did I do a good job? Which version would you want to add to? Which version would you rather look for a bug in?
Original:
unit role Pluggable;
use JSON::Fast;
use File::Find;
my sub match-try-add-module($module-name, $base, $namespace, $name-mat
+cher, @result) {
if ( ($module-name.chars > "{$base}::{$namespace}".chars)
&& ($module-name.starts-with("{$base}::{$namespace}")) ) {
if ((!defined $name-matcher) || ($module-name ~~ $name-matcher)) {
try {
CATCH {
default {
.say if ($*DEBUG-PLUGINS//False);
say .WHAT.perl, do given .backtrace[0] { .file, .line, .su
+bname }
}
}
require ::($module-name);
@result.push(::($module-name));
}
}
}
}
my sub find-modules($base, $namespace, $name-matcher) {
my @result = ();
for $*REPO.repo-chain -> $r {
given $r.WHAT {
when CompUnit::Repository::FileSystem {
my @files = find(dir => $r.prefix, name => /\.pm6?$/);
@files = map(-> $s { $s.substr($r.prefix.chars + 1) }, @files)
+;
@files = map(-> $s { $s.substr(0, $s.rindex('.')) }, @files);
@files = map(-> $s { $s.subst(/\//, '::', :g) }, @files);
for @files -> $f {
match-try-add-module($f, $base, $namespace, $name-matcher, @
+result);
}
}
when CompUnit::Repository::Installation {
# XXX perhaps $r.installed() could be leveraged here, but it
# seems broken at the moment
my $dist_dir = $r.prefix.child('dist');
if ($dist_dir.?e) {
for $dist_dir.IO.dir.grep(*.IO.f) -> $idx_file {
my $data = from-json($idx_file.IO.slurp);
for $data{'provides'}.keys -> $f {
match-try-add-module($f, $base, $namespace, $name-matche
+r, @result);
}
}
}
}
# XXX do we need to support more repository types?
}
}
return @result.unique.Array;
}
method plugins(:$base = Nil, :$plugins-namespace = 'Plugins', :$name-m
+atcher = Nil) {
my $class = "{$base.defined ?? $base !! ::?CLASS.^name}";
return find-modules($class, $plugins-namespace, $name-matcher);
}
sub plugins($base, :$plugins-namespace = 'Plugins', :$name-matcher = N
+il) is export {
return find-modules($base, $plugins-namespace, $name-matcher);
}
Mine:
unit role Pluggable;
use JSON::Fast;
use File::Find;
# Public Interface
# search and load plugins
multi method plugins( :$base = Nil, :$plugins-namespace = 'Plugins', :
+$name-matcher = Nil ) {
load-matching-modules( plugin-base($base), $plugins-namespace, $name
+-matcher );
}
# load a list of plugins
multi method plugins( @list-of-plugins ) {
load-modules( @list-of-plugins );
}
multi sub plugins( $base = Nil, :$plugins-namespace = 'Plugins', :$nam
+e-matcher = Nil ) is export {
load-matching-modules( $base, $plugins-namespace, $name-matcher );
}
multi sub plugins( $list-of-plugins ) is export {
load-modules( $list-of-plugins );
}
method available-plugins(:$base = Nil, :$plugins-namespace = 'Plugins'
+, :$name-matcher = Nil ) {
available-plugins( plugin-base($base), :$plugins-namespace, :$name-m
+atcher );
}
sub available-plugins( $base, :$plugins-namespace = 'Plugins', :$name-
+matcher = Nil ) is export {
list-modules( $base, $plugins-namespace, $name-matcher );
}
# Private stuff
my sub plugin-base( $base ) { $base.defined ?? $base !! ::?CLASS.^name
+ }
my sub load-matching-modules( $base, $namespace, $name-matcher ) {
load-modules( list-modules( $base, $namespace, $name-matcher ) )
}
my sub load-modules( $modules )
{
$modules
.map({ require-module( $_ ) })
# Filter out modules that failed to load.
# Note: We have a list of type objects here.
# These are themselves "false" and their .defined property is "fal
+se" too
# So don' replace the grep with something "simpler" like .grep({$_
+}) or .grep({.defined})
.grep({ !.isa(Nil) })
# Potentially, there same module is installed and locally in "lib"
+ at the same time
.unique
.Array;
}
my sub list-modules( $base, $namespace, $name-matcher ) {
( |matching-installed-modules( $base, $namespace, $name-matcher ),
|matching-filesystem-modules( $base, $namespace, $name-matcher )
).unique.Array;
}
my sub matching-filesystem-modules( $base, $namespace, $name-matcher )
+ {
matching-modules( all-filesystem-modules(), $base, $namespace, $name
+-matcher );
}
my sub matching-installed-modules( $base, $namespace, $name-matcher )
+{
matching-modules( all-installed-modules(), $base, $namespace, $name-
+matcher );
}
my sub matching-modules( $modules, $base, $namespace, $name-matcher )
+{
$modules.grep(-> $module-name {
is-matching-module( $module-name, $base, $namespace, $name-matcher
+ );
});
}
my sub is-matching-module( $module-name, $base, $namespace, $name-matc
+her ) {
( $module-name.chars > "{$base}::{$namespace}".chars ) &&
( $module-name.starts-with("{$base}::{$namespace}") ) &&
( (!defined $name-matcher) || ( $module-name ~~ $name-matcher ) );
}
my sub modules-in-directory( $directory ) {
find(dir => $directory, name => /\.pm6?$/ )
.map({ cleanup-module-name( $_, $directory ) });
}
my sub cleanup-module-name ( $module-name, $path-prefix ) {
$module-name
.substr( $path-prefix.chars + 1 ) # cut off the path
.substr( 0, *-4 ) # cut off the extension
.subst( /\//, '::', :g ) # for linux et al
.subst( /\\/, '::', :g ); # for windows
}
my sub require-module( $module-name ) {
try require ::( $module-name );
return ::( $module-name )
unless $!;
say "Warning: Unable to load <$module-name>";
say $! if ( $*DEBUG-PLUGINS//False );
return;
}
# Black magic
my sub all-filesystem-modules() {
$*REPO.repo-chain
.grep({ .isa( CompUnit::Repository::FileSystem ) })
.map({ |modules-in-directory( .prefix ) });
}
my sub all-installed-modules() {
# XXX perhaps $r.installed() could be leveraged here, but it
# seems broken at the moment
$*REPO.repo-chain
.map({ say $_; $_ })
.grep({ .isa( CompUnit::Repository::Installation ) })
.map({ |modules-in-dist( .prefix ) });
}
my sub modules-in-dist( $directory ) {
# Can't replace this with <map> as this mysteriously dies
# under Windows ( https://github.com/rakudo/rakudo/issues/3120 )
gather {
try {
for $directory.child('dist').IO.dir.grep(*.IO.f) -> $idx-file {
take modules-in-idx-file( $idx-file );
}
}
}.flat
}
sub modules-in-idx-file( $idx-file ) {
try {
my $data = from-json( $idx-file.IO.slurp );
return $data{'provides'}.keys;
}
}
holli
You can lead your users to water, but alas, you cannot drown them.
|
Re: Refactoring example (A good one? (Perl6))
by jcb (Parson) on Aug 13, 2019 at 06:19 UTC
|
I will admit that learning Perl 6 has just found its way onto my TODO list ... somewhere. That is a very interesting language.
Back on topic, is Pluggable a mixin? Would this refactoring change the interface exposed by other classes that use Pluggable? Could the original "narrow" interface have been a goal in itself?
The original version fits on a single screen here if I stretch my edit window, while the refactored version crosses that threshold into requiring scrolling. For that reason alone, I expect that the original would be easier for me to debug, although the exact threshold here is a quirk of my environment and YMMV. I am also assuming, based on the reputation of St. Larry, that the Perl 6 debugger is at least as capable as the Perl 5 debugger when inspecting the function of seemingly monolithic blocks of code.
I do not know enough about Perl 6 to be sure, but the refactored version "feels like" it may do more work than the original. This may just be a cognitive bias because it is longer, and the actual code paths may be more efficient or at least equivalent if the new functionality is not used, but it "feels" questionable to me. I do not know if Perl 6 can inline my sub or not, but I know that calling a sub is not free in Perl 5 (among the best as far as interpreted languages go, but not free) as I learned using HTML::Parser on long and complex documents.
An aside for the interested reader: HTML::Parser for Perl 5 can either call a sub or push an array reference containing the arguments that would have been passed to the sub onto an array, with the latter implemented entirely in XS code. I have seen significant performance improvements by simply storing such a "parse trace" into an array and then processing the array with foreach compared to actually handling the nodes as the parser encounters them. Note that those improvements only come if the entire handling is in the loop body: HTML::Parser is very efficient and sub call overhead is small in Perl 5, but it is not zero!
| [reply]
[d/l]
[select] |
|
|
| [reply]
[d/l] |
|
|
| [reply]
[d/l]
[select] |
|
|
