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