1 package Package::Variant;
5 use Module::Runtime qw(require_module);
8 our $VERSION = '1.003000';
10 $VERSION = eval $VERSION;
14 my $sanitize_importing = sub {
21 : (ref($spec) eq 'ARRAY')
23 : (ref($spec) eq 'HASH')
25 croak qq{The import argument list for '$_' is not an array ref}
26 unless ref($spec->{$_}) eq 'ARRAY';
29 : croak q{The 'importing' option has to be either a hash or array ref};
33 my $key = shift @specced;
34 croak qq{Value $arg_count in 'importing' is not a package string},
36 unless defined($key) and not(ref $key);
39 (not(@specced) or (defined($specced[0]) and not ref($specced[0])))
41 : (ref($specced[0]) eq 'ARRAY')
42 ? do { $arg_count++; shift @specced }
44 qq{Value $arg_count for package '$key' in 'importing' is not}
45 . qq{ a package string or array ref}
47 push @imports, [$key, $import_args];
52 my $sub_namer = eval {
53 require Sub::Name; sub { shift if @_ > 2; Sub::Name::subname(@_) }
57 my $variable = caller;
59 my $last = (split '::', $variable)[-1];
63 $Variable{$variable} = {
67 importing => $me->$sanitize_importing($args{importing}),
70 map +($_ => sub {}), @{$args{subs}||[]},
73 *{"${variable}::import"} = sub {
75 my (undef, %arg) = @_;
76 my $as = defined($arg{as}) ? $arg{as} : $last;
78 *{"${target}::${as}"} = sub {
79 $me->build_variant_of($variable, @_);
82 my $subs = $Variable{$variable}{subs};
83 foreach my $name (keys %$subs) {
84 *{"${variable}::${name}"} = sub {
85 goto &{$subs->{$name}}
88 *{"${variable}::install"} = sub {
89 goto &{$Variable{$variable}{install}};
91 *{"${variable}::build_variant"} = sub {
93 $me->build_variant_of($variable, @_);
97 sub build_variant_package_name {
98 my ($me, $variable, @args) = @_;
99 if ($variable->can('make_variant_package_name')) {
100 return $variable->make_variant_package_name(@args);
102 return "${variable}::_Variant_".++$Variable{$variable}{anon};
105 sub build_variant_of {
106 my ($me, $variable, @args) = @_;
107 my $variant_name = $me->build_variant_package_name($variable, @args);
108 foreach my $to_import (@{$Variable{$variable}{args}{importing}}) {
109 my ($pkg, $args) = @$to_import;
111 eval q{ BEGIN { $pkg->import::into($variant_name, @{$args}) }; 1; }
114 my $subs = $Variable{$variable}{subs};
115 local @{$subs}{keys %$subs} = map $variant_name->can($_), keys %$subs;
116 local $Variable{$variable}{install} = sub {
117 my $full_name = "${variant_name}::".shift;
119 my $ref = $sub_namer->($full_name, @_);
124 $variable->make_variant($variant_name, @args);
125 return $variant_name;
134 Package::Variant - Parameterizable packages
138 Creation of anonymous variants:
140 # declaring a variable Moo role
141 package My::VariableRole::ObjectAttr;
144 # what modules to 'use'
145 importing => ['Moo::Role'],
146 # proxied subroutines
147 subs => [ qw(has around before after with) ];
150 my ($class, $target_package, %arguments) = @_;
152 my $name = $arguments{name};
153 # use proxied 'has' to add an attribute
154 has $name => (is => 'lazy');
155 # install a builder method
156 install "_build_${name}" => sub {
157 return $arguments{class}->new;
162 package My::Class::WithObjectAttr;
165 use My::VariableRole::ObjectAttr;
167 with ObjectAttr(name => 'some_obj', class => 'Some::Class');
170 my $obj = My::Class::WithObjectAttr->new;
171 $obj->some_obj; # returns a Some::Class instance
173 And the same thing, only with named variants:
175 # declaring a variable Moo role that can be named
176 package My::VariableRole::ObjectAttrNamed;
178 use Package::Variant importing => ['Moo::Role'],
179 subs => [ qw(has around before after with) ];
180 use Module::Runtime 'module_notional_filename'; # only if you need protection
182 # this method is run at variant creation time to determine its custom
183 # package name. it can use the arguments or do something entirely else.
184 sub make_variant_package_name {
185 my ($class, $package, %arguments) = @_;
186 $package = "Private::$package"; # you can munge the input here if you like
187 # only if you *need* protection
188 die "Won't clobber $package" if $INC{module_notional_filename $package};
192 # same as in the example above, except for the argument list. in this example
193 # $package is the user input, and
194 # $target_package is the actual package in which the variant gets installed
196 my ($class, $target_package, $package, %arguments) = @_;
197 my $name = $arguments{name};
198 has $name => (is => 'lazy');
199 install "_build_${name}" => sub {return $arguments{class}->new};
203 package My::Class::WithObjectAttr;
206 use My::VariableRole::ObjectAttrNamed;
208 # create the role under a specific name
209 ObjectAttrNamed "My::Role" => (name => 'some_obj', class => 'Some::Class');
211 with "Private::My::Role";
214 my $obj = My::Class::WithObjectAttr->new;
215 $obj->some_obj; # returns a Some::Class instance
219 This module allows you to build a variable package that contains a package
220 template and can use it to build variant packages at runtime.
222 Your variable package will export a subroutine which will build a variant
223 package, combining its arguments with the template, and return the name of the
226 The implementation does not care about what kind of packages it builds, be they
227 simple function exporters, classes, singletons or something entirely different.
229 =head2 Declaring a variable package
231 There are two important parts to creating a variable package. You first
232 have to give C<Package::Variant> some basic information about what kind of
233 variant packages you want to provide, and how. The second part is implementing a
234 method which builds the components of the variant packages that use the user's
235 arguments or cannot be provided with a static import.
237 =head3 Setting up the environment for building variants
239 When you C<use Package::Variant>, you pass along some arguments that
240 describe how you intend to build your variants.
243 importing => { $package => \@import_arguments, ... },
244 subs => [ @proxied_subroutine_names ];
246 The L</importing> option needs to be a hash or array reference with
247 package names to be C<use>d as keys, and array references containing the
248 import arguments as values. These packages will be imported into every new
249 variant package, to provide static functionality of the variant packages and to
250 set up every declarative subroutine you require to build variants package
251 components. The next option will allow you to use these functions. See
252 L</importing> for more options. You can omit empty import argument lists when
253 passing an array reference.
255 The L</subs> option is an array reference of subroutine names that are
256 exported by the packages specified with L</importing>. These subroutines
257 will be proxied from your variable package to the variant to be
260 With L</importing> initializing your package and L</subs> declaring what
261 subroutines you want to use to build a variant, you can now write a
262 L</make_variant> method building your variants.
264 =head3 Declaring a method to produce variants
266 Every time a user requests a new variant, a method named L</make_variant>
267 will be called with the name of the target package and the arguments from
270 It can then use the proxied subroutines declared with L</subs> to
271 customize the variant package. An L</install> subroutine is exported as well
272 allowing you to dynamically install methods into the variant package. If these
273 options aren't flexible enough, you can use the passed name of the variant
274 package to do any other kind of customizations.
277 my ($class, $target, @arguments) = @_;
279 # customization goes here
283 When the method is finished, the user will receive the name of the new variant
284 package you just set up.
286 =head2 Using variable packages
288 After your variable package is L<created|/Declaring a variable package>
289 your users can get a variant generator subroutine by simply importing
293 my $new_variant_package = Variant(@variant_arguments);
294 # the variant package is now fully initialized and used
296 You can import the subroutine under a different name by specifying an C<as>
299 =head2 Dynamic creation of variant packages
301 For regular uses, the L<normal import|/Using variable packages> provides
302 more than enough flexibility. However, if you want to create variants of
303 dynamically determined packages, you can use the L</build_variant_of>
306 You can use this to create variants of other packages and pass arguments
307 on to them to allow more modular and extensible variants.
311 These are the options that can be passed when importing
312 C<Package::Variant>. They describe the environment in which the variants
316 importing => { $package => \@import_arguments, ... },
317 subs => [ @proxied_subroutines ];
321 This option is a hash reference mapping package names to array references
322 containing import arguments. The packages will be imported with the given
323 arguments by every variant before the L</make_variant> method is asked
324 to create the package (this is done using L<Import::Into>).
326 If import order is important to you, you can also pass the C<importing>
327 arguments as a flat array reference:
330 importing => [ 'PackageA', 'PackageB' ];
334 importing => [ 'PackageA' => [], 'PackageB' => [] ];
338 importing => { 'PackageA' => [], 'PackageB' => [] };
340 The import method will be called even if the list of import arguments is
341 empty or not specified,
343 If you just want to import a single package's default exports, you can
344 also pass a string instead:
346 use Package::Variant importing => 'Package';
350 An array reference of strings listing the names of subroutines that should
351 be proxied. These subroutines are expected to be installed into the new
352 variant package by the modules imported with L</importing>. Subroutines
353 with the same name will be available in your variable package, and will
354 proxy through to the newly created package when used within
357 =head1 VARIABLE PACKAGE METHODS
359 These are methods on the variable package you declare when you import
364 Some::Variant::Package->make_variant( $target, @arguments );
366 B<You need to provide this method.> This method will be called for every
367 new variant of your package. This method should use the subroutines
368 declared in L</subs> to customize the new variant package.
370 This is a class method receiving the C<$target> package and the
371 C<@arguments> defining the requested variant.
373 =head2 make_variant_package_name
375 Some::Variant::Package->make_variant_package_name( @arguments );
377 B<You may optionally provide this method.> If present, this method will be
378 used to determine the package name for a particular variant being constructed.
380 If you do not implement it, a unique package name something like
382 Some::Variant::Package::_Variant_A003
384 will be created for you.
388 use Some::Variant::Package;
389 my $variant_package = Package( @arguments );
391 This method is provided for you. It will allow a user to C<use> your
392 package and receive a subroutine taking C<@arguments> defining the variant
393 and returning the name of the newly created variant package.
395 The following options can be specified when importing:
401 use Some::Variant::Package as => 'Foo';
402 my $variant_package = Foo(@arguments);
404 Exports the generator subroutine under a different name than the default.
410 use Some::Variant::Package ();
411 my $variant_package = Some::Variant::Package->build_variant( @arguments );
413 This method is provided for you. It will generate a variant package
414 and return its name, just like the generator sub provided by
415 L</import>. This allows you to avoid importing anything into the
418 =head1 C<Package::Variant> METHODS
420 These methods are available on C<Package::Variant> itself.
422 =head2 build_variant_of
424 my $variant_package = Package::Variant
425 ->build_variant_of($variable_package, @arguments);
427 This is the dynamic method of creating new variants. It takes the
428 C<$variable_package>, which is a pre-declared variable package, and a set
429 of C<@arguments> passed to the package to generate a new
430 C<$variant_package>, which will be returned.
434 use Package::Variant @options;
436 Sets up the environment in which you declare the variants of your
437 packages. See L</OPTIONS> for details on the available options and
438 L</EXPORTS> for a list of exported subroutines.
442 Additionally to the proxies for subroutines provided in L</subs>, the
443 following exports will be available in your variable package:
447 install($method_name, $code_reference);
449 Installs a method with the given C<$method_name> into the newly created
450 variant package. The C<$code_reference> will be used as the body for the
451 method, and if L<Sub::Name> is available the coderef will be named. If you
452 want to name it something else, then use:
454 install($method_name, $name_to_use, $code_reference);
458 mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
462 phaylon - Robert Sedlacek (cpan:PHAYLON) <r.sedlacek@shadowcat.co.uk>
464 haarg - Graham Knop (cpan:HAARG) <haarg@haarg.org>
468 Copyright (c) 2010-2012 the C<Package::Variant> L</AUTHOR> and
469 L</CONTRIBUTORS> as listed above.
473 This library is free software and may be distributed under the same
474 terms as perl itself.