Skip to content

Instantly share code, notes, and snippets.

@dolmen
Forked from kentfredric/winrar.pl
Last active August 29, 2015 14:14
Show Gist options
  • Save dolmen/3b2a03fdffd113fbf73b to your computer and use it in GitHub Desktop.
Save dolmen/3b2a03fdffd113fbf73b to your computer and use it in GitHub Desktop.
Monkey patching a fatpacked script (cpanm)
#!/usr/bin/env perl
# Dynamically patch cpanm
# Alternative implementation to:
# https://gist.github.com/kentfredric/ce1df3e7e509e071b63d
use strict;
use 5.010001;
use warnings;
use Scalar::Util qw(blessed);
use File::Which qw(which);
{
# Make 'use App::cpanminus::scipt;' do nothing
local $INC{'App/cpanminus/script.pm'} = 1;
require(which 'cpanm');
}
# Find the fatpacked container object
my $fatpacked;
for my $inc (@INC) {
if (blessed($inc) && index(ref($inc), 'FatPacked::') == 0) {
$fatpacked = $inc;
last;
}
}
die "Couldn't hack into fatpacked script!" unless $fatpacked;
# Delete external modules embedded in the script, and let us load them
# from the usual place
delete @{$fatpacked}{ grep !m<\AApp/cpanminus>, keys %$fatpacked };
# Patch App::cpanminus::script::install_module
# From this point this is kentfredric's original code
require App::cpanminus::script;
{
my $old = App::cpanminus::script->can('install_module');
my $stack = [];
sub pp_stack {
printf "\e[31m%s\e[0m", join qq[->\n], map { $_->[0] } @{$stack};
}
my $new = sub {
my ( $self, $module, $depth, $version ) = @_;
push @{$stack}, [ $module, $depth, $version ];
pp_stack;
my $exit = $self->$old( $module, $depth, $version );
pop @{$stack};
return $exit;
};
{
no strict 'refs';
no warnings 'redefine';
*{"App::cpanminus::script::install_module"} = $new;
}
}
unless (caller) {
my $app = App::cpanminus::script->new;
$app->parse_options(@ARGV);
exit $app->doit;
}
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment