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