package Exporter::Simple;
use 5.008;
use warnings;
use strict;
use Attribute::Handlers;
use base 'Exporter';
our $VERSION = '1.10';
no warnings 'redefine';
sub UNIVERSAL::Exported :ATTR(SCALAR,BEGIN) { export('$', BEGIN => @_) }
sub UNIVERSAL::Exported :ATTR(ARRAY,BEGIN) { export('@', BEGIN => @_) }
sub UNIVERSAL::Exported :ATTR(HASH,BEGIN) { export('%', BEGIN => @_) }
sub UNIVERSAL::Exported :ATTR(CODE,BEGIN,CHECK) { export('', INIT => @_) }
sub UNIVERSAL::Exportable :ATTR(SCALAR,BEGIN) { exportable('$', BEGIN => @_) }
sub UNIVERSAL::Exportable :ATTR(ARRAY,BEGIN) { exportable('@', BEGIN => @_) }
sub UNIVERSAL::Exportable :ATTR(HASH,BEGIN) { exportable('%', BEGIN => @_) }
sub UNIVERSAL::Exportable :ATTR(CODE,BEGIN,CHECK) { exportable('', INIT => @_) }
# Build a structure in which we remember what to export when (in
# which phase, BEGIN or INIT) to whom. Scalars, arrays and hashes are exported
# during BEGIN, but subroutines need to be exported during CHECK, because
# their names aren't known during BEGIN (they're 'ANON' in this phase). But
# because of a bug in Attribute::Handlers, we can't just declare
# :ATTR(CODE,CHECK), because that would make the handlers for scalars, arrays
# and hashes run during CHECK as well, even though they were declared as
# :ATTR(...,BEGIN). But each handler specifies in the call to export() or
# exportable() which phase the symbol is to be exported in.
#
# The structure is %EXPORTDEF and is built when the attribute handlers run,
# and consulted during do_export(), which is called both from import() and
# INIT(), see below.
#
# An example structure is shown here and is built by declaring the following
# exports in a module that subclasses Exporter::Simple:
#
# our @bar : Exportable(vars) = (2, 3, 5, 7);
# our $foo : Exported(vars) = 42;
# our %baz : Exported = (a => 65, b => 66);
#
# sub hello : Exported(greet,uk) { "hello there" }
# sub askme : Exportable { "what you will" }
# sub hi : Exportable(greet,us) { "hi there" }
#
# sub get_foo : Exported(vars) { $foo }
# sub get_bar : Exportable(vars) { @bar }
#
# results in:
#
# %EXPORTDEF =
# --- #YAML:1.0
# BEGIN:
# MyExport:
# EXPORT:
# - '$foo'
# - '%baz'
# EXPORT_OK:
# - '@bar'
# EXPORT_TAGS:
# all:
# - '@bar'
# - '$foo'
# - '%baz'
# greet: []
# uk: []
# us: []
# vars:
# - '@bar'
# - '$foo'
# INIT:
# MyExport:
# EXPORT:
# - hello
# - get_foo
# EXPORT_OK:
# - askme
# - hi
# - get_bar
# EXPORT_TAGS:
# all:
# - hello
# - askme
# - hi
# - get_foo
# - get_bar
# greet:
# - hello
# - hi
# uk:
# - hello
# us:
# - hi
# vars:
# - get_foo
# - get_bar
sub add {
my ($arrname, $sigil, $exp_phase, $pkg, $symbol, $ref, $attr, $tags) = @_;
$symbol = *{$symbol}{NAME} if ref $symbol;
$symbol = "$sigil$symbol";
$tags = [ $tags || () ] unless ref $tags eq 'ARRAY';
our %EXPORTDEF;
if ($symbol eq 'ANON') {
# see the empty arrays in keys 'greet', 'uk' and 'us' in the above
# sample of $EXPORT{BEGIN}{MyExport}{EXPORT_TAGS} ? They need to be
# there because these tags are only defined by subroutines (hello()
# and hi(); see sample code above), and hence they would appear in
# %EXPORTDEF only during CHECK, but the tag ':greet' still gets passed
# to Exporter::import() during BEGIN (which is necessary because some
# scalars, arrays and hashes *could* still have used these tags in
# their attribute declarations). Therefore, when we handle a subroutine
# attribute during BEGIN (recognized by the symbol name being 'ANON'),
# we make empty entries for the tags in %EXPORTDEF. Now Exporter is
# happy and the tests are happy and we are all happy.
$EXPORTDEF{BEGIN}{$pkg}{EXPORT_TAGS}{$_} ||= [] for @$tags, 'all';
# we'll see the sub again during CHECK, to be exported during INIT, so:
return;
}
push @{ $EXPORTDEF{$exp_phase}{$pkg}{$arrname} } => $symbol unless
grep { $_ eq $symbol } @{ $EXPORTDEF{$exp_phase}{$pkg}{$arrname} };
for my $tag (@$tags, 'all') {
push @{ $EXPORTDEF{$exp_phase}{$pkg}{EXPORT_TAGS}{$tag} } => $symbol
unless grep { $_ eq $symbol }
@{ $EXPORTDEF{$exp_phase}{$pkg}{EXPORT_TAGS}{$tag} };
}
}
sub export { add(EXPORT => @_) }
sub exportable { add(EXPORT_OK => @_) }
# import() could be called several times, from different packages
# who want to import symbols from us. So we remember who gets to
# import what in which phase. Scalars, arrays and hashes are imported
# during BEGIN (that's why import() also calls do_export('BEGIN') at
# the end, while subroutines are exported during INIT. Tags, starting
# with a colon, need to be seen both during BEGIN and END.
sub import {
my $pkg = shift;
our %wants_import;
for (@_) {
if (/^:/) {
push @{ $wants_import{BEGIN}{$pkg} } => $_;
push @{ $wants_import{INIT}{$pkg} } => $_;
} elsif (/^[\$\@%]/) {
push @{ $wants_import{BEGIN}{$pkg} } => $_;
} else {
push @{ $wants_import{INIT}{$pkg} } => $_;
}
}
do_export('BEGIN');
}
sub do_export {
my $phase = shift;
our (%EXPORTDEF, %wants_import);
while (my ($pkg, $def) = each %{ $EXPORTDEF{$phase} }) {
no strict 'refs';
# remove export cache; without this, we can't export in both BEGIN
# and INIT phases
undef %{ "$pkg\::EXPORT" };
# build the variables Exporter requires to do its work and ask it to export
# the symbols we remembered during import().
@{ "$pkg\::EXPORT" } = @{ $def->{EXPORT} || [] };
@{ "$pkg\::EXPORT_OK" } = @{ $def->{EXPORT_OK} || [] };
%{ "$pkg\::EXPORT_TAGS" } = %{ $def->{EXPORT_TAGS} || {} };
local $Exporter::ExportLevel = 2;
Exporter::import($pkg => @{ $wants_import{$phase}{$pkg} || [] });
}
}
INIT { do_export('INIT') }
1;
__END__
=head1 NAME
Exporter::Simple - Easier set-up of module exports
=head1 SYNOPSIS
package MyExport;
use base 'Exporter::Simple';
our @bar : Exportable(vars) = (2, 3, 5, 7);
our $foo : Exported(vars) = 42;
our %baz : Exported = (a => 65, b => 66);
sub hello : Exported(greet,uk) { "hello there" }
sub askme : Exportable { "what you will" }
sub hi : Exportable(greet,us) { "hi there" }
# meanwhile, in a module far, far away
use MyExport qw(:greet);
print hello();
$baz{c} = 67;
=head1 DESCRIPTION
This module, when subclassed by a package, allows that package to define
exports in a more concise way than using C<Exporter>. Instead of having to
worry what goes in C<@EXPORT>, C<@EXPORT_OK> and C<%EXPORT_TAGS>, you can
use two attributes to define exporter behavior. This has two advantages:
It frees you from the implementation details of C<Exporter>, and it
keeps the export definitions where they belong, with the subroutines
and variables.
The attributes provided by this module are:
=over 4
=item C<Exported>
Indicates that the associated subroutine or global variable should
be automatically exported. It will also go into the C<:all> tag
(per the rules of C<%EXPORT_TAGS>), as well as any tags you specify
as options of this attribute.
For example, the following declaration
sub hello : Exported(greet,uk) { ... }
will cause C<hello()> to be exported, but also be available in the
tags C<:all>, C<:greet> and C<:uk>.
=item C<Exportable>
Is like C<Exported>, except that the associated subroutine or
global variable won't be automatically exported. It will still
go to the C<:all> tag in any case and all other tags specified as
attribute options.
=back
=head1 BUGS
If you find any bugs or oddities, please do inform the author.
=head1 INSTALLATION
See perlmodinstall for information and options on installing Perl modules.
=head1 AVAILABILITY
The latest version of this module is available from the Comprehensive Perl
Archive Network (CPAN). Visit <http://www.perl.com/CPAN/> to find a CPAN
site near you. Or see <http://www.perl.com/CPAN/authors/id/M/MA/MARCEL/>.
=head1 VERSION
This document describes version 1.10 of C<Exporter::Simple>.
=head1 AUTHOR
Marcel GrE<uuml>nauer <[email protected]>
=head1 CONTRIBUTORS
Damian Conway <[email protected]>
Richard Clamp <[email protected]>
=head1 COPYRIGHT
Copyright 2001-2002 Marcel GrE<uuml>nauer. All rights reserved.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=head1 SEE ALSO
perl(1), Attribute::Handlers(3pm), Exporter(3pm).
=cut