package Package::Variant;
use strictures 1;
-use Carp qw( croak );
+use Import::Into;
+use Module::Runtime qw(require_module);
+use Carp qw(croak);
+
+our $VERSION = '1.002000'; # 1.2.0
+
+$VERSION = eval $VERSION;
our %Variable;
return \@imports;
};
+my $sub_namer = eval {
+ require Sub::Name; sub { shift if @_ > 2; Sub::Name::subname(@_) }
+} || sub { $_[-1] };
+
sub import {
- my $target = caller;
+ my $variable = caller;
my $me = shift;
- my $last = (split '::', $target)[-1];
+ my $last = (split '::', $variable)[-1];
my $anon = 'A000';
- my $variable = $target;
my %args = @_;
no strict 'refs';
$Variable{$variable} = {
map +($_ => sub {}), @{$args{subs}||[]},
},
};
- *{"${target}::import"} = sub {
+ *{"${variable}::import"} = sub {
my $target = caller;
my (undef, %arg) = @_;
my $as = defined($arg{as}) ? $arg{as} : $last;
};
my $subs = $Variable{$variable}{subs};
foreach my $name (keys %$subs) {
- *{"${target}::${name}"} = sub {
+ *{"${variable}::${name}"} = sub {
goto &{$subs->{$name}}
};
}
- *{"${target}::install"} = sub {
+ *{"${variable}::install"} = sub {
goto &{$Variable{$variable}{install}};
- }
+ };
+ *{"${variable}::build_variant"} = sub {
+ shift;
+ $me->build_variant_of($variable, @_);
+ };
}
sub build_variant_of {
my ($me, $variable, @args) = @_;
my $variant_name = "${variable}::_Variant_".++$Variable{$variable}{anon};
- my $import = $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;
+ require_module $pkg;
+ eval q{ BEGIN { $pkg->import::into($variant_name, @{$args}) }; 1; }
+ or die $@;
+ }
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) = @_;
depending on what parameters are given.
Users of your package will receive a subroutine able to take parameters
-and return the name of a suitable variant package. The implmenetation does
+and return the name of a suitable variant package. The implementation does
not care about what kind of package it builds.
=head2 Declaring a variable package
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.
For regular uses, the L<normal import|/Using variable packages> provides
more than enough flexibility. However, if you want to create variations of
-dynamically determined packages, you can use the L</build_variation_of>
+dynamically determined packages, you can use the L</build_variant_of>
method.
You can use this to create variations of other packages and pass arguments
=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:
If you just want to import a single package's default exports, you can
also pass a string instead:
- use PAckage::Variant importing => 'Package';
+ use Package::Variant importing => 'Package';
=head2 subs
An array reference of strings listing the names of subroutines that should
be proxied. These subroutines are expected to be installed into the new
variant package by the modules imported with L</importing>. Subroutines
-with the same name will be availabe in your declaration package, and will
+with the same name will be available in your declaration package, and will
proxy through to the newly created package when used within
L</make_variant>.
=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.
=back
+=head2 build_variant
+
+ use Some::Variant::Package ();
+ my $variant_package = Some::Variant::Package->build_variant( @arguments );
+
+This method is provided for you. It will generate a variant package
+and return its name, just like the generator sub provided by
+L</import>. This allows you to avoid importing anything into the
+consuming package.
+
=head1 C<Package::Variant> METHODS
These methods are available on C<Package::Variant> itself.
-=head2 build_variation_of
+=head2 build_variant_of
my $variant_package = Package::Variant
- ->build_variation_of( $variable_package, @arguments );
+ ->build_variant_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>
+
+haarg - Graham Knop (cpan:HAARG) <haarg@haarg.org>
=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
projects / p5sagit/Package-Variant.git / blobdiff