File Coverage

blib/lib/Getopt/LL/SimpleExporter.pm

Criterion	Covered	Total	%
statement	42	42	100.0
branch	2	2	100.0
condition			n/a
subroutine	8	8	100.0
pod	1	1	100.0
total	53	53	100.0

# $Id: SimpleExporter.pm,v 1.5 2007/07/13 00:00:14 ask Exp $
# $Source: /opt/CVS/Getopt-LL/lib/Getopt/LL/SimpleExporter.pm,v $
# $Author: ask $
# $HeadURL$
# $Revision: 1.5 $
# $Date: 2007/07/13 00:00:14 $
package Getopt::LL::SimpleExporter;
use strict;
use warnings;
use version; our $VERSION = qv('1.0.0');
use 5.006_001;

my %EXPORTS_FOR_PACKAGE = ();

sub import {
    my @exports = @_;
    my $caller = caller;

    $EXPORTS_FOR_PACKAGE{$caller} = {map { $_ => 1} @exports};

    no strict 'refs'; ## no critic;
    *{ $caller . q{::} . 'import'    } = \&simple_export;
    @{ $caller . q{::} . 'EXPORT_OK' } = @exports;

    return;
}

sub simple_export {
    my ($class, @tags) = @_;
        my $caller = caller;

        no strict 'refs'; ## no critic
        while (@tags) {
            my $export_attr = shift @tags;
            my %exports     = %{ $EXPORTS_FOR_PACKAGE{$class} };

            if (!exists $exports{$export_attr}) {
                require Carp;
                Carp->import('croak');
                croak("$class does not export $export_attr"); ## no critic
            }

            my $sub = *{ "$class\::$export_attr" }{CODE}; ## no critic
            *{ $caller . q{::} . $export_attr } = $sub;
        }

        return;
}

1;

__END__