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