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