r7236 - in /branches/upstream/libsub-exporter-perl/current: Changes MANIFEST META.yml lib/Sub/Exporter.pm lib/Sub/Exporter/Tutorial.pod lib/Sub/Exporter/Util.pm t/collection.t t/util-merge.t t/util-namemap.t
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Wed Sep 5 12:11:01 UTC 2007
Author: dmn
Date: Wed Sep 5 12:11:01 2007
New Revision: 7236
URL: http://svn.debian.org/wsvn/?sc=1&rev=7236
Log:
[svn-upgrade] Integrating new upstream version, libsub-exporter-perl (0.976)
Added:
branches/upstream/libsub-exporter-perl/current/t/util-namemap.t
Modified:
branches/upstream/libsub-exporter-perl/current/Changes
branches/upstream/libsub-exporter-perl/current/MANIFEST
branches/upstream/libsub-exporter-perl/current/META.yml
branches/upstream/libsub-exporter-perl/current/lib/Sub/Exporter.pm
branches/upstream/libsub-exporter-perl/current/lib/Sub/Exporter/Tutorial.pod
branches/upstream/libsub-exporter-perl/current/lib/Sub/Exporter/Util.pm
branches/upstream/libsub-exporter-perl/current/t/collection.t
branches/upstream/libsub-exporter-perl/current/t/util-merge.t
Modified: branches/upstream/libsub-exporter-perl/current/Changes
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-exporter-perl/current/Changes?rev=7236&op=diff
==============================================================================
--- branches/upstream/libsub-exporter-perl/current/Changes (original)
+++ branches/upstream/libsub-exporter-perl/current/Changes Wed Sep 5 12:11:01 2007
@@ -1,4 +1,11 @@
Revision history for Sub-Exporter
+
+0.976 2007-08-30
+ fixed merge_col, which was not updated to work with \name generators
+ collector hooks can now alter @_ to replace the value to be collected
+ clarify args passed to generator in Tutorial; thanks MARKSTOS
+
+ added commented-out name_map to Sub::Exporter::Util; future feature?
0.975 2007-07-04
update Tutorial to show (preferred) \'name' style for generators
Modified: branches/upstream/libsub-exporter-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-exporter-perl/current/MANIFEST?rev=7236&op=diff
==============================================================================
--- branches/upstream/libsub-exporter-perl/current/MANIFEST (original)
+++ branches/upstream/libsub-exporter-perl/current/MANIFEST Wed Sep 5 12:11:01 2007
@@ -12,8 +12,8 @@
lib/Sub/Exporter/Tutorial.pod
lib/Sub/Exporter/Util.pm
LICENSE
-MANIFEST
Makefile.PL
+MANIFEST This list of files
META.yml
README
t/collection.t
@@ -40,4 +40,5 @@
t/util-like.t
t/util-merge.t
t/util-mixin.t
+t/util-namemap.t
t/valid-config.t
Modified: branches/upstream/libsub-exporter-perl/current/META.yml
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-exporter-perl/current/META.yml?rev=7236&op=diff
==============================================================================
--- branches/upstream/libsub-exporter-perl/current/META.yml (original)
+++ branches/upstream/libsub-exporter-perl/current/META.yml Wed Sep 5 12:11:01 2007
@@ -15,4 +15,4 @@
Data::OptList: 0.1
Params::Util: 0.14
Sub::Install: 0.92
-version: 0.975
+version: 0.976
Modified: branches/upstream/libsub-exporter-perl/current/lib/Sub/Exporter.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-exporter-perl/current/lib/Sub/Exporter.pm?rev=7236&op=diff
==============================================================================
--- branches/upstream/libsub-exporter-perl/current/lib/Sub/Exporter.pm (original)
+++ branches/upstream/libsub-exporter-perl/current/lib/Sub/Exporter.pm Wed Sep 5 12:11:01 2007
@@ -14,13 +14,11 @@
=head1 VERSION
-version 0.975
-
- $Id: /my/cs/projects/Sub-Exporter/trunk/lib/Sub/Exporter.pm 31990 2007-07-06T02:33:04.864653Z rjbs $
+version 0.976
=cut
-our $VERSION = '0.975';
+our $VERSION = '0.976';
=head1 SYNOPSIS
@@ -504,8 +502,6 @@
Carp::croak "collection $name provided multiple times in import"
if $seen{ $name }++;
- $collection{ $name } = $value;
-
if (ref(my $hook = $config->{collectors}{$name})) {
my $arg = {
name => $name,
@@ -522,6 +518,8 @@
Carp::croak $error_msg unless $hook->($value, $arg);
}
}
+
+ $collection{ $name } = $value;
}
return \%collection;
Modified: branches/upstream/libsub-exporter-perl/current/lib/Sub/Exporter/Tutorial.pod
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-exporter-perl/current/lib/Sub/Exporter/Tutorial.pod?rev=7236&op=diff
==============================================================================
--- branches/upstream/libsub-exporter-perl/current/lib/Sub/Exporter/Tutorial.pod (original)
+++ branches/upstream/libsub-exporter-perl/current/lib/Sub/Exporter/Tutorial.pod Wed Sep 5 12:11:01 2007
@@ -5,7 +5,7 @@
=head1 VERSION
- $Id: /my/cs/projects/Sub-Exporter/trunk/lib/Sub/Exporter/Tutorial.pod 31962 2007-07-04T02:29:46.946587Z rjbs $
+ $Id$
=head1 DESCRIPTION
@@ -199,7 +199,7 @@
=over
-=item * the class on which the exporter was called
+=item * the invocant on which the exporter was called
=item * the name of the export being generated (not the name it's being installed as)
@@ -209,7 +209,7 @@
=back
-The third item is the last major feature that hasn't been covered.
+The fourth item is the last major feature that hasn't been covered.
=head2 Argument Collectors
@@ -231,7 +231,7 @@
use Menu::Airline allergies => [ qw(peanuts) ], ethics => [ qw(vegan) ];
...the consumer would get a salad. Also, all the generators would be passed,
-as their third argument, something like this:
+as their fourth argument, something like this:
{ allerges => [ qw(peanuts) ], ethics => [ qw(vegan) ] }
Modified: branches/upstream/libsub-exporter-perl/current/lib/Sub/Exporter/Util.pm
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-exporter-perl/current/lib/Sub/Exporter/Util.pm?rev=7236&op=diff
==============================================================================
--- branches/upstream/libsub-exporter-perl/current/lib/Sub/Exporter/Util.pm (original)
+++ branches/upstream/libsub-exporter-perl/current/lib/Sub/Exporter/Util.pm Wed Sep 5 12:11:01 2007
@@ -12,13 +12,13 @@
=head1 VERSION
-version 0.975
-
- $Id: /my/cs/projects/Sub-Exporter/trunk/lib/Sub/Exporter/Util.pm 31990 2007-07-06T02:33:04.864653Z rjbs $
-
-=cut
-
-our $VERSION = '0.975';
+version 0.976
+
+ $Id$
+
+=cut
+
+our $VERSION = '0.976';
=head1 DESCRIPTION
@@ -138,11 +138,56 @@
}
}
+# =head2 name_map
+#
+# This utility returns an list to be used in specify export generators. For
+# example, the following:
+#
+# exports => {
+# name_map(
+# '_?_gen' => [ qw(fee fie) ],
+# '_make_?' => [ qw(foo bar) ],
+# ),
+# }
+#
+# is equivalent to:
+#
+# exports => {
+# name_map(
+# fee => \'_fee_gen',
+# fie => \'_fie_gen',
+# foo => \'_make_foo',
+# bar => \'_make_bar',
+# ),
+# }
+#
+# This can save a lot of typing, when providing many exports with similarly-named
+# generators.
+#
+# =cut
+#
+# sub name_map {
+# my (%groups) = @_;
+#
+# my %map;
+#
+# while (my ($template, $names) = each %groups) {
+# for my $name (@$names) {
+# (my $export = $template) =~ s/\?/$name/
+# or Carp::croak 'no ? found in name_map template';
+#
+# $map{ $name } = \$export;
+# }
+# }
+#
+# return %map;
+# }
+
=head2 merge_col
exports => {
merge_col(defaults => {
- twiddle => \&_twiddle_gen,
+ twiddle => \'_twiddle_gen',
tweak => \&_tweak_gen,
}),
}
@@ -150,6 +195,8 @@
This utility wraps the given generator in one that will merge the named
collection into its args before calling it. This means that you can support a
"default" collector in multipe exports without writing the code each time.
+
+You can specify as many pairs of collection names and generators as you like.
=cut
@@ -167,7 +214,11 @@
? { %{ $col->{$default_name} }, %$arg }
: $arg;
- $gen->($class, $name, $merged_arg, $col);
+ if (Params::Util::_CODELIKE($gen)) { ## no critic Private
+ $gen->($class, $name, $merged_arg, $col);
+ } else {
+ $class->$$gen($name, $merged_arg, $col);
+ }
}
}
}
@@ -284,6 +335,7 @@
use Sub::Exporter -setup => {
exports => [ qw(
like
+ name_map
merge_col
curry_method curry_class
curry_chain
Modified: branches/upstream/libsub-exporter-perl/current/t/collection.t
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-exporter-perl/current/t/collection.t?rev=7236&op=diff
==============================================================================
--- branches/upstream/libsub-exporter-perl/current/t/collection.t (original)
+++ branches/upstream/libsub-exporter-perl/current/t/collection.t Wed Sep 5 12:11:01 2007
@@ -8,7 +8,7 @@
=cut
-use Test::More tests => 7;
+use Test::More tests => 8;
use Data::OptList qw(mkopt_hash);
BEGIN { use_ok('Sub::Exporter'); }
@@ -34,6 +34,7 @@
'defaults',
brand_preference => sub { 0 },
model_preference => sub { 1 },
+ sets_own_value => sub { $_[0] = { foo => 10 } },
definedp => \'is_defined',
]
@@ -53,6 +54,20 @@
$collection,
{ defaults => { foo => 1, bar => 2 } },
"collection returned properly from collector",
+ );
+}
+
+{
+ my $collection = Sub::Exporter::_collect_collections(
+ $config,
+ [ [ sets_own_value => undef ] ],
+ 'main',
+ );
+
+ is_deeply(
+ $collection,
+ { sets_own_value => { foo => 10} },
+ "a collector can alter the stack to change its own value",
);
}
Modified: branches/upstream/libsub-exporter-perl/current/t/util-merge.t
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-exporter-perl/current/t/util-merge.t?rev=7236&op=diff
==============================================================================
--- branches/upstream/libsub-exporter-perl/current/t/util-merge.t (original)
+++ branches/upstream/libsub-exporter-perl/current/t/util-merge.t Wed Sep 5 12:11:01 2007
@@ -7,14 +7,15 @@
BEGIN {
package Thing;
- BEGIN { main::use_ok("Sub::Exporter::Util", 'merge_col'); }
+ BEGIN { main::use_ok("Sub::Exporter::Util", 'merge_col'); }
+
use Sub::Exporter -setup => {
collectors => [ qw(defaults etc) ],
exports => {
merge_col(
defaults => {
stack => sub { my @x = @_; sub { return @x } },
- kcats => sub { my @x = @_; sub { return reverse @x } },
+ kcats => \'_kcats_gen',
},
empty => {
bogus => sub { my @x = @_; sub { return @x } },
@@ -27,6 +28,11 @@
plain => sub { my @x = @_; sub { return @x } },
},
};
+
+ sub _kcats_gen {
+ my @x = @_;
+ sub { return reverse @x }
+ }
}
package Test::SubExporter::MERGE::0;
Added: branches/upstream/libsub-exporter-perl/current/t/util-namemap.t
URL: http://svn.debian.org/wsvn/branches/upstream/libsub-exporter-perl/current/t/util-namemap.t?rev=7236&op=file
==============================================================================
--- branches/upstream/libsub-exporter-perl/current/t/util-namemap.t (added)
+++ branches/upstream/libsub-exporter-perl/current/t/util-namemap.t Wed Sep 5 12:11:01 2007
@@ -1,0 +1,28 @@
+#!perl -T
+use strict;
+use warnings;
+
+use Test::More skip_all => 'not actually offerring this feature yet';
+
+# use Test::More tests => 3;
+
+BEGIN { use_ok("Sub::Exporter::Util", 'name_map'); }
+
+is_deeply(
+ {
+ name_map(
+ '_?_gen' => [ qw(fee fie) ],
+ '_make_?' => [ qw(foo bar) ],
+ ),
+ },
+ {
+ fee => \'_fee_gen',
+ fie => \'_fie_gen',
+ foo => \'_make_foo',
+ bar => \'_make_bar',
+ },
+ 'example from docs works just dandy',
+);
+
+eval { name_map(foo => [ qw(bar) ] ) };
+like($@, qr/no \?/, 'exception raised with no ? in template');
More information about the Pkg-perl-cvs-commits
mailing list