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';
   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::VariableRole::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::VariableRole::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 a variable package that returns different
 166 variant packages depending on what parameters are given.
 167
 168 Users of your variable 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 variant 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 variant packages you want to provide, and how. The second part is implementing a
 177 method receiving the user's arguments and generating your variant packages.
 178
 179 =head3 Setting up the environment for building variants
 180
 181 When you C<use Package::Variant>, you pass along some arguments that
 182 describe how you intend to build your variants.
 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 package, 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 variable 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 variant package. An L</install> subroutine is exported as well
 213 allowing you to dynamically install methods into the variant package. If these
 214 options aren't flexible enough, you can use the passed name of the variant
 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 variant
 225 package 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   # the variant package is now fully initialized and used
 236
 237 You can import the subroutine under a different name by specifying an C<as>
 238 argument.
 239
 240 =head2 Dynamic creation of variant packages
 241
 242 For regular uses, the L<normal import|/Using variable packages> provides
 243 more than enough flexibility. However, if you want to create variants of
 244 dynamically determined packages, you can use the L</build_variant_of>
 245 method.
 246
 247 You can use this to create variants of other packages and pass arguments
 248 on to them to allow more modular and extensible variants.
 249
 250 =head1 OPTIONS
 251
 252 These are the options that can be passed when importing
 253 C<Package::Variant>. They describe the environment in which the variants
 254 are created.
 255
 256   use Package::Variant
 257     importing => { $package => \@import_arguments, ... },
 258     subs      => [ @proxied_subroutines ];
 259
 260 =head2 importing
 261
 262 This option is a hash reference mapping package names to array references
 263 containing import arguments. The packages will be imported with the given
 264 arguments by every variant before the L</make_variant> method is asked
 265 to create the package (this is done using L<Import::Into>).
 266
 267 If import order is important to you, you can also pass the C<importing>
 268 arguments as a flat array reference:
 269
 270   use Package::Variant
 271     importing => [ 'PackageA', 'PackageB' ];
 272
 273   # same as
 274   use Package::Variant
 275     importing => [ 'PackageA' => [], 'PackageB' => [] ];
 276
 277   # or
 278   use Package::Variant
 279     importing => { 'PackageA' => [], 'PackageB' => [] };
 280
 281 The import method will be called even if the list of import arguments is
 282 empty or not specified,
 283
 284 If you just want to import a single package's default exports, you can
 285 also pass a string instead:
 286
 287   use Package::Variant importing => 'Package';
 288
 289 =head2 subs
 290
 291 An array reference of strings listing the names of subroutines that should
 292 be proxied. These subroutines are expected to be installed into the new
 293 variant package by the modules imported with L</importing>. Subroutines
 294 with the same name will be available in your variable package, and will
 295 proxy through to the newly created package when used within
 296 L</make_variant>.
 297
 298 =head1 VARIABLE PACKAGE METHODS
 299
 300 These are methods on the variable package you declare when you import
 301 C<Package::Variant>.
 302
 303 =head2 make_variant
 304
 305   Some::Variant::Package->make_variant( $target, @arguments );
 306
 307 B<You need to provide this method.> This method will be called for every
 308 new variant of your package. This method should use the subroutines
 309 declared in L</subs> to customize the new variant package.
 310
 311 This is a class method receiving the C<$target> package and the
 312 C<@arguments> defining the requested variant.
 313
 314 =head2 import
 315
 316   use Some::Variant::Package;
 317   my $variant_package = Package( @arguments );
 318
 319 This method is provided for you. It will allow a user to C<use> your
 320 package and receive a subroutine taking C<@arguments> defining the variant
 321 and returning the name of the newly created variant package.
 322
 323 The following options can be specified when importing:
 324
 325 =over
 326
 327 =item * B<as>
 328
 329   use Some::Variant::Package as => 'Foo';
 330   my $variant_package = Foo(@arguments);
 331
 332 Exports the generator subroutine under a different name than the default.
 333
 334 =back
 335
 336 =head2 build_variant
 337
 338   use Some::Variant::Package ();
 339   my $variant_package = Some::Variant::Package->build_variant( @arguments );
 340
 341 This method is provided for you.  It will generate a variant package
 342 and return its name, just like the generator sub provided by
 343 L</import>.  This allows you to avoid importing anything into the
 344 consuming package.
 345
 346 =head1 C<Package::Variant> METHODS
 347
 348 These methods are available on C<Package::Variant> itself.
 349
 350 =head2 build_variant_of
 351
 352   my $variant_package = Package::Variant
 353     ->build_variant_of($variable_package, @arguments);
 354
 355 This is the dynamic method of creating new variants. It takes the
 356 C<$variable_package>, which is a pre-declared variable package, and a set
 357 of C<@arguments> passed to the package to generate a new
 358 C<$variant_package>, which will be returned.
 359
 360 =head2 import
 361
 362   use Package::Variant @options;
 363
 364 Sets up the environment in which you declare the variants of your
 365 packages. See L</OPTIONS> for details on the available options and
 366 L</EXPORTS> for a list of exported subroutines.
 367
 368 =head1 EXPORTS
 369
 370 Additionally to the proxies for subroutines provided in L</subs>, the
 371 following exports will be available in your variable package:
 372
 373 =head2 install
 374
 375   install($method_name, $code_reference);
 376
 377 Installs a method with the given C<$method_name> into the newly created
 378 variant package. The C<$code_reference> will be used as the body for the
 379 method, and if L<Sub::Name> is available the coderef will be named. If you
 380 want to name it something else, then use:
 381
 382   install($method_name, $name_to_use, $code_reference);
 383
 384 =head1 AUTHOR
 385
 386 mst - Matt S. Trout (cpan:MSTROUT) <mst@shadowcat.co.uk>
 387
 388 =head1 CONTRIBUTORS
 389
 390 phaylon - Robert Sedlacek (cpan:PHAYLON) <r.sedlacek@shadowcat.co.uk>
 391
 392 haarg - Graham Knop (cpan:HAARG) <haarg@haarg.org>
 393
 394 =head1 COPYRIGHT
 395
 396 Copyright (c) 2010-2012 the C<Package::Variant> L</AUTHOR> and
 397 L</CONTRIBUTORS> as listed above.
 398
 399 =head1 LICENSE
 400
 401 This library is free software and may be distributed under the same
 402 terms as perl itself.
 403
 404 =cut