lib/Package/Variant.pm

   1 package Package::Variant;
   2
   3 use strictures 1;
   4 use Import::Into;
   5 use Module::Runtime qw(require_module);
   6 use Carp qw(croak);
   7
   8 our $VERSION = '1.001004'; # 1.1.4
   9
  10 $VERSION = eval $VERSION;
  11
  12 our %Variable;
  13
  14 my $sanitize_importing = sub {
  15   my ($me, $spec) = @_;
  16   return []
  17     unless defined $spec;
  18   my @specced =
  19     not(ref $spec)
  20       ? ($spec)
  21     : (ref($spec) eq 'ARRAY')
  22       ? (@$spec)
  23     : (ref($spec) eq 'HASH')
  24       ? (map {
  25           croak qq{The import argument list for '$_' is not an array ref}
  26             unless ref($spec->{$_}) eq 'ARRAY';
  27           ($_ => $spec->{$_});
  28         } sort keys %$spec)
  29     : croak q{The 'importing' option has to be either a hash or array ref};
  30   my @imports;
  31   my $arg_count = 1;
  32   while (@specced) {
  33     my $key = shift @specced;
  34     croak qq{Value $arg_count in 'importing' is not a package string},
  35       $arg_count
  36       unless defined($key) and not(ref $key);
  37     $arg_count++;
  38     my $import_args =
  39       (not(@specced) or (defined($specced[0]) and not ref($specced[0])))
  40         ? []
  41       : (ref($specced[0]) eq 'ARRAY')
  42         ? do { $arg_count++; shift @specced }
  43       : croak(
  44             qq{Value $arg_count for package '$key' in 'importing' is not}
  45           . qq{ a package string or array ref}
  46         );
  47     push @imports, [$key, $import_args];
  48   }
  49   return \@imports;
  50 };
  51
  52 my $sub_namer = eval {
  53   require Sub::Name; sub { shift if @_ > 2; Sub::Name::subname(@_) }
  54 } || sub { $_[-1] };
  55
  56 sub import {
  57   my $variable = caller;
  58   my $me = shift;
  59   my $last = (split '::', $variable)[-1];
  60   my $anon = 'A000';
  61   my %args = @_;
  62   no strict 'refs';
  63   $Variable{$variable} = {
  64     anon => $anon,
  65     args => {
  66       %args,
  67       importing => $me->$sanitize_importing($args{importing}),
  68     },
  69     subs => {
  70       map +($_ => sub {}), @{$args{subs}||[]},
  71     },
  72   };
  73   *{"${variable}::import"} = sub {
  74     my $target = caller;
  75     my (undef, %arg) = @_;
  76     my $as = defined($arg{as}) ? $arg{as} : $last;
  77     no strict 'refs';
  78     *{"${target}::${as}"} = sub {
  79       $me->build_variant_of($variable, @_);
  80     };
  81   };
  82   my $subs = $Variable{$variable}{subs};
  83   foreach my $name (keys %$subs) {
  84     *{"${variable}::${name}"} = sub {
  85       goto &{$subs->{$name}}
  86     };
  87   }
  88   *{"${variable}::install"} = sub {
  89     goto &{$Variable{$variable}{install}};
  90   }
  91 }
  92
  93 sub build_variant_of {
  94   my ($me, $variable, @args) = @_;
  95   my $variant_name = "${variable}::_Variant_".++$Variable{$variable}{anon};
  96   foreach my $to_import (@{$Variable{$variable}{args}{importing}}) {
  97     my ($pkg, $args) = @$to_import;
  98     require_module $pkg;
  99     eval q{ BEGIN { $pkg->import::into($variant_name, @{$args}) }; 1; }
 100       or die $@;
 101   }
 102   my $subs = $Variable{$variable}{subs};
 103   local @{$subs}{keys %$subs} = map $variant_name->can($_), keys %$subs;
 104   local $Variable{$variable}{install} = sub {
 105     my $full_name = "${variant_name}::".shift;
 106
 107     my $ref = $sub_namer->($full_name, @_);
 108
 109     no strict 'refs';
 110     *$full_name = $ref;
 111   };
 112   $variable->make_variant($variant_name, @args);
 113   return $variant_name;
 114 }
 115
 116 1;
 117
 118 __END__
 119
 120 =head1 NAME
 121
 122 Package::Variant - Parameterizable packages
 123
 124 =head1 SYNOPSIS
 125
 126   # declaring a variable Moo role
 127   package My::Role::ObjectAttr;
 128   use strictures 1;
 129   use Package::Variant
 130     # what modules to 'use'
 131     importing => ['Moo::Role'],
 132     # proxied subroutines
 133     subs => [ qw(has around before after with) ],
 134
 135   sub make_variant {
 136     my ($class, $target_package, %arguments) = @_;
 137     # access arguments
 138     my $name = $arguments{name};
 139     # use proxied 'has' to add an attribute
 140     has $name => (is => 'lazy');
 141     # install a builder method
 142     install "_build_${name}" => sub {
 143       return $arguments{class}->new;
 144     };
 145   }
 146
 147   # using the role
 148   package My::Class::WithObjectAttr;
 149   use strictures 1;
 150   use Moo;
 151   use My::Role::ObjectAttr;
 152
 153   with ObjectAttr(name => 'some_obj', class => 'Some::Class');
 154
 155   # using our class
 156   my $obj = My::Class::WithObjectAttr->new;
 157   $obj->some_obj; # returns a Some::Class instance
 158
 159 =head1 DESCRIPTION
 160
 161 This module allows you to build packages that return different variations
 162 depending on what parameters are given.
 163
 164 Users of your package will receive a subroutine able to take parameters
 165 and return the name of a suitable variant package. The implementation does
 166 not care about what kind of package it builds.
 167
 168 =head2 Declaring a variable package
 169
 170 There are two important parts to creating a variable package. You first
 171 have to give C<Package::Variant> some basic information about what kind of
 172 package you want to provide, and how. The second part is implementing a
 173 method receiving the user's arguments and generating your variants.
 174
 175 =head3 Setting up the environment for building variations
 176
 177 When you C<use Package::Variant>, you pass along some arguments that
 178 describe how you intend to build your variations.
 179
 180   use Package::Variant
 181     importing => { $package => \@import_arguments, ... },
 182     subs      => [ @proxied_subroutine_names ];
 183
 184 The L</importing> option needs to be a hash or array reference with
 185 package names to be C<use>d as keys, and array references containing the
 186 import arguments as values. These packages will be imported into every new
 187 variant, and need to set up every declarative subroutine you require to
 188 build your variable package. The next option will allow you to use these
 189 functions. See L</importing> for more options. You can omit empty import
 190 argument lists when passing an array reference.
 191
 192 The L</subs> option is an array reference of subroutine names that are
 193 exported by the packages specified with L</importing>. These subroutines
 194 will be proxied from your declaration package to the variant to be
 195 generated.
 196
 197 With L</importing> initializing your package and L</subs> declaring what
 198 subroutines you want to use to build a variant, you can now write a
 199 L</make_variant> method building your variants.
 200
 201 =head3 Declaring a method to produce variants
 202
 203 Every time a user requests a new variant a method named L</make_variant>
 204 will be called with the name of the target package and the arguments from
 205 the user.
 206
 207 It can then use the proxied subroutines declared with L</subs> to
 208 customize the new package. An L</install> subroutine is exported as well
 209 allowing you to dynamically install methods into the new package. If these
 210 options aren't flexible enough, you can use the passed name of the new
 211 package to do any other kind of customizations.
 212
 213   sub make_variant {
 214     my ($class, $target, @arguments) = @_;
 215     # ...
 216     # customization goes here
 217     # ...
 218   }
 219
 220 When the method is finished, the user will receive the name of the new
 221 package variant you just set up.
 222
 223 =head2 Using variable packages
 224
 225 After your variable package is L<created|/Declaring a variable package>
 226 your users can get a variant generating subroutine by simply importing
 227 your package.
 228
 229   use My::Variant;
 230   my $new_variant_package = Variant(@variant_arguments);
 231
 232 The package is now fully initialized and used. You can import the
 233 subroutine under a different name by specifying an C<as> argument.
 234
 235 =head2 Dynamic creation of variant packages
 236
 237 For regular uses, the L<normal import|/Using variable packages> provides
 238 more than enough flexibility. However, if you want to create variations of
 239 dynamically determined packages, you can use the L</build_variant_of>
 240 method.
 241
 242 You can use this to create variations of other packages and pass arguments
 243 on to them to allow more modular and extensible variations.
 244
 245 =head1 OPTIONS
 246
 247 These are the options that can be passed when importing
 248 C<Package::Variant>. They describe the environment in which the variants
 249 are created.
 250
 251   use Package::Variant
 252     importing => { $package => \@import_arguments, ... },
 253     subs      => [ @proxied_subroutines ];
 254
 255 =head2 importing
 256
 257 This option is a hash reference mapping package names to array references
 258 containing import arguments. The packages will be imported with the given
 259 arguments by every variation before the L</make_variant> method is asked
 260 to create the package (this is done using L<Import::Into>).
 261
 262 If import order is important to you, you can also pass the C<importing>
 263 arguments as a flat array reference:
 264
 265   use Package::Variant
 266     importing => [ 'PackageA', 'PackageB' ];
 267
 268   # same as
 269   use Package::Variant
 270     importing => [ 'PackageA' => [], 'PackageB' => [] ];
 271
 272   # or
 273   use Package::Variant
 274     importing => { 'PackageA' => [], 'PackageB' => [] };
 275
 276 The import method will be called even if the list of import arguments is
 277 empty or not specified,
 278
 279 If you just want to import a single package's default exports, you can
 280 also pass a string instead:
 281
 282   use Package::Variant importing => 'Package';
 283
 284 =head2 subs
 285
 286 An array reference of strings listing the names of subroutines that should
 287 be proxied. These subroutines are expected to be installed into the new
 288 variant package by the modules imported with L</importing>. Subroutines
 289 with the same name will be available in your declaration package, and will
 290 proxy through to the newly created package when used within
 291 L</make_variant>.
 292
 293 =head1 VARIABLE PACKAGE METHODS
 294
 295 These are methods on the variable package you declare when you import
 296 C<Package::Variant>.
 297
 298 =head2 make_variant
 299
 300   Some::Variant::Package->make_variant( $target, @arguments );
 301
 302 B<You need to provide this method.> This method will be called for every
 303 new variant of your package. This method should use the subroutines
 304 declared in L</subs> to customize the new variant package.
 305
 306 This is a class method receiving the C<$target> package and the
 307 C<@arguments> defining the requested variant.
 308
 309 =head2 import
 310
 311   use Some::Variant::Package;
 312   my $variant_package = Package( @arguments );
 313
 314 This method is provided for you. It will allow a user to C<use> your
 315 package and receive a subroutine taking C<@arguments> defining the variant
 316 and returning the name of the newly created variant package.
 317
 318 The following options can be specified when importing:
 319
 320 =over
 321
 322 =item * B<as>
 323
 324   use Some::Variant::Package as => 'Foo';
 325   my $variant_package = Foo(@arguments);
 326
 327 Exports the generator subroutine under a different name than the default.
 328
 329 =back
 330
 331 =head1 C<Package::Variant> METHODS
 332
 333 These methods are available on C<Package::Variant> itself.
 334
 335 =head2 build_variant_of
 336
 337   my $variant_package = Package::Variant
 338     ->build_variant_of($variable_package, @arguments);
 339
 340 This is the dynamic method of creating new variants. It takes the
 341 C<$variable_package>, which is a pre-declared variable package, and a set
 342 of C<@arguments> passed to the package to generate a new
 343 C<$variant_package>, which will be returned.
 344
 345 =head2 import
 346
 347   use Package::Variant @options;
 348
 349 Sets up the environment in which you declare the variants of your
 350 packages. See L</OPTIONS> for details on the available options and
 351 L</EXPORTS> for a list of exported subroutines.
 352
 353 =head1 EXPORTS
 354
 355 Additionally to the proxies for subroutines provided in L</subs>, the
 356 following exports will be available in your variable package:
 357
 358 =head2 install
 359
 360   install($method_name, $code_reference);
 361
 362 Installs a method with the given C<$method_name> into the newly created
 363 variant package. The C<$code_reference> will be used as the body for the
 364 method, and if L<Sub::Name> is available the coderef will be named. If you
 365 want to name it something else, then use:
 366
 367   install($method_name, $name_to_use, $code_reference);
 368
 369 =head1 AUTHOR
 370
 371 mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
 372
 373 =head1 CONTRIBUTORS
 374
 375 phaylon - Robert Sedlacek (cpan:PHAYLON) <r.sedlacek@shadowcat.co.uk>
 376
 377 =head1 COPYRIGHT
 378
 379 Copyright (c) 2010-2012 the C<Package::Variant> L</AUTHOR> and
 380 L</CONTRIBUTORS> as listed above.
 381
 382 =head1 LICENSE
 383
 384 This library is free software and may be distributed under the same
 385 terms as perl itself.
 386
 387 =cut