Exporter::Graft.pm

package Exporter::Graft;

# DO NOT USE UNDER MOD_PERL OR ANY OTHER SORT OF SINGLE-PROCESS-CONCURRENCY!
# IT IS LIKELY THAT ONE CALLER TO THIS WILL STOMP THE CHANGES ANOTHER CALLER
# MADE WITH THIS BEFORE THE FIRST CALLER CAN USE THEM.
# FASTCGI SHOULD BE FINE.

use strict;
use warnings;

require UNIVERSAL::require;

use base 'Exporter';
our @EXPORT = qw( import );
our @EXPORT_OK = qw();

sub import {
    my $callpkg = caller(0);
  
    {
        no strict 'refs';
        *{$callpkg."::import"} = \&graft_exports_to_target_and_export_to_caller;
    }
    
    return;
}

sub graft_exports_to_target_and_export_to_caller {
    my ( $target_module, $mode, $data, @caller_import ) = @_;
    
    my $graft_module = translate_graft_module_name( $target_module, $mode, $data );
    
    my ( $graft_EXPORT, $graft_EXPORT_OK ) = load_graft_module( $graft_module );
    my @target_EXPORT = write_subs_to_target( $graft_module, $target_module, $graft_EXPORT, $graft_EXPORT_OK );
    write_subs_to_caller( $target_module, \@target_EXPORT, @caller_import );
    
    return;
}

sub load_graft_module {
    my ( $graft_module ) = @_;
    
    $graft_module->require or die $@;                                   # get the graft module into memory
    
    my @graft_EXPORT = get_real_export_list( $graft_module );           # get the graft module's export lists
    my @graft_EXPORT_OK = get_real_export_list( $graft_module, '_OK' );
    
    return ( \@graft_EXPORT, \@graft_EXPORT_OK );
}

sub write_subs_to_target {
    my ( $graft_module, $target_module, $graft_EXPORT, $graft_EXPORT_OK ) = @_;
    
    $graft_module->export( $target_module, @{$graft_EXPORT}, @{$graft_EXPORT_OK} ); # export all subs into the target's namespace
    my @target_EXPORT = set_target_export_list( $target_module, undef, @{$graft_EXPORT} );              # set the target module's export lists to match the graft module's lists
    set_target_export_list( $target_module, '_OK', @{$graft_EXPORT_OK} );    
    
    return @target_EXPORT;
}

sub write_subs_to_caller {
    my ( $target_module, $target_EXPORT, @caller_import ) = @_;
    
    @caller_import = @{$target_EXPORT} if !@caller_import;   # default to @EXPORT if no subs to import are specified
    my $call_pkg = caller(1);
    $target_module->export( $call_pkg, @caller_import );    # export requested functions into the namespace that called $prepender_pkg
    
    return;
}

sub translate_graft_module_name {
    my ( $target_pkg, $mode, $data ) = @_;
    
    my %modes = (
        prefix => \&prepend_to_target,
        suffix => \&append_to_target,
        name => \&direct,
        code => \&apply_sub_to_target,
    );
    
    die "no mode" if !$mode;
    die "unknown mode $mode" if !$modes{$mode};
    
    return $modes{$mode}->( $target_pkg, $data );
}

sub prepend_to_target {
    my ( $target_pkg, $data ) = @_;
    return $data."::".$target_pkg;
}

sub append_to_target {
    my ( $target_pkg, $data ) = @_;
    return $target_pkg."::".$data;
}

sub direct {
    my ( $target_pkg, $data ) = @_;
    return $data;
}

sub apply_sub_to_target {
    my ( $target_pkg, $data ) = @_;
    return $data->( $target_pkg );
}

sub get_real_export_list {
    my ( $pkg, $suffix ) = @_;
    $suffix ||= '';
    
    {
        no strict 'refs';
        return @{$pkg."::EXPORT".$suffix};
    }
}

sub set_target_export_list {
    my ( $pkg, $suffix, @exports ) = @_;
    $suffix ||= '';
    
    my $target_export_list;
    {
        no strict 'refs';
        $target_export_list = \@{$pkg."::EXPORT".$suffix};
    }
    push @{$target_export_list}, @exports;
    
    return @{$target_export_list};
}

1;

ExporterModule.pm

package ExporterModule;

use strict;
use warnings;

use base 'Exporter';
our @EXPORT = qw( marp );

use Exporter::Graft;

sub marp {
    print 'weee';
}

1;

Marp::ExporterModule.pm

package Marp::ExporterModule;

use strict;
use warnings;

use base 'Exporter';
our @EXPORT = qw( blah );
our @EXPORT_OK = qw( moo );

sub blah {
    print 4;
}

sub moo {
    print 'moo';
}

1;

Meep::ExporterModule.pm

package Meep::ExporterModule;

use strict;
use warnings;

use base 'Exporter';
our @EXPORT = qw( blah );
our @EXPORT_OK = qw( moo );

sub blah {
    print 3;
}

sub moo {
    print 'meow';
}

1;

script.pl

#!/usr/bin/perl
use strict;
use warnings;

# use Foo;
use Local::Patched::Foo qw( baz );
baz();

exit;

my $marp = $ARGV[0];
$marp ||= 'Marp';


require ExporterModule;

ExporterModule->import( prefix => $marp );

marp();
ExporterModule::marp();

blah();                 # from $marp::ExporterModule -- in @EXPORT
ExporterModule::blah(); # from $marp::ExporterModule -- in @EXPORT
ExporterModule::moo();  # from $marp::ExporterModule -- in @EXPORT_OK

#moo();                 # from $marp::ExporterModule -- dies


ExporterModule->import( prefix => $marp, 'moo' );

moo();                 # from $marp::ExporterModule -- in @EXPORT_OK



print ' ';



$marp = 'Meep';


ExporterModule->import( prefix => $marp );

blah();                 # from $marp::ExporterModule -- in @EXPORT
ExporterModule::blah(); # from $marp::ExporterModule -- in @EXPORT
ExporterModule::moo();  # from $marp::ExporterModule -- in @EXPORT_OK

#moo();                 # from $marp::ExporterModule -- dies


ExporterModule->import( prefix => $marp, 'moo' );

moo();                 # from $marp::ExporterModule -- in @EXPORT_OK



print ' ';



$marp = 'Marp';


ExporterModule->import( code => sub { $marp."::".$_[0] } );

blah();                 # from $marp::ExporterModule -- in @EXPORT
ExporterModule::blah(); # from $marp::ExporterModule -- in @EXPORT
ExporterModule::moo();  # from $marp::ExporterModule -- in @EXPORT_OK

#moo();                 # from $marp::ExporterModule -- dies


ExporterModule->import( prefix => $marp, 'moo' );

moo();                 # from $marp::ExporterModule -- in @EXPORT_OK