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