File Coverage

blib/lib/Exporter/WithBase.pm

Criterion	Covered	Total	%
statement	19	22	86.3
branch	3	6	50.0
condition	3	6	50.0
subroutine	5	5	100.0
pod			n/a
total	30	39	76.9

use strict qw; # no refs
use warnings;

package Exporter::WithBase;
# ABSTRACT: Like Exporter, but add a '-base' flag to declare a class as a child
$Exporter::WithBase::VERSION = '1.00';
use Exporter 5.57 ();

sub import
{
    my $caller = caller;
    # If -base, inherit from Exporter
    if (@_ >= 2 && $_[1] eq '-base') {
	splice @_, 1, 1;
	push @{"${caller}::ISA"}, $_[0] eq __PACKAGE__ ? 'Exporter' : $_[0];
    }
    # Inject _import as import
    *{"${caller}::import"} = \&_import;
    # No symbols to export
}

sub _import
{
    if (@_ >= 2 && $_[1] eq '-base') {
	splice @_, 1, 1;
	my $caller = caller;
	push @{"${caller}::ISA"}, $_[0];
    }
    goto &Exporter::import;
}

1;
__END__