view release on metacpan or  search on metacpan

lib/Badger/Exporter.pm  view on Meta::CPAN

        # declarataions.  We upgrade each '=value' to a constant subroutine.
        if (ref && ref eq HASH) {
            while (my ($key, $value) = each %$_) {
                if ($value =~ s/^=//) {
                    _debug("export_tags() constructing constant: $key => $value\n") if $DEBUG;
                    $_->{ $key } = sub() { $value };
                }
            }
        }
        $_;
    }
    values %$args;

    # all symbols referenced in tagsets (except other tag sets) must be
    # flagged as exportable
    $self->export_any(
        grep {
            # ignore references to code or other tag sets
            not (ref || /^(:|=)/);
        }
        map {
            # symbols in tagset can be a list ref, hash ref or string
            ref $_ eq ARRAY ? @$_ :
            ref $_ eq HASH  ? %$_ :
            split DELIMITER
        }
        values %$args
    );

    return $tags;
}

sub export_hooks {
    my $self  = shift;
    my $args  = (@_ == 1) && (ref $_[0] eq HASH) ? shift : { @_ };
    my $hooks = $self->export_variable( EXPORT_HOOKS => { } );
    @$hooks{ keys %$args } = values %$args;
    return $hooks;
}

sub export_fail {
    my $self  = shift;
    my $class = ref $self || $self;
    no strict REFS;

    # get/set $EXPORT_FAIL
    return @_
        ? (${$class.PKG.EXPORT_FAIL} = shift)
        :  ${$class.PKG.EXPORT_FAIL};
}


#------------------------------------------------------------------------
# import/export methods:
#   import(@imports)
#   export($target, @exports)
#------------------------------------------------------------------------

sub import {
    my $class  = shift;
    my $target = (caller())[0];

    # enable strict and warnings in the caller - this ensures that every
    # Badger module (that calls this method - which is pretty much all of
    # them) has strict/warnings enabled, without having to explicitly write
    # it.  Thx Moose!
    strict->import;
    warnings->import;

    # call in the heavy guns
    $class->export($target, @_);
}

sub export {
    my $class     = shift;
    my $target    = shift;
    my $imports   = @_ == 1 ? shift : [ @_ ];
    my ($all, $any, $tags, $hooks, $fails, $before, $after)
                  = $class->exportables;
    my $can_hook  = (%$hooks ? 1 : 0);
    my $added_all = 0;
    my $count     = 0;
    my ($symbol, $symbols, $source, $hook, $pkg, $nargs,
        %done, @args, @errors);

    no strict   REFS;
    no warnings ONCE;

    # imports can be a single whitespace delimited string of symbols
    $imports = [ split(DELIMITER, $imports) ]
        unless ref $imports eq ARRAY;

    # default to export_all if list of exports not specified
    # TODO: what about: use Badger::Example qw();    ?  perhaps we should
    # return unless @_ up above?
    @$imports = @$all unless @$imports;

    foreach $hook (@$before) {
        $hook->($class, $target, $imports);
    }

    SYMBOL: while (@$imports) {
        next unless ($symbol = shift @$imports);
        next if $done{ $symbol }++;

        # look for :tagset symbols and expand their contents onto @$imports
        if ($symbol =~ s/^://) {
            if ($symbols = $tags->{ $symbol }) {
                if (ref $symbols eq ARRAY) {
                    # expand list of symbols onto @$imports list
                    unshift(@$imports, @$symbols);
                }
                elsif (ref $symbols eq HASH) {
                    # map hash into [name => $symbol] pairs
                    unshift(@$imports, map { [$_ => $symbols->{ $_ }] } keys %$symbols);
                }
                else {
                    # string of space-delimited symbols
                    unshift(@$imports, split(DELIMITER, $symbols));
                }
            }