develooper 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


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About