r3195 - in
/packages/libsub-exporter-perl/branches/upstream/current: Changes
META.yml lib/Sub/Exporter.pm lib/Sub/Exporter/Util.pm t/util-curry.t
t/util-mixin.t
eloy at users.alioth.debian.org
eloy at users.alioth.debian.org
Wed Jun 28 14:56:37 UTC 2006
Author: eloy
Date: Wed Jun 28 14:56:36 2006
New Revision: 3195
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=3195
Log:
Load /tmp/tmp.PAvZe32369/libsub-exporter-perl-0.97.0 into
packages/libsub-exporter-perl/branches/upstream/current.
Modified:
packages/libsub-exporter-perl/branches/upstream/current/Changes
packages/libsub-exporter-perl/branches/upstream/current/META.yml
packages/libsub-exporter-perl/branches/upstream/current/lib/Sub/Exporter.pm
packages/libsub-exporter-perl/branches/upstream/current/lib/Sub/Exporter/Util.pm
packages/libsub-exporter-perl/branches/upstream/current/t/util-curry.t
packages/libsub-exporter-perl/branches/upstream/current/t/util-mixin.t
Modified: packages/libsub-exporter-perl/branches/upstream/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/branches/upstream/current/Changes?rev=3195&op=diff
==============================================================================
--- packages/libsub-exporter-perl/branches/upstream/current/Changes (original)
+++ packages/libsub-exporter-perl/branches/upstream/current/Changes Wed Jun 28 14:56:36 2006
@@ -1,5 +1,10 @@
Revision history for Sub-Exporter
+0.970 2006-06-27
+ defaults populate before collectors collect, now
+ default group's value is undef by default, not 1
+ mixin_exporter can now export into objects, creating virtual classes
+
0.966 2006-06-17
correct documentation of collector hook args
simplify internal use of setup_exporter
Modified: packages/libsub-exporter-perl/branches/upstream/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/branches/upstream/current/META.yml?rev=3195&op=diff
==============================================================================
--- packages/libsub-exporter-perl/branches/upstream/current/META.yml (original)
+++ packages/libsub-exporter-perl/branches/upstream/current/META.yml Wed Jun 28 14:56:36 2006
@@ -11,4 +11,4 @@
Data::OptList: 0.1
Params::Util: 0.14
Sub::Install: 0.92
-version: 0.966
+version: 0.970
Modified: packages/libsub-exporter-perl/branches/upstream/current/lib/Sub/Exporter.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/branches/upstream/current/lib/Sub/Exporter.pm?rev=3195&op=diff
==============================================================================
--- packages/libsub-exporter-perl/branches/upstream/current/lib/Sub/Exporter.pm (original)
+++ packages/libsub-exporter-perl/branches/upstream/current/lib/Sub/Exporter.pm Wed Jun 28 14:56:36 2006
@@ -14,13 +14,13 @@
=head1 VERSION
-version 0.966
-
- $Id: /my/cs/projects/export/trunk/lib/Sub/Exporter.pm 22590 2006-06-17T19:54:13.510080Z rjbs $
+version 0.970
+
+ $Id: /my/cs/projects/export/trunk/lib/Sub/Exporter.pm 22773 2006-06-27T16:48:37.268002Z rjbs $
=cut
-our $VERSION = '0.966';
+our $VERSION = '0.970';
=head1 SYNOPSIS
@@ -631,9 +631,11 @@
# this builds a AOA, where the inner arrays are [ name => value_ref ]
my $import_args = Data::OptList::mkopt([ @_ ]);
+ # is this right? defaults first or collectors first? -- rjbs, 2006-06-24
+ $import_args = [ [ -default => undef ] ] unless @$import_args;
+
my $collection = _collect_collections($config, $import_args, $class, $into);
- $import_args = [ [ -default => 1 ] ] unless @$import_args;
my $to_import = _expand_groups($class, $config, $import_args, $collection);
# now, finally $import_arg is really the "to do" list
Modified: packages/libsub-exporter-perl/branches/upstream/current/lib/Sub/Exporter/Util.pm
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/branches/upstream/current/lib/Sub/Exporter/Util.pm?rev=3195&op=diff
==============================================================================
--- packages/libsub-exporter-perl/branches/upstream/current/lib/Sub/Exporter/Util.pm (original)
+++ packages/libsub-exporter-perl/branches/upstream/current/lib/Sub/Exporter/Util.pm Wed Jun 28 14:56:36 2006
@@ -9,13 +9,13 @@
=head1 VERSION
-version 0.015
+version 0.020
$Id$
=cut
-our $VERSION = '0.015';
+our $VERSION = '0.020';
=head1 DESCRIPTION
@@ -114,27 +114,46 @@
This utility returns an exporter that will export into a superclass and adjust
the ISA importing class to include the newly generated superclass.
+If the target of importing is an object, the hierarchy is reversed: the new
+class will be ISA the object's class, and the object will be reblessed.
+
B<Prerequisites>: This utility requires that Package::Generator be installed.
=cut
+sub __mixin_class_for {
+ my ($class, $mix_into) = @_;
+ require Package::Generator;
+ my $mixin_class = Package::Generator->new_package({
+ base => "$class\:\:__mixin__",
+ });
+
+ no strict 'refs';
+ if (ref $mix_into) {
+ $mix_into = ref $mix_into if ref $mix_into;
+ unshift @{"$mixin_class" . "::ISA"}, $mix_into;
+ } else {
+ unshift @{"$mix_into" . "::ISA"}, $mixin_class;
+ }
+ return $mixin_class;
+}
+
sub mixin_exporter {
+ # These are NOT arguments to mixin_exporter, that's why there is no = @_.
+ # They are variables created to enclose in each generated exporter coderef.
my ($mixin_class, $col_ref);
+
sub {
my ($class, $generator, $name, $arg, $collection, $as, $into) = @_;
unless ($mixin_class and ($collection == $col_ref)) {
- require Package::Generator;
- $mixin_class = Package::Generator->new_package({
- base => "$class\:\:__mixin__",
- });
+ $mixin_class = __mixin_class_for($class, $into);
+ bless $into => $mixin_class if ref $into;
$col_ref = 0 + $collection;
- no strict 'refs';
- unshift @{"$into" . "::ISA"}, $mixin_class;
}
- $into = $mixin_class;
+
Sub::Exporter::default_exporter(
- $class, $generator, $name, $arg, $collection, $as, $into
+ $class, $generator, $name, $arg, $collection, $as, $mixin_class
);
};
}
@@ -195,8 +214,6 @@
exports => [ qw(like merge_col curry_class mixin_exporter) ]
};
-=head1 TODO
-
=head1 AUTHOR
Ricardo SIGNES, C<< <rjbs at cpan.org> >>
Modified: packages/libsub-exporter-perl/branches/upstream/current/t/util-curry.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/branches/upstream/current/t/util-curry.t?rev=3195&op=diff
==============================================================================
--- packages/libsub-exporter-perl/branches/upstream/current/t/util-curry.t (original)
+++ packages/libsub-exporter-perl/branches/upstream/current/t/util-curry.t Wed Jun 28 14:56:36 2006
@@ -2,7 +2,7 @@
use strict;
use warnings;
-use Test::More tests => 9;
+use Test::More tests => 10;
BEGIN { use_ok("Sub::Exporter"); }
BEGIN {
@@ -15,6 +15,7 @@
},
};
+ sub new { bless { key => "value" } => $_[0] }
sub return_invocant { return $_[0] }
}
@@ -76,3 +77,13 @@
'Thing',
'imported talkback acts like return_invocant'
);
+
+package Test::SubExporter::CURRY::Object;
+
+BEGIN { Thing->new->import(qw(talkback)); }
+
+main::isa_ok(
+ talkback(),
+ 'Thing',
+ 'the result of object-curried talkback'
+);
Modified: packages/libsub-exporter-perl/branches/upstream/current/t/util-mixin.t
URL: http://svn.debian.org/wsvn/pkg-perl/packages/libsub-exporter-perl/branches/upstream/current/t/util-mixin.t?rev=3195&op=diff
==============================================================================
--- packages/libsub-exporter-perl/branches/upstream/current/t/util-mixin.t (original)
+++ packages/libsub-exporter-perl/branches/upstream/current/t/util-mixin.t Wed Jun 28 14:56:36 2006
@@ -6,7 +6,7 @@
BEGIN {
if (eval { require Package::Generator; 1; }) {
- plan tests => 20;
+ plan 'no_plan';
} else {
plan skip_all => "the mixin exporter requires Package::Generator";
}
@@ -101,3 +101,33 @@
isnt("@{$super[$x]}", "@{$super[$y]}", "parent($x) ne parent($y)")
}
}
+
+{
+ package Test::SubExporter::OBJECT;
+
+ sub new { bless {} => shift }
+
+ sub plugh { "plugh" }
+}
+
+package main;
+
+my $obj_1 = Test::SubExporter::OBJECT->new;
+isa_ok($obj_1, "Test::SubExporter::OBJECT", "first object");
+is(ref $obj_1, "Test::SubExporter::OBJECT", "first object's ref is TSEO");
+
+my $obj_2 = Test::SubExporter::OBJECT->new;
+isa_ok($obj_2, "Test::SubExporter::OBJECT", "second object");
+is(ref $obj_2, "Test::SubExporter::OBJECT", "second object's ref is TSEO");
+
+Thing::Mixin->import({ into => $obj_1 }, qw(bar));
+pass("mixin-exporting to an object didn't die");
+
+is(
+ eval { $obj_1->bar },
+ 1,
+ "now that object has a bar method"
+);
+
+isa_ok($obj_1, "Test::SubExporter::OBJECT");
+isnt(ref $obj_1, "Test::SubExporter::OBJECT", "but its actual class isnt TSEO");
More information about the Pkg-perl-cvs-commits
mailing list