package Package::Variant;
use strictures 1;
-use Carp qw( croak );
+use Import::Into;
+use Module::Runtime qw(use_module);
+use Carp qw(croak);
+
+our $VERSION = '1.001002'; # 1.1.2
+
+$VERSION = eval $VERSION;
our %Variable;
+my $sanitize_importing = sub {
+ my ($me, $spec) = @_;
+ return []
+ unless defined $spec;
+ my @specced =
+ not(ref $spec)
+ ? ($spec)
+ : (ref($spec) eq 'ARRAY')
+ ? (@$spec)
+ : (ref($spec) eq 'HASH')
+ ? (map {
+ croak qq{The import argument list for '$_' is not an array ref}
+ unless ref($spec->{$_}) eq 'ARRAY';
+ ($_ => $spec->{$_});
+ } sort keys %$spec)
+ : croak q{The 'importing' option has to be either a hash or array ref};
+ my @imports;
+ my $arg_count = 1;
+ while (@specced) {
+ my $key = shift @specced;
+ croak qq{Value $arg_count in 'importing' is not a package string},
+ $arg_count
+ unless defined($key) and not(ref $key);
+ $arg_count++;
+ my $import_args =
+ (not(@specced) or (defined($specced[0]) and not ref($specced[0])))
+ ? []
+ : (ref($specced[0]) eq 'ARRAY')
+ ? do { $arg_count++; shift @specced }
+ : croak(
+ qq{Value $arg_count for package '$key' in 'importing' is not}
+ . qq{ a package string or array ref}
+ );
+ push @imports, [$key, $import_args];
+ }
+ return \@imports;
+};
+
+my $sub_namer = eval {
+ require Sub::Name; sub { shift if @_ > 2; Sub::Name::subname(@_) }
+} || sub { $_[-1] };
+
sub import {
my $target = caller;
my $me = shift;
no strict 'refs';
$Variable{$variable} = {
anon => $anon,
- args => \%args,
+ args => {
+ %args,
+ importing => $me->$sanitize_importing($args{importing}),
+ },
subs => {
map +($_ => sub {}), @{$args{subs}||[]},
},
}
}
-my $sanitize_importing = sub {
- my ($me, $spec) = @_;
- return []
- unless defined $spec;
- return [map {
- my $import_args = $spec->{$_};
- croak sprintf q{Import argument list for '%s' are is an array ref},
- $_,
- unless ref($import_args) and ref($import_args) eq 'ARRAY';
- [$_ => $import_args];
- } keys %$spec]
- if ref $spec eq 'HASH';
- croak q{The 'importing' option has to be either a hash or array ref}
- unless ref $spec eq 'ARRAY';
- my @specced = @$spec;
- my @imports;
- while (@specced) {
- my $key = shift @specced;
- push @imports, [
- $key,
- (ref($specced[0]) and ref($specced[0]) eq 'ARRAY')
- ? shift(@specced)
- : [],
- ];
- }
- return \@imports;
-};
-
sub build_variant_of {
my ($me, $variable, @args) = @_;
my $variant_name = "${variable}::_Variant_".++$Variable{$variable}{anon};
- my $import = $me
- ->$sanitize_importing($Variable{$variable}{args}{importing});
- my $setup = join("\n",
- "package ${variant_name};",
- (map sprintf(
- q!use %s %s;!,
- $import->[$_][0],
- scalar(@{$import->[$_][1]})
- ? sprintf(
- q!@{$import->[%d][1]}!,
- $_,
- )
- : '',
- ), 0..$#$import),
- "1;",
- );
- eval $setup
- or die "evaling ${setup} failed: $@";
+ foreach my $to_import (@{$Variable{$variable}{args}{importing}}) {
+ my ($pkg, $args) = @$to_import;
+ use_module($pkg)->import::into($variant_name, @{$args});
+ }
my $subs = $Variable{$variable}{subs};
local @{$subs}{keys %$subs} = map $variant_name->can($_), keys %$subs;
local $Variable{$variable}{install} = sub {
- my ($name, $ref) = @_;
+ my $full_name = "${variant_name}::".shift;
+
+ my $ref = $sub_namer->($full_name, @_);
+
no strict 'refs';
- *{"${variant_name}::${name}"} = $ref;
+ *$full_name = $ref;
};
$variable->make_variant($variant_name, @args);
return $variant_name;
# what modules to 'use'
importing => ['Moo::Role'],
# proxied subroutines
- subs => [qw( has around before after extends )],
+ subs => [ qw(has around before after with) ],
sub make_variant {
my ($class, $target_package, %arguments) = @_;
your package.
use My::Variant;
- my $new_variant_package = Variant( @variant_arguments );
+ my $new_variant_package = Variant(@variant_arguments);
The package is now fully initialized and used. You can import the
subroutine under a different name by specifying an C<as> argument.
=head2 importing
This option is a hash reference mapping package names to array references
-containing import arguments. The packages will be C<use>d with the given
+containing import arguments. The packages will be imported with the given
arguments by every variation before the L</make_variant> method is asked
-to create the package.
+to create the package (this is done using L<Import::Into>).
If import order is important to you, you can also pass the C<importing>
arguments as a flat array reference:
The import method will be called even if the list of import arguments is
empty or not specified,
+If you just want to import a single package's default exports, you can
+also pass a string instead:
+
+ use Package::Variant importing => 'Package';
+
=head2 subs
An array reference of strings listing the names of subroutines that should
=item * B<as>
use Some::Variant::Package as => 'Foo';
- my $variant_package = Foo( @arguments );
+ my $variant_package = Foo(@arguments);
Exports the generator subroutine under a different name than the default.
=head2 build_variation_of
my $variant_package = Package::Variant
- ->build_variation_of( $variable_package, @arguments );
+ ->build_variation_of($variable_package, @arguments);
This is the dynamic method of creating new variants. It takes the
C<$variable_package>, which is a pre-declared variable package, and a set
=head2 install
- install( $method_name, $code_reference );
+ install($method_name, $code_reference);
Installs a method with the given C<$method_name> into the newly created
variant package. The C<$code_reference> will be used as the body for the
-method.
+method, and if L<Sub::Name> is available the coderef will be named. If you
+want to name it something else, then use:
+
+ install($method_name, $name_to_use, $code_reference);
=head1 AUTHOR
-=over
+mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
-=item mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
+=head1 CONTRIBUTORS
-=back
+phaylon - Robert Sedlacek (cpan:PHAYLON) <r.sedlacek@shadowcat.co.uk>
=head1 COPYRIGHT
-Copyright (c) 2010-2011 the C<Package::Stash> L</AUTHOR> as listed above.
+Copyright (c) 2010-2012 the C<Package::Variant> L</AUTHOR> and
+L</CONTRIBUTORS> as listed above.
=head1 LICENSE