lib/Package/Variant.pm

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