Front page | perl.perl5.porters |
Postings from February 2003
[PATCH] making Exporter simpler to use
Thread Next
From:
Fergal Daly
Date:
February 11, 2003 09:02
Subject:
[PATCH] making Exporter simpler to use
Message ID:
200302111659.34960.fergal@esatclear.ie
If accepted this patch will allow hundreds of lines of fiddling with
EXPORT_BLAH to be deleted from Perl modules.
The patch barely touches the original code and is totally backwards
compatible. All it does is give a nice way to set up @EXPORT and all the
others without have to explicitly mention them.
T
his time I diffed against the latest version of Exporter - 5.567. The patch
includes tests and doc changes.
In it's simplest case it allows you to replace
require Exporter;
use base qw( Exporter );
use vars qw( @EXPORT );
@EXPORT = qw( init );
with
use Exporter ( EXPORT => [qw( init )] );
For more complex needs, it allows you to build tags easily and to use
previously defined tags to build new tags. You can also use tags in EXPORT
and EXPORT_FAIL. It automatically builds @EXPORT_OK and, if you want, it will
automatically build a tag that contains all the symbols you've mentioned
(minus the ones in EXPORT_FAIL).
Comments or objections?
F
### START OF PATCH ###
--- perl-5.8.0/lib/Exporter.pm.orig 2003-02-11 15:17:46.000000000 +0000
+++ perl-5.8.0/lib/Exporter.pm 2003-02-11 16:37:36.000000000 +0000
@@ -9,7 +9,7 @@
our $Debug = 0;
our $ExportLevel = 0;
our $Verbose ||= 0;
-our $VERSION = '5.567';
+our $VERSION = '5.568';
our (%Cache);
$Carp::Internal{Exporter} = 1;
@@ -30,6 +30,12 @@
my $pkg = shift;
my $callpkg = caller($ExportLevel);
+ if ($pkg eq 'Exporter')
+ {
+ # called as 'use Exporter'
+ return _set_export_vars($callpkg, @_);
+ }
+
# We *need* to treat @{"$pkg\::EXPORT_FAIL"} since Carp uses it :-(
my($exports, $fail) = (\@{"$pkg\::EXPORT"}, \@{"$pkg\::EXPORT_FAIL"});
return export $pkg, $callpkg, @_
@@ -60,6 +66,168 @@
*{"$callpkg\::$_"} = \&{"$pkg\::$_"} foreach @_;
}
+sub _set_export_vars
+{
+ # this handles setting up all of the EXPORT variables in the callers
+ # package. It gives a nice way of creating tags, allows you to use tags
+ # when defining @EXPORT, @EXPORT_FAIL and other in tags. It also takes
+ # care of @EXPORT_OK.
+
+ my $callpkg = shift;
+ my %args = @_;
+
+ push(@{"$callpkg\::ISA"}, "Exporter");
+
+ my @ok; # this will be a list of all the symbols mentioned
+ my @export; # this will be a list symbols to be exported by default
+ my @fail; # this will be a list symbols that should not be exported
+ my $tags; # will contain a ref hash of all tags
+
+ if (my $tag_data = $args{'TAGS'})
+ {
+ die "TAGS must be a reference to an array" unless ref($tag_data) eq
'ARRAY';
+
+ $tags = _build_all_tags($tag_data);
+
+ push(@ok, map {@$_} values %$tags);
+ }
+
+ if (my $export = $args{'EXPORT'})
+ {
+ die "EXPORT must be a reference to an array"
+ unless ref($export) eq 'ARRAY';
+
+ @export = eval { _expand_tags($export, $tags) };
+ die "$@while building the EXPORT list in $callpkg" if $@;
+
+ push(@ok, @export);
+ }
+
+ if (my $fail = $args{'FAIL'})
+ {
+ die "FAIL must be a reference to an array" unless ref($fail) eq 'ARRAY';
+
+ @fail = eval { _expand_tags($fail, $tags) };
+ die "$@while building the FAIL list in $callpkg" if $@;
+ }
+
+ if (my $ok = $args{'OK'})
+ {
+ die "OK must be a reference to a array" unless ref($ok) eq 'ARRAY';
+
+ push(@ok, @$ok);
+ }
+
+ # uniquify the OK symbols and take out any fails
+ @ok = do
+ {
+ my %o;
+ @{o}{@ok} = ();
+ delete @o{@fail};
+ keys %o
+ };
+
+ if (my $all = $args{'ALL'})
+ {
+ die "No name supplied for ALL" unless length($all);
+
+ die "Cannot use '$all' for ALL, already exists" if exists $tags->{$all};
+ my @all = (@ok, @export);
+ # uniquify
+ @all = do { my %o; @{o}{@all} = (); keys %o };
+
+ $tags->{$all} = \@all;
+ }
+
+ @{"$callpkg\::EXPORT"} = @export;
+ %{"$callpkg\::EXPORT_TAGS"} = %$tags;
+ @{"$callpkg\::EXPORT_OK"} = @ok;
+ @{"$callpkg\::EXPORT_FAIL"} = @fail;
+}
+
+sub _build_all_tags($)
+{
+ # this takes the tags argument and creates a hash of all the tags with
+ # their various expansions and deletions performed
+
+ my $tags = shift;
+
+ my %tags_so_far;
+
+ my @tags = @$tags;
+ while (@tags)
+ {
+ my $tag_name = shift @tags || die "No name for tag";
+ die "Tag name cannot be a reference, maybe you left out a comma"
+ if (ref $tag_name);
+
+ die "Tried to redefine tag '$tag_name'"
+ if (exists $tags_so_far{$tag_name});
+
+ my $tag_list = shift @tags || die "No values for tag '$tag_name'";
+
+ die "Tag values for '$tag_name' is not a reference to an array"
+ unless ref($tag_list) eq 'ARRAY';
+
+ my @symbols = eval { _expand_tags($tag_list, \%tags_so_far) };
+
+ die "$@while building tag '$tag_name'" if $@;
+
+ $tags_so_far{$tag_name} = \@symbols;
+ }
+
+ return \%tags_so_far;
+}
+
+sub _expand_tags($$)
+{
+ # this takes a list of strings. Each string can be a symbol, or a tag and
+ # each may start with a ! to signify deletion.
+
+ # We return a list of symbols where all the tag have been expanded and
+ # some symbols may have been deleted
+
+ # we die if we hit an unknown tag
+
+ my ($string_list, $so_far) = @_;
+
+ my %this_tag;
+
+ foreach my $sym (@$string_list)
+ {
+ my @symbols; # list of symbols to add or delete
+ my $remove = 0;
+
+ if ($sym =~ s/^!//)
+ {
+ $remove = 1;
+ }
+
+ if ($sym =~ s/://)
+ {
+ my $sub_tag = $so_far->{$sym};
+ die "Tried to use an unknown tag '$sym'" unless defined($sub_tag);
+
+ @symbols = @{$sub_tag};
+ }
+ else
+ {
+ @symbols = ($sym);
+ }
+
+ if ($remove)
+ {
+ delete @this_tag{@symbols};
+ }
+ else
+ {
+ @this_tag{@symbols} = ();
+ }
+ }
+
+ return keys %this_tag;
+}
+
# Default methods
sub export_fail {
@@ -99,6 +267,13 @@
In module YourModule.pm:
package YourModule;
+ use Exporter (
+ OK => [ 'munge', 'frobnicate' ] # symbols to export on request
+ );
+
+or the old way
+
+ package YourModule;
require Exporter;
@ISA = qw(Exporter);
@EXPORT_OK = qw(munge frobnicate); # symbols to export on request
@@ -124,6 +299,12 @@
=head2 How to Export
+There are two ways to export you can set C<@EXPORT>, C<EXPORT_OK> and so on
+by hand use C<require Exporter> or you can use C<use Expoerter (ARGS)> to
+avoid setting the variables by hand.
+
+=head3 How to Export with variables
+
The arrays C<@EXPORT> and C<@EXPORT_OK> in a module hold lists of
symbols that are going to be exported into the users name space by
default, or which they can request to be exported, respectively. The
@@ -137,6 +318,84 @@
If you are only exporting function names it is recommended to omit the
ampersand, as the implementation is faster this way.
+=head3 How to Export with use
+
+When you C<use Exporter> you don't have worry about setting C<@ISA> or
+setting arrays or hashes, you simply pass in an array of key-value pairs.
+These will be used to set up the C<@EXPORT>, C<@EXPORT_OK>, C<%EXPORT_TAGS>
+and C<@EXPORT_FAIL> variables. You can also define your tags in terms of
+previous other tags. For example
+
+ use Exporter (
+ EXPORT => [qw( init )],
+ TAGS => [
+ base => [qw( open close )],
+ read => [qw( read sysread readline )],
+ write => [qw( print write writeline )],
+ misc => [qw( select flush )],
+ all => [qw( :base :read :write :misc)],
+ no_misc => [qw( :all !:misc )],
+ ],
+ OK => [qw( some other stuff )],
+ );
+
+The following keys are available.
+
+=over 4
+
+=item EXPORT
+
+The value should be a reference to a list of symbol names and tags. The tags
+will be expanded and the resulting list of symbol names will be placed in
+the C<@EXPORT> array in your package.
+
+=item FAIL
+
+The value should be a reference to a list of symbol names and tags. The tags
+will be expanded and the resulting list of symbol names will be placed in
+the C<@EXPORT_FAIL> array in your package.
+
+=item TAGS
+
+The value should be a reference to a list that goes like (TAG_NAME,
+TAG_VALUE, TAG_NAME, TAG_VALUE, ...), where TAG_NAME is a string and
+TAG_VALUE is a reference to an array of symbols and tags. For example
+
+ TAGS => [
+ file => [ 'open', 'close', 'read', 'write'],
+ string => [ 'length', 'substr', 'chomp' ],
+ hash => [ 'keys', 'values', 'each' ],
+ all => [ ':file', ':string', ':hash' ],
+ some => [':all', '!open', ':hash'],
+ ]
+
+This is used to fill the C<%EXPORT_TAGS> in your package. You can build tags
+from other tags - in the example above the tag C<all> will contain all the
+symbols from C<file>, C<string> and C<hash>. You can also subtract symbols
+and tags - in the example above, C<some> contains the symbols from all but
+with C<open> removed and all the symbols from C<hash> removed.
+
+The rule is that any symbol starting with a ':' is taken to be a tag which
+has been defined previously (if it's not defined you'll get an error). If a
+symbol is preceded by a '!' it will be subtracted from the list, otherwise
+it is added.
+
+If you try to redefine a tag you will also get an error.
+
+All the symbols which occur while building the tags are automatically added
+your package's C<@EXPORT_OK> array.
+
+=item OK
+
+The value should be a reference to a list of symbols names. These symbol
+names (along with any that occur in the C<TAGS> will be places in the
+C<@EXPORT_OK> array in your package.
+
+=item ALL
+
+The value should be the name of tag that doesn't yet exist. This tag will
+contain a list of all symbols which can be exported.
+
=head2 Selecting What To Export
Do B<not> export method names!
@@ -335,6 +594,8 @@
=head2 Tag Handling Utility Functions
+NOTE: these are only needed if you used the old "require" way of using
Exporter.
+
Since the symbols listed within %EXPORT_TAGS must also appear in either
@EXPORT or @EXPORT_OK, two utility functions are provided which allow
you to easily add tagged sets of symbols to @EXPORT or @EXPORT_OK:
@@ -351,6 +612,8 @@
=head2 Generating combined tags
+NOTE: these are only needed if you used the old "require" way of using
Exporter.
+
If several symbol categories exist in %EXPORT_TAGS, it's usually
useful to create the utility ":all" to simplify "use" statements.
--- perl-5.8.0/lib/Exporter.t.orig 2003-02-11 15:07:25.000000000 +0000
+++ perl-5.8.0/lib/Exporter.t 2003-02-11 16:36:45.000000000 +0000
@@ -20,8 +20,27 @@
return $ok;
}
+sub cmp_array ($$)
+{
+ my ($a1, $a2) = @_;
+
+ if ($#$a1 != $#$a2)
+ {
+ print "Different lengths, $#$a1 vs $#$a2\n";
+ return 0;
+ }
+ for (my $i=0; $i <= $#$a1; $i++)
+ {
+ if ($a1->[$i] ne $a2->[$i])
+ {
+ print "difference at $i '$a1->[$i]' ne '$a2->[$i]'\n";
+ return 0;
+ }
+ }
+ return 1;
+}
-print "1..26\n";
+print "1..49\n";
require Exporter;
ok( 1, 'Exporter compiled' );
@@ -196,3 +215,157 @@
Moving::Target->import (bar);
::ok (bar eq "bar", "imported bar after EXPORT_OK changed");
+
+package Start::Testing::Use::Functions;
+
+::ok(
+ ::cmp_array(
+ [sort (Exporter::_expand_tags([qw( a b c)], {})) ],
+ [qw( a b c)],
+ ),
+ "simple _expand_tags"
+);
+
+::ok(
+ ::cmp_array(
+ [sort (Exporter::_expand_tags([qw( a b c !b)], {})) ],
+ [qw( a c )],
+ ),
+ "simple _expand_tags with remove"
+);
+
+::ok(
+ ::cmp_array(
+ [
+ sort (
+ Exporter::_expand_tags(
+ [qw( a b c :tag2 )],
+ {
+ tag2 => [ qw( d e ) ] ,
+ }
+ )
+ )
+ ],
+ [qw( a b c d e )],
+ ),
+ "_expand_tags with tag"
+);
+
+::ok(
+ ::cmp_array(
+ [
+ sort (
+ Exporter::_expand_tags(
+ [qw( a b c d f !:tag2 )],
+ {
+ tag2 => [ qw( d e ) ] ,
+ }
+ )
+ )
+ ],
+ [qw( a b c f )],
+ ),
+ "_expand_tags with remove tag"
+);
+
+my $tags = Exporter::_build_all_tags(
+ [
+ tag1 => [qw( a b c d )],
+ tag2 => [qw( c d e )],
+ tag3 => [qw( :tag1 !:tag2 d !a )],
+ ]
+);
+
+::ok(::cmp_array([sort @{$tags->{tag1}}], [qw( a b c d )]), "_build_all_tags
tag1");
+::ok(::cmp_array([sort @{$tags->{tag2}}], [qw( c d e )]), "_build_all_tags
tag2");
+::ok(::cmp_array([sort @{$tags->{tag3}}], [qw( b d )]), "_build_all_tags
tag3");
+::ok(keys(%$tags) == 3, "use TAGS count");
+
+package Test::The::Use1;
+
+use Exporter (
+ OK => [qw( o_1 o_2) ],
+);
+
+use vars qw( @EXPORT @EXPORT_FAIL @EXPORT_OK @EXPORT_TAGS );
+
+::ok(::cmp_array([sort @EXPORT_OK], [sort qw( o_1 o_2 )]), "simple use OK");
+
+package Test::The::Use2;
+
+use Exporter (
+ EXPORT => [ qw( e_1 e_2 ) ],
+ FAIL => [qw( f_1 f_2) ],
+ OK => [qw( o_1 o_2) ],
+);
+
+use vars qw( @EXPORT @EXPORT_FAIL @EXPORT_OK @EXPORT_TAGS );
+
+::ok(::cmp_array([sort @EXPORT], [sort qw( e_1 e_2)]), "use EXPORT");
+::ok(::cmp_array([sort @EXPORT_FAIL], [sort qw( f_1 f_2)]), "use FAIL");
+::ok(::cmp_array([sort @EXPORT_OK], [sort qw( e_1 e_2 o_1 o_2 )]), "use OK
with EXPORT");
+::ok(::cmp_array(\@EXPORT_TAGS, []), "use without TAGS");
+
+package Test::The::Use3;
+
+use Exporter (
+ EXPORT => [ qw( e_1 e_2 ) ],
+ TAGS => [
+ tag1 => [qw( a b c d e f )],
+ tag2 => [qw( b d f )],
+ tag3 => [qw( :tag1 !:tag2 )],
+ ],
+ OK => [qw( o_1 o_2) ],
+);
+
+use vars qw( @EXPORT @EXPORT_OK %EXPORT_TAGS );
+
+::ok(::cmp_array([sort @EXPORT], [sort qw( e_1 e_2)]), "use EXPORT and
TAGS");
+::ok(
+ ::cmp_array(
+ [sort @EXPORT_OK],
+ [sort qw( e_1 e_2 a b c d e f o_1 o_2 )]
+ ),
+ "use OK with EXPORT and TAGS"
+);
+
+my %e = %EXPORT_TAGS;
+
+::ok(::cmp_array([sort @{$e{tag1}}], [qw( a b c d e f )]), "use TAGS tag1");
+::ok(::cmp_array([sort @{$e{tag2}}], [qw( b d f )]), "use TAGS tag2");
+::ok(::cmp_array([sort @{$e{tag3}}], [qw( a c e )]), "use TAGS tag3");
+::ok(keys(%e) == 3, "use TAGS count");
+
+package Test::The::Use4;
+
+use Exporter (
+ EXPORT => [qw( open close :rw )],
+ FAIL => [qw( hello :fail )],
+ TAGS => [
+ fail => [qw (f_1 f_2 )],
+ rw => [qw( read write )],
+ sys => [qw( sysopen sysclose )],
+ ],
+ ALL => 'all',
+);
+
+use vars qw( @EXPORT @EXPORT_FAIL %EXPORT_TAGS );
+
+::ok(::cmp_array([sort @EXPORT], [sort qw( open close read write)]), "use
tags in EXPORT");
+::ok(::cmp_array([sort @EXPORT_FAIL], [sort qw( hello f_1 f_2 )]), "use tags
in EXPORT");
+::ok(::cmp_array
+ (
+ [sort @{$EXPORT_TAGS{all}}],
+ [sort qw( open close read write sysopen sysclose )]
+ ), "use ALL with FAIL");
+
+
+package Test::The::Use5;
+
+eval <<EOM;
+use Exporter (
+ EXPORT => [qw( :tag )],
+);
+EOM
+
+::ok($@, "die for unknown tag");
Thread Next
-
[PATCH] making Exporter simpler to use
by Fergal Daly