Commit | Line | Data |
236a4386 |
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}; |
1abbe9d7 |
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 | ); |
236a4386 |
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; |
0c378352 |
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 |