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.001000'; # 1.1.0
+
+$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 [$_ => $spec->{$_}], 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) {
- push @imports, [shift(@specced), 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],
- not(defined $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;
use strictures 1;
use Package::Variant
# what modules to 'use'
- importing => { 'Moo::Role' => undef },
+ 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) = @_;
importing => { $package => \@import_arguments, ... },
subs => [ @proxied_subroutine_names ];
-The L</importing> option needs to be a hash reference with package names
-to be C<use>d as keys, and array references containing the import
-arguments as values. These packages will be imported into every new
+The L</importing> option needs to be a hash or array reference with
+package names to be C<use>d as keys, and array references containing the
+import arguments as values. These packages will be imported into every new
variant, and need to set up every declarative subroutine you require to
build your variable package. The next option will allow you to use these
-functions. See L</importing> for more options.
+functions. See L</importing> for more options. You can omit empty import
+argument lists when passing an array reference.
The L</subs> option is an array reference of subroutine names that are
exported by the packages specified with L</importing>. These subroutines
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 flag array reference:
+arguments as a flat array reference:
+
+ use Package::Variant
+ importing => [ 'PackageA', 'PackageB' ];
+
+ # same as
+ use Package::Variant
+ importing => [ 'PackageA' => [], 'PackageB' => [] ];
+ # or
use Package::Variant
- importing => [ PackageA => [], PackageB => [] ];
+ importing => { 'PackageA' => [], 'PackageB' => [] };
+
+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:
-If you want to import whatever the package exports by default, you have to
-pass C<undef> instead of an empty array reference.
+ use Package::Variant importing => 'Package';
=head2 subs
=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
projects / p5sagit/Package-Variant.git / blobdiff