Exporter-Easy-0.16/0040755000076400007640000000000010103767556013457 5ustar fergalfergalExporter-Easy-0.16/CHANGES0100644000076400007640000000203210100546071014424 0ustar fergalfergal0.16 Fixed Exporter::Easiest so that it automatically does the use vars, the problem was that I was not using the magic goto so the vars were being used in the wrong package. Factored out some code in the vars tests. 0.15 changed the processing order and documented it FAIL symbols are now added to EXPORT_OK Fixed bug, ":" now is anchored to start of string for tag detection is Easiest Optimised expand_tags a little by specialising the add/delete code for the tag and non-tag cases. 0.14 some slight optimistaions no longer subtracting the FAIL from OK more helpful errors messages added benchmark 0.13 I should have fixed Easiest to work with ALL as weel as VARS and ISA, done now Doc fixes 0.12 Fixed Easiest to handle scalar values for VARS and ISA 0.11 No longer need to use TAGS in Easiest Added ISA control No longer including EXPORT in EXPORT_OK Added OK_ONLY, which means only these symbols go in EXPORT_OK Added VARS control. Now no longer need to explicitly use vars for exportable variables 0.1 initial release Exporter-Easy-0.16/META.yml0100644000076400007640000000047010103767556014726 0ustar fergalfergal# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Exporter-Easy version: 0.16 version_from: ./lib/Exporter/Easy.pm installdirs: perl requires: distribution_type: module generated_by: ExtUtils::MakeMaker version 6.17 Exporter-Easy-0.16/t/0040755000076400007640000000000010103767556013722 5ustar fergalfergalExporter-Easy-0.16/t/Run.pm0100644000076400007640000000106010100545146015000 0ustar fergalfergaluse strict; use warnings; sub run_it { my ($code) = @_; my $pkg = caller(1); eval "package $pkg;$code"; my $ok = $@ ? 0 : 1; return ($ok, $@); } sub runs_ok { local($Test::Builder::Level) = $Test::Builder::Level + 1; my ($code, $name) = @_; my ($ok, $err) = run_it($code); ok($ok, $name) || diag("eval died with $err"); return $ok; } sub dies_ok { local($Test::Builder::Level) = $Test::Builder::Level + 1; my ($code, $name) = @_; my ($ok, $err) = run_it($code); ok(!$ok, $name) || diag("$code executed successfully"); return !$ok; } 1; Exporter-Easy-0.16/t/Easiest.t0100644000076400007640000000446410103767541015503 0ustar fergalfergaluse strict; use Test::More tests => 21; use lib 't'; use Run; require_ok('Exporter::Easiest'); { no strict 'refs'; *{suck_list} = \&Exporter::Easiest::suck_list; *{parse_spec} = \&Exporter::Easiest::parse_spec; } is_deeply(suck_list([qw(a b c d e)]), [qw( a b c d e )], "suck all"); is_deeply(suck_list([qw(a b c => e)]), [qw( a b )], "suck some"); is_deeply( { parse_spec(q( a => a b c )) }, { a => [qw( a b c )], }, "parse 1" ); is_deeply( { parse_spec(q( a => a b c b => g h i )) }, { a => [qw( a b c )], b => [qw( g h i )], }, "parse 2" ); is_deeply( { parse_spec(q( a => b => g h i )) }, { a => [], b => [qw( g h i )], }, "parse with empty" ); is_deeply( { parse_spec(q( a => :b => a b :c :e => e f g )) }, { a => [], TAGS => [ 'b', [qw( a b :c )], 'e', [qw( e f g )], ] }, "simple with :s" ); is_deeply( { parse_spec(q( b => a b a => :b => :e => e f :g :d => a c => a :c )) }, { a => [], TAGS => [ 'b', [], 'e', [qw( e f :g )], 'd' => ['a'], ], b => [qw( a b )], c => [qw( a :c)], }, "everything" ); is_deeply( { parse_spec(q(VARS => a b)) }, { VARS => [qw( a b )] }, "VARS list" ); is_deeply( { parse_spec(q(VARS => a)) }, { VARS => [qw( a )] }, "VARS list of 1" ); is_deeply( { parse_spec(q(VARS => 1)) }, { VARS => 1 }, "VARS 1" ); is_deeply( { parse_spec(q(VARS => 0)) }, { VARS => 0 }, "VARS 0" ); is_deeply( { parse_spec(q(ALL => all)) }, { ALL => 'all' }, "good ALL works" ); eval {parse_spec(q(ALL => all other))}; ok($@, "bad all dies"); package Test::The::Use; use Exporter::Easiest q( EXPORT => e_1 e_2 TAGS => :tag1 => a b c d e f :tag2 => b d f :tag3 => :tag1 !:tag2 OK => o_1 o_2 ); use vars qw( @EXPORT @EXPORT_OK %EXPORT_TAGS ); ::ok(::eq_set( \@EXPORT, [ qw( e_1 e_2)] ), "use EXPORT and TAGS"); ::ok(::eq_set( \@EXPORT_OK ,[qw( a b c d e f o_1 o_2 )] ), "use OK with EXPORT and TAGS" ); my %e = %EXPORT_TAGS; ::ok(::eq_set( $e{tag1}, [qw( a b c d e f )] ), "use TAGS tag1"); ::ok(::eq_set( $e{tag2}, [qw( b d f )] ), "use TAGS tag2"); ::ok(::eq_set( $e{tag3}, [qw( a c e )] ), "use TAGS tag3"); ::ok(keys(%e) == 3, "use TAGS count"); package Test::Vars; use Exporter::Easiest qw( OK => $Var ); ::runs_ok('$Var', 'tag vars can use var $Var'); Exporter-Easy-0.16/t/Easy.t0100644000076400007640000001261210100545257014774 0ustar fergalfergaluse strict; use Test::More tests => 51; use lib 't'; use Run; require_ok('Exporter::Easy'); package Start::Testing::Use::Functions; { no strict 'refs'; *{add_tags} = \&Exporter::Easy::add_tags; *{expand_tags} = \&Exporter::Easy::expand_tags; } ::ok( ::eq_set( [ expand_tags([qw( a b c)], {}) ], [ qw( a b c) ] ), "simple _expand_tags" ); ::ok( ::eq_set( [ expand_tags([qw( a b c !b)], {}) ], [ qw( a c ) ] ), "simple _expand_tags with remove" ); ::ok( ::eq_set( [ expand_tags([ qw( a b c :tag2 ) ], { tag2 => [ qw( d e ) ] }), ], [qw( a b c d e )], ), "_expand_tags with tag" ); ::ok( ::eq_set( [ 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 = add_tags( [ tag1 => [qw( a b c d )], tag2 => [qw( c d e )], tag3 => [qw( :tag1 !:tag2 d !a )], ] ); ::ok(::eq_set( $tags->{tag1}, [qw( a b c d )] ), "_build_all_tags tag1"); ::ok(::eq_set( $tags->{tag2}, [qw( c d e )] ), "_build_all_tags tag2"); ::ok(::eq_set( $tags->{tag3}, [qw( b d )] ), "_build_all_tags tag3"); ::ok(keys(%$tags) == 3, "use TAGS count"); package Use::OK; use Exporter::Easy ( OK => [qw( o_1 o_2) ], ); use vars qw( @EXPORT_OK ); ::ok(::eq_set(\@EXPORT_OK, [qw( o_1 o_2 )]), "simple use OK"); package Use::OK_ONLY; use Exporter::Easy ( OK_ONLY => [qw( o_1 o_2 ) ], ); use vars qw( @EXPORT_OK ); ::ok(::eq_set(\@EXPORT_OK, [qw( o_1 o_2 )]), "simple use OK_ONLY"); package Use::More; use Exporter::Easy ( EXPORT => [ qw( e_1 e_2 ) ], FAIL => [qw( f_1 f_2) ], OK_ONLY => [qw( o_1 o_2) ], ); use vars qw( @EXPORT @EXPORT_FAIL @EXPORT_OK %EXPORT_TAGS ); ::ok(::eq_set( \@EXPORT, [qw( e_1 e_2)] ), "use EXPORT"); ::ok(::eq_set( \@EXPORT_FAIL, [qw( f_1 f_2)] ), "use FAIL"); ::ok(::eq_set( \@EXPORT_OK, [qw( o_1 o_2 )] ), "use OK_ONLY with EXPORT"); ::is_deeply(\%EXPORT_TAGS, {}, "use without TAGS"); package Use::TAGS::And::OK_ONLY; use Exporter::Easy ( 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_ONLY => [qw( o_1 o_2) ], ); use vars qw( @EXPORT @EXPORT_OK %EXPORT_TAGS ); ::ok(::eq_set( \@EXPORT, [ qw( e_1 e_2)] ), "use EXPORT and TAGS"); ::ok(::eq_set( \@EXPORT_OK ,[qw( o_1 o_2 )] ), "use OK_ONLY with EXPORT and TAGS" ); { my %e = %EXPORT_TAGS; ::ok(::eq_set( $e{tag1}, [qw( a b c d e f )] ), "use TAGS tag1"); ::ok(::eq_set( $e{tag2}, [qw( b d f )] ), "use TAGS tag2"); ::ok(::eq_set( $e{tag3}, [qw( a c e )] ), "use TAGS tag3"); ::ok(keys(%e) == 3, "use TAGS count"); } package Test::The::Use3; use Exporter::Easy ( 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(::eq_set( \@EXPORT, [ qw( e_1 e_2)] ), "use EXPORT and TAGS"); ::ok(::eq_set( \@EXPORT_OK ,[qw( a b c d e f o_1 o_2 )] ), "use OK with EXPORT and TAGS" ); { my %e = %EXPORT_TAGS; ::ok(::eq_set( $e{tag1}, [qw( a b c d e f )] ), "use TAGS tag1"); ::ok(::eq_set( $e{tag2}, [qw( b d f )] ), "use TAGS tag2"); ::ok(::eq_set( $e{tag3}, [qw( a c e )] ), "use TAGS tag3"); ::ok(keys(%e) == 3, "use TAGS count"); } package Test::The::Use4; use Exporter::Easy ( 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_OK @EXPORT_FAIL %EXPORT_TAGS ); ::ok(::eq_set( \@EXPORT, [qw( open close read write)] ), "use tags in EXPORT"); ::ok(::eq_set( \@EXPORT_OK, [qw( hello f_1 f_2 sysopen sysclose read write )]) , "use FAIL in EXPORT_OK"); ::ok(::eq_set( \@EXPORT_FAIL, [qw( hello f_1 f_2 )] ), "use tags in EXPORT"); ::ok(::eq_set( $EXPORT_TAGS{all}, [qw( hello f_1 f_2 read write sysopen sysclose open close )] ), "use ALL with FAIL"); package Test::The::Use5; eval < [qw( :tag )], ); EOM ::ok($@, "die for unknown tag"); package Test::ISA::Default; use base 'base'; use vars '@ISA'; use Exporter::Easy(ALL => 'all'); ::is_deeply(\@ISA, ['base','Exporter'], '@ISA default'); package Test::ISA::Explicit; use base 'base'; use vars '@ISA'; use Exporter::Easy( ISA => 1, ); ::is_deeply(\@ISA, ['base','Exporter'], '@ISA explicit'); package Test::ISA::No; use base 'base'; use vars '@ISA'; use Exporter::Easy( ISA => 0, ); ::is_deeply(\@ISA, ['base'], 'no @ISA explicit'); package Test::Vars; use Exporter::Easy( TAGS => [ var => [qw( $hello @hello %hello a )], not => [qw( $goodbye @goodbye %goodbye b )], ], ); foreach my $type (qw( $ @ % )) { ::runs_ok("${type}\{hello}", "tag vars can use var ${type}hello"); ::runs_ok("${type}\{goodbye}", "tag vars can't use var ${type}goodbye"); } package Test::Vars::List; use Exporter::Easy( TAGS => [ var => [qw( $hello @hello %hello a )], not => [qw( $goodbye @goodbye %goodbye a )], ], VARS => [':var', '$cat'], ); foreach my $type (qw( $ @ % )) { ::runs_ok("${type}\{hello}", "list vars can use var ${type}hello"); ::dies_ok("${type}\{goodbye}", "list vars can't use var ${type}goodbye"); } ::runs_ok('$cat', 'list vars can use var $cat'); package Test::Vars::Fail; use Exporter::Easy( TAGS => [ not => [qw( $goodbye @goodbye %goodbye )], ], VARS => 0, ); foreach my $type (qw( $ @ % )) { ::dies_ok("${type}\{goodbye}", "no vars can't use var ${type}goodbye"); } Exporter-Easy-0.16/lib/0040755000076400007640000000000010103767556014225 5ustar fergalfergalExporter-Easy-0.16/lib/Exporter/0040755000076400007640000000000010103767556016035 5ustar fergalfergalExporter-Easy-0.16/lib/Exporter/Easy.pm0100644000076400007640000002507110100544766017267 0ustar fergalfergal# $Header: /home/fergal/my/cvs/Exporter-Easy/lib/Exporter/Easy.pm,v 1.24 2003/02/14 16:53:20 fergal Exp $ use strict; package Exporter::Easy; require 5.006; require Exporter; use vars; our $VERSION = '0.16'; sub import { my $pkg = shift; unshift(@_, scalar caller); # must goto or we lose the use vars functionality goto &set_export_vars; } 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, %args) = @_; my %could_export; # symbols that could be exported my @will_export; # symbols that will be exported by default my @fail; # symbols that should be tested before export my @ok_only; # the symbols that are ok to export my %tags; # will contain a ref hash of all tags @_ = (); # we'll be using this for vars to be use vars'd if ($args{OK_ONLY} and $args{OK}) { nice_die("Can't use OK_ONLY and OK together"); } my $isa = exists $args{ISA} ? delete $args{ISA} : 1; my $vars = exists $args{VARS} ? delete $args{VARS} : 1; if (my $tag_data = delete $args{'TAGS'}) { nice_die("TAGS must be a reference to an array") unless ref($tag_data) eq 'ARRAY'; add_tags($tag_data, \%tags); @could_export{map {@$_} values %tags} = (); } if (my $export = delete $args{'EXPORT'}) { nice_die("EXPORT must be a reference to an array") unless ref($export) eq 'ARRAY'; @will_export = eval { expand_tags($export, \%tags) }; nice_die("$@while building the EXPORT list in $callpkg") if $@; } if (my $ok = delete $args{'OK'}) { nice_die("OK must be a reference to a array") unless ref($ok) eq 'ARRAY'; my @ok = eval { expand_tags($ok, \%tags) }; nice_die("$@while building the \@EXPORT_OK") if $@; @could_export{@ok} = (); } my $ok_only = delete $args{'OK_ONLY'}; if ($ok_only) { die("OK_ONLY must be a reference to a array") unless ref($ok_only) eq 'ARRAY'; @ok_only = eval { expand_tags($ok_only, \%tags) }; nice_die("$@while building the OK_ONLY list") if $@; @could_export{@ok_only} = (); } if (my $fail = delete $args{'FAIL'}) { die "FAIL must be a reference to an array" unless ref($fail) eq 'ARRAY'; @fail = eval { expand_tags($fail, \%tags) }; nice_die("$@while building \@EXPORT_FAIL") if $@; @could_export{@fail} = (); } my @could_export = keys %could_export; if (defined(my $all = delete $args{'ALL'})) { nice_die("No name supplied for ALL") unless length($all); nice_die("Cannot use '$all' for ALL, already exists") if exists $tags{$all}; my %all; @all{@could_export, @will_export} = (); $tags{$all} = [keys %all]; } if ($vars) { if (my $ref = ref($vars)) { nice_die("VARS was a reference to a ".$ref." instead of an array") unless $ref eq 'ARRAY'; @_ = ('vars', grep /^(?:\$|\@|\%)/, eval { expand_tags($vars, \%tags) }); nice_die("$@while building the \@EXPORT") if $@; } else { @_ = ('vars', grep /^(?:\$|\@|\%)/, @will_export, @could_export); } } if (%args) { nice_die("Attempt to use unknown keys: ", join(", ", keys %args)); } no strict 'refs'; if ($isa) { push(@{"$callpkg\::ISA"}, "Exporter"); } @{"$callpkg\::EXPORT"} = @will_export if @will_export; %{"$callpkg\::EXPORT_TAGS"} = %tags if %tags; @{"$callpkg\::EXPORT_OK"} = $ok_only ? @ok_only : @could_export; @{"$callpkg\::EXPORT_FAIL"} = @fail if @fail; if (@_ > 1) { goto &vars::import; } } sub nice_die { my $msg = shift; my $level = shift || 1; my ($pkg, $file, $line) = caller(1); die "$msg at $file line $line\n"; } sub add_tags($;$) { # this takes a reference to tag data and an optional reference to a hash # of already exiting tags. If no hash ref is supplied then it creates an # empty one # It adds the tags from the tag data to the hash ref. my $tag_data = shift; my $tags = shift || {}; my @tag_data = @$tag_data; while (@tag_data) { my $tag_name = shift @tag_data || 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->{$tag_name}); my $tag_list = shift @tag_data || 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) }; die "$@while building tag '$tag_name'" if $@; $tags->{$tag_name} = \@symbols; } return $tags; } 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); if ($remove) { delete @this_tag{@$sub_tag} } else { @this_tag{@$sub_tag} = (); } } else { if ($remove) { delete $this_tag{$sym}; } else { $this_tag{$sym} = undef; } } } return keys %this_tag; } 1; __END__ =head1 NAME Exporter::Easy - Takes the drudgery out of Exporting symbols =head1 SYNOPSIS In module YourModule.pm: package YourModule; use Exporter::Easy ( OK => [ '$munge', 'frobnicate' ] # symbols to export on request ); In other files which wish to use YourModule: use ModuleName qw(frobnicate); # import listed symbols frobnicate ($left, $right) # calls YourModule::frobnicate =head1 DESCRIPTION Exporter::Easy makes using Exporter easy. In it's simplest case it allows you to drop the boilerplate code that comes with using Exporter, so require Exporter; use base qw( Exporter ); use vars qw( @EXPORT ); @EXPORT = ( 'init' ); becomes use Exporter::Easy ( EXPORT => [ 'init' ] ); and more complicated situations where you use tags to build lists and more tags become easy, like this use Exporter::Easy ( EXPORT => [qw( init :base )], 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 )], ); This will set C<@EXPORT>, C<@EXPORT_OK>, C<@EXPORT_FAIL> and C<%EXPORT_TAGS> in the current package, add Exporter to that package's C<@ISA> and do a C on all the variables mentioned. The rest is handled as normal by Exporter. =head1 HOW TO USE IT Put use Exporter::Easy ( KEY => value, ...); in your package. Arguments are passes as key-value pairs, the following keys are available =over 4 =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 will contain all the symbols from C, C and C. You can also subtract symbols and tags - in the example above, C contains the symbols from all but with C removed and all the symbols from C 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 and tags (which will be exapanded). These symbols will be added to the C<@EXPORT_OK> array in your package. Using OK and and OK_ONLY together will give an error. =item OK_ONLY The value should be a reference to a list of symbols and tags (which will be exapanded). The C<@EXPORT_OK> array in your package will contains only these symbols.. This totally overrides the automatic population of this array. If you just want to add some symbols to the list that Exporter::Easy has automatically built then you should use OK instead. Using OK_ONLY and OK together will give an error. =item EXPORT The value should be a reference to a list of symbol names and tags. Any tags will be expanded and the resulting list of symbol names will be placed in the C<@EXPORT> array in your package. The tag created by the ALL key is not available at this stage. =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. They will also be added to the C<@EXPORT_OK> list. =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. =item ISA If you set this to 0 then Exporter will not be added to your C<@ISA> list. =item VARS If this is set to 1 or not provided then all $, @ and % variables mentioned previously will be available to use in your package as if you had done a C on them. If it's set to a reference to a list of symbols and tags then only those symbols will be available. If it's set to 0 then you'll have to do your own C in your package. =back =head1 PROCESSING ORDER We need take the information provided and build @EXPORT, @EXPORT_OK, @EXPORT_FAIL and %EXPORT_TAGS in the calling package. We may also need to build a tag with all of the symbols and to make all the variables useable under strict. The arguments are processed in the following order: TAGS, EXPORT, OK, OK_ONLY and FAIL, ALL, VARS and finally ISA. This means you cannot use the tag created by ALL anywhere except in VARS (although vars defaults to using all symbols anyway). =head1 SEE ALSO For details on what all these arrays and hashes actually do, see the Exporter documentation. =head1 AUTHOR Written by Fergal Daly . =head1 LICENSE Under the same license as Perl itself =cut Exporter-Easy-0.16/lib/Exporter/Easiest.pm0100644000076400007640000000564710100544726017766 0ustar fergalfergal# $Header: /home/fergal/my/cvs/Exporter-Easy/lib/Exporter/Easiest.pm,v 1.5 2003/02/13 13:09:15 fergal Exp $ # Be lean. use strict; no strict 'refs'; package Exporter::Easiest; require 5.006; require Exporter::Easy; sub import { my $pkg = shift; my $callpkg = caller(0); @_ = ($callpkg, parse_spec(@_)); goto &Exporter::Easy::set_export_vars; } sub parse_spec { # maybe we were passed a string or an array of strings, allow both my @spec = grep { /\S/ } map { split(/\s+/) } @_; my %spec; my $key = ""; while (@spec) { my $new_key = shift @spec; my $arrow = shift @spec; $arrow = "" unless defined($arrow); die "Expected '=>' not '$arrow' after $new_key" unless ($arrow eq '=>'); if ($new_key =~ s/^://) { # if the new key starts with a : then it and the following list are # pushed onto the TAGS entry push(@{$spec{TAGS}}, $new_key, suck_list(\@spec)); } else { $key = $new_key; # VARS and ISA should aren't necessarily a list if( ($key =~ /^(VARS|ISA)$/ and $spec[0] =~ /^\d+$/) or ($key eq 'ALL') ) { $spec{$key} = shift @spec; } else { $spec{$key} = suck_list(\@spec); } } } return %spec; } sub suck_list { # takes a ref to a list and removes elements from the front of the list # until the list is empty or it's 2 shift away from removing a => # returns a ref to a list of the removed list elements my $list = shift; my @sucked; while (@$list) { if ($#$list and ($list->[1] eq '=>')) { last; } else { push(@sucked, shift(@$list)); } } return \@sucked; } =head1 NAME Exporter::Easiest - Takes even more drudgery out of Exporting symbols =head1 SYNOPSIS In module YourModule.pm: package YourModule; use Exporter::Easiest q( EXPORT => :tag1 OK => munge frobnicate :tag1 => a b c :tag2 => :tag1 d e f FAIL => f g h ); In other files which wish to use YourModule: use ModuleName qw(frobnicate); # import listed symbols frobnicate ($left, $right) # calls YourModule::frobnicate =head1 DESCRIPTION The Exporter::Easiest module is a wrapper around Exporter::Easy. It allows you to pass the arguments into Exporter::Easy without all those tiresome []s and qw()s. You pass arguments in as a string or an array of strings. You no longer need to bracket lists or take references. If want, you can also leave out the TAGS key and just put tag definitions along with the other keys. The important thing to remember is that tags should be preceded by ':' everywhere, including to the left of the '=>', otherwise it'll get confused. And don't worry I haven't done something horribly pythonesque, whitespace is not significant, all the parsing logic revolves around the use of ':'s and '=>'s =head1 SEE ALSO For the real details on exporting symbols see Exporter and Exporter::Easy =head1 AUTHOR Written by Fergal Daly . =head1 LICENSE Under the same license as Perl itself =cut Exporter-Easy-0.16/MANIFEST0100644000076400007640000000031110100546111014553 0ustar fergalfergalbench CHANGES lib/Exporter/Easiest.pm lib/Exporter/Easy.pm Makefile.PL MANIFEST README t/Easiest.t t/Easy.t t/Run.pm TODO META.yml Module meta-data (added by MakeMaker) Exporter-Easy-0.16/TODO0100644000076400007640000000015607622730253014142 0ustar fergalfergal* add level ? * test all the dies * think some more about whether to delete FAIL * refine errors for lists Exporter-Easy-0.16/bench0100755000076400007640000000552407623231164014461 0ustar fergalfergal#! /usr/bin/perl use strict; use lib 'lib'; use Benchmark qw(cmpthese); require Exporter::Easy; use vars; my $file_bms = { new => '', old => '', }; my $simple_bms = { old_simple => <<'EOM', our(@EXPORT) = qw(getservbyname getservbyport getservent getserv); our @ISA = ('Exporter'); EOM new_simple => <<'EOM', use Exporter::Easy( EXPORT => [qw(getservbyname getservbyport getservent getserv)], ); EOM }; my $vars_bms = { old_our_vars => <<'EOM', our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS, @ISA); @ISA = ('Exporter'); @EXPORT = qw(getservbyname getservbyport getservent getserv); @EXPORT_OK = qw( $s_name @s_aliases $s_port $s_proto ); %EXPORT_TAGS = (FIELDS => [ @EXPORT_OK, @EXPORT ] ); our ($s_name, @s_aliases, $s_port, $sx_proto); EOM old_use_vars => <<'EOM', our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS, @ISA); @ISA = ('Exporter'); @EXPORT = qw(getservbyname getservbyport getservent getserv); @EXPORT_OK = qw( $s_name @s_aliases $s_port $s_proto ); %EXPORT_TAGS = (FIELDS => [ @EXPORT_OK, @EXPORT ] ); use vars @EXPORT_OK; EOM old_grep_vars => <<'EOM', our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS, @ISA); @ISA = ('Exporter'); @EXPORT = qw(getservbyname getservbyport getservent getserv); @EXPORT_OK = qw( $s_name @s_aliases $s_port $s_proto ); %EXPORT_TAGS = (FIELDS => [ @EXPORT_OK, @EXPORT ] ); use vars grep /^\$/, @EXPORT_OK; EOM new_vars => <<'EOM', use Exporter::Easy( EXPORT => [qw(getservbyname getservbyport getservent getserv)], OK => [qw( $s_name @s_aliases $s_port $s_proto )], ALL => 'FIELDS', ); EOM }; my $no_vars_bms = { old_no_vars => <<'EOM', our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS, @ISA); @ISA = ('Exporter'); @EXPORT = qw(getservbyname getservbyport getservent getserv); @EXPORT_OK = qw( $s_name @s_aliases $s_port $s_proto ); %EXPORT_TAGS = (FIELDS => [ @EXPORT_OK, @EXPORT ] ); EOM new_no_vars => <<'EOM', use Exporter::Easy( EXPORT => [qw(getservbyname getservbyport getservent getserv)], OK => [qw( $s_name @s_aliases $s_port $s_proto )], ALL => 'FIELDS', VARS => 0, ); EOM }; my @bms = ( $file_bms, $vars_bms, $no_vars_bms, $simple_bms, ); my @comps; foreach my $bm (@bms) { foreach my $want_files ( '', # '_file' ) { my %comp; while (my ($name, $code) = (each %$bm)) { $comp{"$name$want_files"} = make_bm("$name$want_files", $code, $want_files); } push(@comps, \%comp); } } my $time = -2; foreach my $bm (@comps) { cmpthese($time, $bm); } sub make_bm { my ($name, $code, $want_files) = @_; my @files; if ($want_files) { @files = ('lib/Exporter.pm'); if ($name =~ /^new/) { push(@files, 'lib/Exporter/Easy.pm'); } else { } } my @file_code = map { "do '$_';" } @files; my $all_code = join("\n", @file_code, $code); eval $all_code; die "$all_code\n$@" if $@; # print "------------------$name----------------\n$all_code\n\n"; return sub { eval $all_code }; } Exporter-Easy-0.16/Makefile.PL0100644000076400007640000000043307622275460015426 0ustar fergalfergal# $Header: /home/fergal/my/cvs/Exporter-Easy/Makefile.PL,v 1.1 2003/02/11 22:37:36 fergal Exp $ use ExtUtils::MakeMaker; WriteMakefile( AUTHOR => 'Fergal Daly ', NAME => 'Exporter::Easy', VERSION_FROM => './lib/Exporter/Easy.pm', INSTALLDIRS => 'perl', ); Exporter-Easy-0.16/README0100644000076400007640000000343307622717563014344 0ustar fergalfergalEporter::Easy gets rid of the drudgery of exporting symbols allowing you to eliminate those bits of code that exists in every single module that uses Exporter. It also allows you to define tags in terms of other tags and you no longer have to worry about filling in @EXPORT_OK. So require Exporter; our @ISA = ('Exporter'); our @EXPORT = qw( open close ); becomes use Exporter::Easy(EXPORT => [qw( open close ]); and use strict; our(@EXPORT, @EXPORT_OK, %EXPORT_TAGS, @VARS, @); require Exporter; our @ISA = ('Exporter'); @EXPORT = qw(getservbyname getservbyport getservent getserv); @EXPORT_OK = qw( $s_name @s_aliases $s_port $s_proto ); %EXPORT_TAGS = (FIELDS => [ @EXPORT_OK, @EXPORT ] ); our ($s_name, @s_aliases, $s_port, $sx_proto); $s_port = 8080; becomes use strict; use Exporter::Easy( EXPORT => [qw(getservbyname getservbyport getservent getserv)], OK => [qw( $s_name @s_aliases $s_port $s_proto ]), ALL => 'FIELDS', ); $s_port = 8080; and finally this becomes possible without lots of nasty arrays use Exporter::Easy ( EXPORT => [qw( init :base )], TAGS => [ base => [qw( open close )], read => [qw( read sysread readline )], write => [qw( print write writeline )], misc => [qw( select flush )], most => [qw( :base :read :write)], no_misc => [qw( :all !:misc )], ], OK => [qw( $some $other $stuff )], ALL => 'all', ); Exporter::Easiest lets you do leave out almost all of the punctuation, so the above becomes use Exporter::Easy q( :base => open close :read => read sysread readline :write => print write writeline :misc => select flush :most => :base :read :write :no_misc => :all !:misc EXPORT => init :base OK => $some $other $stuff ALL => all ); epxorting symbols can't get any easier than this! Written by Fergal Daly