Prototype Sub Mocking Shim

Shim.pm

package My::Test::Shim;

use Test2::V0;
use 5.10.0;

use Test2::Mock;
use Package::Stash;

use Exporter ();
use Module::Runtime qw( use_module );

our @EXPORT = ( 'shim' );

our %SHADOW_PACKAGE;

our $mock;

BEGIN {
    $mock = Test2::Mock->new(
    class  => 'Test2::Mock',
    around => [
        new => sub {
            my ( $orig, $class ) = ( shift, shift );
            my @args;
            while( @_ && $_[0] ne 'class' ) { push @args, shift, shift };
            push @args, shift, $SHADOW_PACKAGE{ $_[0]} // $_[0];
            shift;
            @_ = ($class, @args, @_);
            goto $orig;
        }
    ] );
}

sub shim {
    my $class = shift;

    use_module( $class )
      or do { require Carp; Carp::croak( "error loading $class\n" ) };

    my $shadow = $SHADOW_PACKAGE{$class} //= join( '::', __PACKAGE__, $class );

    my $from = Package::Stash->new( $class );
    my $to   = Package::Stash->new( $shadow );

    @_ = $from->list_all_symbols( 'CODE' )
      unless @_;

    for my $sub ( @_ ) {
        my $from_sub = $from->get_symbol( '&' . $sub );
        $to->add_symbol( '&' . $sub, $from_sub );
        my $symbol = "${shadow}::${sub}";
        my $code   = "sub { goto *${symbol}{CODE} }";
        $from->add_symbol( '&' . $sub, eval $code );
    }
}

sub import {
    if ( @_ > 2 && $_[1] eq '-shim' ) {
        shim $_ for ( 'ARRAY' eq ref $_[2] ? @{ $_[2] } : $_[2] );
        @_ = ( shift, do { shift, shift; () }, @_ );
    }
    goto \&Exporter::import;
}


1;