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