lib/Package/Variant.pm

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