File Coverage

blib/lib/constant/defer.pm
Criterion Covered Total %
statement 56 63 88.8
branch 10 14 71.4
condition n/a
subroutine 12 14 85.7
pod n/a
total 78 91 85.7


line stmt bran cond sub pod time code
1             # Copyright 2008, 2009, 2010, 2011 Kevin Ryde
2              
3             # This file is part of constant-defer.
4             #
5             # constant-defer is free software; you can redistribute it and/or modify it
6             # under the terms of the GNU General Public License as published by the Free
7             # Software Foundation; either version 3, or (at your option) any later
8             # version.
9             #
10             # constant-defer is distributed in the hope that it will be useful, but
11             # WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
12             # or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
13             # for more details.
14             #
15             # You should have received a copy of the GNU General Public License along
16             # with constant-defer. If not, see <http://www.gnu.org/licenses/>.
17              
18             package constant::defer;
19 1     1   1159802 use strict;
  1         4  
  1         73  
20 1     1   6 use vars qw($VERSION);
  1         4  
  1         675  
21              
22             $VERSION = 5;
23              
24             sub import {
25 15     15   758008 my $class = shift;
26 15         48 $class->_create_for_package (scalar(caller), @_);
27             }
28             sub _create_for_package {
29 15     15   19 my $class = shift;
30 15         19 my $target_package = shift;
31 15         63 while (@_) {
32 20         46 my $name = shift;
33 20 100       49 if (ref $name eq 'HASH') {
34 2         9 unshift @_, %$name;
35 2         8 next;
36             }
37 18 50       39 unless (@_) {
38 0         0 require Carp;
39 0         0 Carp::croak ("Missing value sub for $name");
40             }
41 18         22 my $subr = shift;
42              
43             ### $constant::defer::DEBUG_LAST_SUBR = $subr;
44              
45 18         23 my ($fullname, $basename);
46 18 100       45 if ($name =~ /::([^:]*)$/s) {
47 1         2 $fullname = $name;
48 1         3 $basename = $1;
49             } else {
50 17         19 $basename = $name;
51 17         41 $fullname = "${target_package}::$name";
52             }
53             ## print "constant::defer $arg -- $fullname $basename $old\n";
54 18         43 $class->_validate_name ($basename);
55 18         40 $class->_create_fullname ($fullname, $subr);
56             }
57             }
58              
59             sub _create_fullname {
60 18     18   33 my ($class, $fullname, $subr) = @_;
61             my $run = sub {
62 17     17   37 unshift @_, $fullname, $subr;
63 17         37 goto &_run;
64 18         133 };
65             my $func = sub () {
66 20     20   1803 unshift @_, \$run;
67 20         310 goto $run;
68 18         65 };
69 1     1   7 no strict 'refs';
  1         8  
  1         6962  
70 18         2151 *$fullname = $func;
71              
72             ### $constant::defer::DEBUG_LAST_RUNNER = $run;
73             }
74              
75             sub _run {
76 17     17   29 my $fullname = shift;
77 17         35 my $subr = shift;
78 17         25 my $run_ref = shift;
79             ### print "_run() $fullname $subr\n";
80              
81 17         57 my @ret = &$subr(@_);
82 17 100       90 if (@ret == 1) {
    50          
83             # constant.pm has an optimization to make a constant by storing a scalar
84             # value directly into the %{Foo::Bar::} hash if there's no typeglob for
85             # the name yet. But that doesn't apply here, there's always a glob from
86             # having converted a function.
87             #
88             # The function created only has name __ANON__ in its coderef GV (as
89             # fetched by Sub::Identify for instance). This is the same as most
90             # function creating modules, including Memoize.pm. Plain constant.pm
91             # likewise, except when it uses the scalar ref in symbol table
92             # optimization, in that case a later upgrade to a function gets a name.
93             #
94 14         19 my $value = $ret[0];
95 14     0   153 $subr = sub () { $value };
  0         0  
96              
97             } elsif (@ret == 0) {
98 0         0 $subr = \&_nothing;
99              
100             } else {
101 3     5   13 $subr = sub () { @ret };
  5         190  
102             }
103              
104 17         26 $$run_ref = $subr;
105 1     1   10 { no strict 'refs';
  1         2  
  1         239  
  17         82  
106 17         42 local $^W = 0; # no warnings 'redefine';
107 17 50       23 eval { *$fullname = $subr } or die $@;
  17         120  
108             }
109 17         81 goto $subr;
110             }
111              
112             # not as strict as constant.pm
113             sub _validate_name {
114 18     18   26 my ($class, $name) = @_;
115 18 50       98 if ($name =~ m{[()] # no parens like CODE(0x1234) if miscounted args
116             |^[0-9] # no starting with a number
117             |^$ # not empty
118             }x) {
119 0           require Carp;
120 0           Carp::croak ("Constant name '$name' is invalid");
121             }
122             }
123              
124 0     0     sub _nothing () { } ## no critic (ProhibitSubroutinePrototypes)
125              
126             1;
127             __END__
128              
129             =for stopwords bareword stringizing inline there'd fakery subclassing Ryde multi-value inlined coderef subrs subr
130              
131             =head1 NAME
132              
133             constant::defer -- constant subs with deferred value calculation
134              
135             =for test_synopsis my ($some,$thing,$an,$other);
136              
137             =head1 SYNOPSIS
138              
139             use constant::defer FOO => sub { return $some + $thing; },
140             BAR => sub { return $an * $other; };
141              
142             use constant::defer MYOBJ => sub { require My::Class;
143             return My::Class->new_thing; }
144              
145             =head1 DESCRIPTION
146              
147             C<constant::defer> creates a subroutine which on the first call runs given
148             code to calculate its value, and on the second and subsequent calls just
149             returns that value, like a constant. The value code is discarded once run,
150             allowing it to be garbage collected.
151              
152             Deferring a calculation is good if it might take a lot of work or produce a
153             big result, but is only needed sometimes or only well into a program run.
154             If it's never needed then the value code never runs.
155              
156             A deferred constant is generally not inlined or folded (see
157             L<perlop/Constant Folding>) like a plain C<constant> since it's not a single
158             scalar value. In the current implementation a deferred constant becomes a
159             plain one after the first use, so may inline etc in code compiled after that
160             (see L</IMPLEMENTATION> below).
161              
162             =head2 Uses
163              
164             Here are some typical uses.
165              
166             =over 4
167              
168             =item *
169              
170             A big value or slow calculation only sometimes needed,
171              
172             use constant::defer SLOWVALUE => sub {
173             long calculation ...;
174             return $result;
175             };
176              
177             if ($option) {
178             print "s=", SLOWVALUE, "\n";
179             }
180              
181             =item *
182              
183             A shared object instance created when needed then re-used,
184              
185             use constant::defer FORMATTER =>
186             sub { return My::Formatter->new };
187              
188             if ($something) {
189             FORMATTER()->format ...
190             }
191              
192             =item *
193              
194             The value code might load requisite modules too, again deferring that until
195             actually needed,
196              
197             use constant::defer big => sub {
198             require Some::Big::Module;
199             return Some::Big::Module->create_something(...);
200             };
201              
202             =item *
203              
204             Once-only setup code can be created with no return value. The code is
205             garbage collected after the first run and becomes a do-nothing. Remember to
206             have an empty return statement so as not to keep the last expression's value
207             alive forever.
208              
209             use constant::defer MY_INIT => sub {
210             many lines of setup code ...;
211             return;
212             };
213              
214             sub new {
215             MY_INIT();
216             ...
217             }
218              
219             =back
220              
221             =head1 IMPORTS
222              
223             There are no functions as such, everything works through the C<use> import.
224              
225             =over 4
226              
227             =item C<< use constant::defer NAME1=>SUB1, NAME2=>SUB2, ...; >>
228              
229             The parameters are name/subroutine pairs. For each one a sub called C<NAME>
230             is created, running the given C<SUB> the first time its value is needed.
231              
232             C<NAME> defaults to the caller's package, or a fully qualified name can be
233             given. Remember that the bareword stringizing of C<=E<gt>> doesn't act on a
234             qualified name, so add quotes in that case.
235              
236             use constant::defer 'Other::Package::BAR' => sub { ... };
237              
238             For compatibility with the C<constant> module a hash of name/sub arguments
239             is accepted too. But C<constant::defer> doesn't need that since there's
240             only ever one thing (a sub) following each name.
241              
242             use constant::defer { FOO => sub { ... },
243             BAR => sub { ... } };
244              
245             # works without the hashref too
246             use constant::defer FOO => sub { ... },
247             BAR => sub { ... };
248              
249             =back
250              
251             =head1 MULTIPLE VALUES
252              
253             The value sub can return multiple values to make an array style constant
254             sub.
255              
256             use constant::defer NUMS => sub { return ('one', 'two') };
257              
258             foreach (NUMS) {
259             print $_,"\n";
260             }
261              
262             The value sub is always run in array context, for consistency, irrespective
263             how the constant is used. The return from the new constant sub is an array
264             style
265              
266             sub () { return @result }
267              
268             If the value sub was a list-style return like C<NUMS> shown above, then this
269             array-style return is slightly different. In scalar context a list return
270             means the last value (like a comma operator), but an array return in scalar
271             context means the number of elements. A multi-value constant won't normally
272             be used in scalar context, so the difference shouldn't arise. The array
273             style is easier for C<constant::defer> to implement and is the same as the
274             plain C<constant> module does.
275              
276             =head1 ARGUMENTS
277              
278             If the constant is called with arguments then they're passed on to the value
279             sub. This can be good for constants used as object or class methods.
280             Passing anything to plain constants would be unusual.
281              
282             One cute use for a class method style is to make a "singleton" instance of
283             the class. See F<examples/instance.pl> in the sources for a complete
284             program.
285              
286             package My::Class;
287             use constant::defer INSTANCE => sub { my ($class) = @_;
288             return $class->new };
289             package main;
290             $obj = My::Class->INSTANCE;
291              
292             A subclass might want to be careful about letting a subclass object get into
293             the parent C<INSTANCE>, though if a program only ever used the subclass then
294             that might in fact be desirable.
295              
296             Subs created by C<constant::defer> always have prototype C<()>, ensuring
297             they always parse the same way. The prototype has no effect when called as
298             a method like above, but if you want a plain call with arguments then use
299             C<&> to bypass the prototype (see L<perlsub>).
300              
301             &MYCONST ('Some value');
302              
303             =head1 IMPLEMENTATION
304              
305             Currently C<constant::defer> creates a sub under the requested name and when
306             called it replaces that with a new constant sub the same as C<use constant>
307             would make. This is compact and means that later loaded code might be able
308             to inline it.
309              
310             It's fine to keep a reference to the initial sub and in fact that happens
311             quite normally if importing into another module (with the usual
312             C<Exporter>), or an explicit C<\&foo>, or a C<$package-E<gt>can('foo')>.
313             The initial sub changes itself to jump to the new constant, it doesn't
314             re-run the value code.
315              
316             The jump is currently done by a C<goto> to the new coderef, so it's a touch
317             slower than the new constant sub directly. A spot of XS would no doubt make
318             the difference negligible, in fact perhaps to the point where there'd be no
319             need for a new sub, just have the initial transform itself. If the new form
320             looked enough like a plain constant it might inline in later loaded code.
321              
322             For reference, C<Package::Constants> (as of version 0.02) considers
323             C<constant::defer> subrs as constants, both before and after the first call
324             that runs the value code. C<Package::Constants> just looks for prototyped
325             S<C<sub foo () { }>> functions, so any such subr rates as a constant.
326              
327             =head1 OTHER WAYS TO DO IT
328              
329             There's many ways to do "deferred" or "lazy" calculations.
330              
331             =over 4
332              
333             =item *
334              
335             C<Memoize> makes a function repeat its return. Results are cached against
336             the arguments, so it keeps the original code whereas C<constant::defer>
337             discards after the first run.
338              
339             =item *
340              
341             C<Class::Singleton> and friends make a create-once
342             C<My::Class-E<gt>instance> method. C<constant::defer> can get close with
343             the fakery shown under L</ARGUMENTS> above, though without a C<has_instance>
344             to query.
345              
346             =item *
347              
348             C<Sub::Become> offers some syntactic sugar for redefining the running
349             subroutine, including to a constant.
350              
351             =item *
352              
353             C<Sub::SingletonBuilder> can create an instance function for a class. It's
354             geared towards objects and so won't allow 0 or C<undef> as the return value.
355              
356             =item *
357              
358             A scalar can be rigged up to run code on its first access. C<Data::Lazy>
359             uses a C<tie>. C<Scalar::Defer> and C<Scalar::Lazy> use C<overload> on an
360             object. C<Data::Thunk> optimizes out the object from C<Scalar::Defer> after
361             the first run. C<Variable::Lazy> uses XS magic removed after the first
362             fetch and some parsing for syntactic sugar.
363              
364             The advantage of a variable is that it interpolates in strings, but it won't
365             inline in later loaded code; sloppy XS code might bypass the magic; and
366             package variables aren't very friendly when subclassing.
367              
368             =item *
369              
370             C<Object::Lazy> and C<Object::Trampoline> rig up an object wrapper to load
371             and create an actual object only when a method is called, dispatching to it
372             and replacing the callers C<$_[0]>. The advantage is you can pass the
373             wrapper object around, etc, deferring creation to an even later point than a
374             sub or scalar can.
375              
376             =item *
377              
378             C<Object::Realize::Later>, C<Class::LazyObject> and C<Class::LazyFactory>
379             help make a defer class which transforms lazy stub objects to real ones when
380             a method call is made. A separate defer class is required for each real
381             class.
382              
383             =item *
384              
385             C<once.pm> sets up a run-once code block, but with no particular return
386             value and not discarding the code after run.
387              
388             =item *
389              
390             C<Class::LazyLoad> and C<deferred> load code on a class method call such as
391             object creation. They're more about module loading than a defer of a
392             particular value.
393              
394             =item *
395              
396             C<Tie::LazyList> and C<Tie::Array::Lazy> makes an array calculate values
397             on-demand from a generator function. C<Hash::Lazy> does a similar thing for
398             hashes. C<Tie::LazyFunction> hides a function behind a scalar; its laziness
399             is in the argument evaluation, the function is called every time.
400              
401             =back
402              
403             =head1 SEE ALSO
404              
405             L<constant>, L<perlsub>, L<constant::lexical>
406              
407             L<Memoize>, L<Attribute::Memoize>, L<Memoize::Attrs>,
408             L<Class::Singleton>,
409             L<Data::Lazy>, L<Scalar::Defer>, L<Scalar::Lazy>, L<Data::Thunk>,
410             L<Variable::Lazy>,
411             L<Sub::Become>,
412             L<Sub::SingletonBuilder>,
413             L<Object::Lazy>,
414             L<Object::Trampoline>,
415             L<Object::Realize::Later>,
416             L<once>,
417             L<Class::LazyLoad>,
418             L<deferred>
419              
420             =head1 HOME PAGE
421              
422             http://user42.tuxfamily.org/constant-defer/index.html
423              
424             =head1 COPYRIGHT
425              
426             Copyright 2009, 2010, 2011 Kevin Ryde
427              
428             constant-defer is free software; you can redistribute it and/or modify it
429             under the terms of the GNU General Public License as published by the Free
430             Software Foundation; either version 3, or (at your option) any later
431             version.
432              
433             constant-defer is distributed in the hope that it will be useful, but
434             WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
435             or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
436             more details.
437              
438             You should have received a copy of the GNU General Public License along with
439             constant-defer. If not, see <http://www.gnu.org/licenses/>.
440              
441             =cut