X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FPackage%2FVariant.pm;h=b9ed5a6040ddc1289ff2206a6c9f8819fa51ab3e;hb=refs%2Fheads%2Fextra_options;hp=e490bfb757113939a86bb91b97383d299bd59597;hpb=236a4386470d4edcbdda8a7d5564dd04401c7027;p=p5sagit%2FPackage-Variant.git diff --git a/lib/Package/Variant.pm b/lib/Package/Variant.pm index e490bfb..b9ed5a6 100644 --- a/lib/Package/Variant.pm +++ b/lib/Package/Variant.pm @@ -1,9 +1,58 @@ package Package::Variant; use strictures 1; +use Import::Into; +use Module::Runtime qw(use_module); +use Carp qw(croak); + +our $VERSION = '1.001001'; # 1.1.1 + +$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; @@ -14,18 +63,24 @@ sub import { no strict 'refs'; $Variable{$variable} = { anon => $anon, - args => \%args, + args => { + make_variant => 'make_variant', + %args, + importing => $me->$sanitize_importing($args{importing}), + }, subs => { map +($_ => sub {}), @{$args{subs}||[]}, }, }; *{"${target}::import"} = sub { my $target = caller; + my (undef, %arg) = @_; + my $as = defined($arg{as}) ? $arg{as} : $last; no strict 'refs'; - *{"${target}::${last}"} = sub { + *{"${target}::${as}"} = sub { $me->build_variant_of($variable, @_); }; - }; + } unless $args{no_import}; my $subs = $Variable{$variable}{subs}; foreach my $name (keys %$subs) { *{"${target}::${name}"} = sub { @@ -40,19 +95,293 @@ sub import { sub build_variant_of { my ($me, $variable, @args) = @_; my $variant_name = "${variable}::_Variant_".++$Variable{$variable}{anon}; - my @to_import = keys %{$Variable{$variable}{args}{importing}||{}}; - my $setup = join("\n", "package ${variant_name};", (map "use $_;", @to_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); + $variable->${\$Variable{$variable}{args}{make_variant}}($variant_name, @args); return $variant_name; } 1; + +__END__ + +=head1 NAME + +Package::Variant - Parameterizable packages + +=head1 SYNOPSIS + + # declaring a variable Moo role + package My::Role::ObjectAttr; + use strictures 1; + use Package::Variant + # what modules to 'use' + importing => ['Moo::Role'], + # proxied subroutines + subs => [ qw(has around before after with) ], + + sub make_variant { + my ($class, $target_package, %arguments) = @_; + # access arguments + my $name = $arguments{name}; + # use proxied 'has' to add an attribute + has $name => (is => 'lazy'); + # install a builder method + install "_build_${name}" => sub { + return $arguments{class}->new; + }; + } + + # using the role + package My::Class::WithObjectAttr; + use strictures 1; + use Moo; + use My::Role::ObjectAttr; + + with ObjectAttr(name => 'some_obj', class => 'Some::Class'); + + # using our class + my $obj = My::Class::WithObjectAttr->new; + $obj->some_obj; # returns a Some::Class instance + +=head1 DESCRIPTION + +This module allows you to build packages that return different variations +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 +not care about what kind of package it builds. + +=head2 Declaring a variable package + +There are two important parts to creating a variable package. You first +have to give C some basic information about what kind of +package you want to provide, and how. The second part is implementing a +method receiving the user's arguments and generating your variants. + +=head3 Setting up the environment for building variations + +When you C, you pass along some arguments that +describe how you intend to build your variations. + + use Package::Variant + importing => { $package => \@import_arguments, ... }, + subs => [ @proxied_subroutine_names ]; + +The L option needs to be a hash or array reference with +package names to be Cd 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 for more options. You can omit empty import +argument lists when passing an array reference. + +The L option is an array reference of subroutine names that are +exported by the packages specified with L. These subroutines +will be proxied from your declaration package to the variant to be +generated. + +With L initializing your package and L declaring what +subroutines you want to use to build a variant, you can now write a +L method building your variants. + +=head3 Declaring a method to produce variants + +Every time a user requests a new variant a method named L +will be called with the name of the target package and the arguments from +the user. + +It can then use the proxied subroutines declared with L to +customize the new package. An L subroutine is exported as well +allowing you to dynamically install methods into the new package. If these +options aren't flexible enough, you can use the passed name of the new +package to do any other kind of customizations. + + sub make_variant { + my ($class, $target, @arguments) = @_; + # ... + # customization goes here + # ... + } + +When the method is finished, the user will receive the name of the new +package variant you just set up. + +=head2 Using variable packages + +After your variable package is L +your users can get a variant generating subroutine by simply importing +your package. + + use My::Variant; + 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 argument. + +=head2 Dynamic creation of variant packages + +For regular uses, the L provides +more than enough flexibility. However, if you want to create variations of +dynamically determined packages, you can use the L +method. + +You can use this to create variations of other packages and pass arguments +on to them to allow more modular and extensible variations. + +=head1 OPTIONS + +These are the options that can be passed when importing +C. They describe the environment in which the variants +are created. + + use Package::Variant + importing => { $package => \@import_arguments, ... }, + subs => [ @proxied_subroutines ]; + +=head2 importing + +This option is a hash reference mapping package names to array references +containing import arguments. The packages will be imported with the given +arguments by every variation before the L method is asked +to create the package (this is done using L). + +If import order is important to you, you can also pass the C +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' => [] }; + +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 +be proxied. These subroutines are expected to be installed into the new +variant package by the modules imported with L. Subroutines +with the same name will be availabe in your declaration package, and will +proxy through to the newly created package when used within +L. + +=head1 VARIABLE PACKAGE METHODS + +These are methods on the variable package you declare when you import +C. + +=head2 make_variant + + Some::Variant::Package->make_variant( $target, @arguments ); + +B This method will be called for every +new variant of your package. This method should use the subroutines +declared in L to customize the new variant package. + +This is a class method receiving the C<$target> package and the +C<@arguments> defining the requested variant. + +=head2 import + + use Some::Variant::Package; + my $variant_package = Package( @arguments ); + +This method is provided for you. It will allow a user to C your +package and receive a subroutine taking C<@arguments> defining the variant +and returning the name of the newly created variant package. + +The following options can be specified when importing: + +=over + +=item * B + + use Some::Variant::Package as => 'Foo'; + my $variant_package = Foo(@arguments); + +Exports the generator subroutine under a different name than the default. + +=back + +=head1 C METHODS + +These methods are available on C itself. + +=head2 build_variation_of + + my $variant_package = Package::Variant + ->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 +of C<@arguments> passed to the package to generate a new +C<$variant_package>, which will be returned. + +=head2 import + + use Package::Variant @options; + +Sets up the environment in which you declare the variants of your +packages. See L for details on the available options and +L for a list of exported subroutines. + +=head1 EXPORTS + +Additionally to the proxies for subroutines provided in L, the +following exports will be available in your variable package: + +=head2 install + + 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, and if L 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 + +mst - Matt S. Trout (cpan:MSTROUT) + +=head1 CONTRIBUTORS + +phaylon - Robert Sedlacek (cpan:PHAYLON) + +=head1 COPYRIGHT + +Copyright (c) 2010-2012 the C L and +L as listed above. + +=head1 LICENSE + +This library is free software and may be distributed under the same +terms as perl itself. + +=cut