File Coverage

blib/lib/Params/Lazy.pm
Criterion Covered Total %
statement 47 51 92.1
branch 12 16 75.0
condition 4 5 80.0
subroutine 8 8 100.0
pod n/a
total 71 80 88.7


line stmt bran cond sub pod time code
1             package Params::Lazy;
2              
3             { require 5.008 };
4 16     16   7697166 use strict;
  16         40  
  16         621  
5 16     16   150 use warnings FATAL => 'all';
  16         31  
  16         794  
6              
7 16     16   100 use Carp;
  16         35  
  16         1862  
8              
9             # The call checker API is available on newer Perls;
10             # making the dependency on D::CC conditional lets me
11             # test this on an uninstalled blead.
12 16     16   17316 use if $] < 5.014, "Devel::CallChecker";
  16         147  
  16         96  
13              
14             require Exporter;
15             our @ISA = qw(Exporter);
16             our @EXPORT = "force";
17             our @EXPORT_OK = "force";
18              
19             our $VERSION = '0.005';
20              
21             my $hint_key = "Params::Lazy/no_caller_args";
22              
23             require XSLoader;
24             XSLoader::load('Params::Lazy', $VERSION);
25              
26             sub import {
27 67     67   544349 my $self = shift;
28 67         139 my $caller = caller();
29            
30 67 100       1063 if ( @_ == 1 ) {
31 1 50       8 if ($_[0] eq 'force') {
    50          
32 0         0 return $self->export_to_level(1);
33             }
34             elsif ( $_[0] eq 'caller_args' ) {
35 0         0 delete $^H{$hint_key};
36 0         0 return;
37             }
38             }
39            
40 67 100 100     458 if ( @_ && @_ % 2 ) {
41 1         239 croak("You passed in an uneven list of values, "
42             . "but that doesn't make sense");
43             }
44            
45 66         173 while (@_) {
46 79         198 my ($name, $proto) = splice(@_, 0, 2);
47 79 100       271 if (grep !defined, $name, $proto) {
48 2         233 croak("Both the function name and the "
49             . "pseudo-prototype must be defined");
50             }
51              
52 77         87 my $coderef;
53 77 50 50     574 if ( (ref($name) || "") eq 'CODE' ) {
54 0         0 $coderef = $name;
55             }
56             else {
57 77 50       223 if ($name !~ /::/) {
58 77         176 $name = $caller . "::" . $name;
59             }
60            
61 16     16   5453 my $glob = do { no strict 'refs'; \*{$name} };
  16         34  
  16         900  
  77         76  
  77         81  
  77         413  
62            
63             # Predeclare the sub if it doesn't exist. This allows
64             # people to write
65             # use Params::Lazy foo => ...;
66             # ...
67             # sub foo { ... }
68             # That is, to have the 'use' line on top as usual,
69             # and later on the body of the function.
70 77 100       127 if ( !*{$glob}{CODE} ) {
  77         233  
71 16     16   87 *{$glob} = do { no strict 'refs'; \&{$name} };
  16         24  
  16         3495  
  52         69  
  52         101  
  52         66  
  52         198  
72             }
73            
74 77         110 $coderef = *{$glob}{CODE};
  77         146  
75             }
76            
77 77         437 Params::Lazy::cv_set_call_checker_delay($coderef, $proto);
78             }
79              
80 64         48020 $self->export_to_level(1);
81             }
82              
83             sub unimport {
84 6     6   6817 shift;
85 6         187 $^H{$hint_key} = 1;
86             }
87              
88             =encoding utf8
89              
90             =head1 NAME
91              
92             Params::Lazy - Transparent lazy arguments for subroutines.
93              
94             =head1 VERSION
95              
96             Version 0.005
97              
98             =head1 SYNOPSIS
99              
100             use Params::Lazy delay => '^';
101             sub delay {
102             say "One";
103             force $_[0];
104             say "Three";
105             }
106              
107             delay say "Two"; # Will output One, Two, Three
108              
109             use Params::Lazy fakemap => '^@';
110             sub fakemap {
111             my $delayed = shift;
112             my @retvals;
113             push @retvals, force $delayed for @_;
114             return @retvals;
115             }
116              
117             my @goodies = fakemap "<$_>", 1..10; # same as map "<$_>", 1..10;
118             ...
119            
120             use Params::Lazy fakegrep => ':@';
121             sub fakegrep (&@) {
122             my $delayed = shift;
123             my $coderef = ref($delayed) eq 'CODE';
124             my @retvals;
125             for (@_) {
126             if ($coderef ? $delayed->() : force $delayed) {
127             push @retvals, $_;
128             }
129             }
130             return @retvals;
131             }
132            
133             say fakegrep { $_ % 2 } 9, 16, 25, 36;
134             say fakegrep $_ % 2, 9, 16, 25, 36;
135              
136             =head1 DESCRIPTION
137              
138             The Params::Lazy module provides a way to transparently create lazy
139             arguments for a function, without the callers being aware that anything
140             unusual is happening under the hood.
141              
142             You can enable lazy arguments using this module and specifying the
143             function name and a prototype-looking string as the functions to "export".
144              
145             That pseudo-prototype allows all the characters normally present in a
146             prototype, plus two new options: A caret (C<^>), which means "make this
147             argument lazy", and a colon (C<:>), which will be explained later.
148              
149             When a function with lazy magic is called, instead of receiving the
150             result of whatever expression the caller specified, the delayed argument
151             will instead show up as a simple scalar reference in C<@_>.
152             Only after you pass that reference to C will the delayed
153             expression be run.
154              
155             By default, delayed arguments will see the C<@_> of the context
156             they were delayed in. While this is generally the most desirable behavior,
157             it makes delayed arguments slightly slower, so you can switch to using
158             the current C<@_> by B the delaying function under
159             the scope of C; that is, you must do this:
160              
161             {
162             no Params::Lazy 'caller_args';
163             use Params::Lazy foo => q(^^);
164             ...
165             }
166              
167             For the sake of sanity, it's not recommended that you define a function
168             under no-caller-args, but then enable those again inside the function
169             and then use C<&force> (note the C<&>).
170              
171             The colon (C<:>) is special cased to work with the C<&> prototype.
172             The gist of it is that, if the expression is something that the
173             C<&> prototype would allow, it stays out of the way and gives you that.
174             Otherwise, it gives you a delayed argument you can use with C.
175              
176             =head1 EXPORT
177              
178             =head2 force $delayed
179              
180             Runs the delayed code.
181              
182             =head1 LIMITATIONS AND CAVEATS
183              
184             =over
185              
186             =item *
187              
188             When using the C<:> prototype, these two cases are indistinguishable:
189              
190             myfunction { ... }
191             myfunction sub { ... }
192              
193             Which means that C will work
194             differently than the default map.
195              
196             =item *
197              
198             It's important to note that delayed arguments are C<*not*> closures,
199             so storing them for later use will likely lead to crashes, segfaults,
200             and a general feeling of malignancy to descend upon you, your family,
201             and your cat. Passing them to other functions should work fine, but
202             returning them to the place where they were delayed is generally a
203             bad idea.
204              
205             =item *
206              
207             On Perl 5.8, throwing an exception within a delayed eval does not
208             generally work properly, and, if running with C<$ENV{PERL_DESTRUCT_LEVEL}>
209             set to anything but 0, causes Segfaults during global destruction.
210              
211             =item *
212              
213             There's a bug in Perls older than 5.14 that makes delaying a regular
214             expression likely to crash the program.
215              
216             =item *
217              
218             Threading support is experimental. It should behave slightly better
219             on Perls 5.18 and newer.
220              
221             =item *
222              
223             As of version 0.005, the 'caller arguments' feature doesn't work
224             if you're passing a delayed argument to another delayed function:
225              
226             use Params::Lazy qw( delay_1 ^$ delay_2 ^$ );
227             sub delay_1 { my $delayed = shift; delay_2 expr(), $delayed }
228             sub delay_2 { my ($d1, $d2) = @_; force $d2 }
229              
230             sub {
231             delay_1(
232             warn("I should see the original \@_: <@_>"),
233             "delay_2 should see this"
234             );
235             }->('delay_1 should see this');
236            
237             This is because currently, the 'delayed argument' magic is attached
238             to the delaying function, rather than the delayed argument.
239             This will be fixed in future releases.
240            
241             =item *
242              
243             Finally, while delayed arguments are intended to be faster & more
244             lightweight than passing coderefs, are at best just as fast, and
245             generally anywhere between 5% and 100% B than passing a
246             coderef and dereferencing it, so beware!
247              
248             =back
249              
250             =head1 PREREQUISITES
251              
252             Perl 5.14.0 or higher, although 5.18.0 is recommended to get the most
253             stable behavior. The module will build and test fine as far back as 5.8.8,
254             but some operations are either unstable or plain dangerous; for example,
255             delaying a regular expression might cause the program to crash in 5.10,
256             and trying to C out of a delayed expression in 5.8 will cause
257             all sorts of unexpected behavior.
258              
259             Devel::CallChecker 0.005 or higher, for perl versions earlier than 5.14.
260              
261             Exporter 5.58 or higher.
262              
263             =head1 AUTHOR, LICENSE AND COPYRIGHT
264              
265             Copyright 2013 Brian Fraser, C<< >>
266              
267             This program is free software; you may redistribute it and/or modify it under the same terms as perl.
268              
269             =head1 ACKNOWLEDGEMENTS
270              
271             To Scala for the inspiration, to p5p in general for holding my hand as I
272             stumbled through the callchecker, and to Zefram for L
273             and spotting a leak.
274              
275             =cut
276              
277             1; # End of Params::Lazy