view release on metacpan or  search on metacpan

lib/Export/Attrs.pm  view on Meta::CPAN

package Export::Attrs;

our $VERSION = 'v0.1.0';

use warnings;
use strict;
use Carp;
use Attribute::Handlers;
use PadWalker qw( var_name peek_my );

my %IMPORT_for;

sub import {
    my $caller = caller;
    no strict 'refs';
    *{$caller.'::import'} = \&_generic_import;
    *{$caller.'::IMPORT'} = sub (&) { $IMPORT_for{$caller} = shift };
    for my $var_type (qw( SCALAR ARRAY HASH CODE )) {
        *{$caller.'::MODIFY_'.$var_type.'_ATTRIBUTES'} = \&_generic_handler;
    }
    return;
}

my %tagsets_for;
my %is_exported_from;
my %named_tagsets_for;
my %decl_loc_for;
my %name_of;

my $IDENT = '[^\W\d]\w*';

sub _generic_handler {
    my ($package, $referent, @attrs) = @_;

    ATTR:
    for my $attr (@attrs) {

        ($attr||=q{}) =~ s/\A Export (?: \( (.*) \) )? \z/$1||q{}/exms
            or next ATTR;

        my @tagsets = grep {length $_} split m/ \s+,?\s* | ,\s* /xms, $attr;

        my (undef, $file, $line) = caller(1);
        $file =~ s{.*/}{}xms;

        if (my @bad_tags = grep {!m/\A :$IDENT \z/xms} @tagsets) {
            die 'Bad tagset',
                (@bad_tags==1?' ':'s '),
                "in :Export attribute at '$file' line $line: [@bad_tags]\n";
        }

        my $tagsets = $tagsets_for{$package} ||= {};

        for my $tagset (@tagsets) {
            push @{ $tagsets->{$tagset} }, $referent;
        }
        push @{ $tagsets->{':ALL'} }, $referent;

        $is_exported_from{$package}{$referent} = 1;
        $decl_loc_for{$referent} = "$file line $line";
        $name_of{$referent} = _get_lexical_name($referent);

        undef $attr;

    }

    return grep {defined $_} @attrs;
}