]> git.vpit.fr Git - perl/modules/Scope-Upper.git/blob - Scope/Upper.pm
This is 0.34
[perl/modules/Scope-Upper.git] / Scope / Upper.pm
1 package Scope::Upper;
2
3 use strict;
4 use warnings;
5
6 =head1 NAME
7
8 Scope::Upper - Act on upper scopes.
9
10 =head1 VERSION
11
12 Version 0.07
13
14 =cut
15
16 our $VERSION;
17 BEGIN {
18  $VERSION = '0.07';
19 }
20
21 =head1 SYNOPSIS
22
23     package X;
24
25     use Scope::Upper qw/reap localize localize_elem localize_delete :words/;
26
27     sub desc { shift->{desc} }
28
29     sub set_tag {
30      my ($desc) = @_;
31
32      # First localize $x so that it gets destroyed last
33      localize '$x' => bless({ desc => $desc }, __PACKAGE__) => UP; # one scope up
34
35      reap sub {
36       my $pkg = caller;
37       my $x = do { no strict 'refs'; ${$pkg.'::x'} }; # Get the $x in the scope
38       print $x->desc . ": done\n";
39      } => SCOPE 1; # same as UP here
40
41      localize_elem '%SIG', '__WARN__' => sub {
42       my $pkg = caller;
43       my $x = do { no strict 'refs'; ${$pkg.'::x'} }; # Get the $x in the scope
44       CORE::warn($x->desc . ': ' . join('', @_));
45      } => UP CALLER 0; # same as UP here
46
47      # delete last @ARGV element
48      localize_delete '@ARGV', -1 => UP SUB HERE; # same as UP here
49     }
50
51     package Y;
52
53     {
54      X::set_tag('pie');
55      # $x is now a X object, and @ARGV has one element less
56      warn 'what'; # warns "pie: what at ..."
57      ...
58     } # "pie: done" is printed
59
60     package Z;
61
62     use Scope::Upper qw/unwind want_at :words/;
63
64     sub try (&) {
65      my @result = shift->();
66      my $cx = SUB UP SUB;
67      unwind +(want_at($cx) ? @result : scalar @result) => $cx;
68     }
69
70     ...
71
72     sub zap {
73      try {
74       return @things; # returns to try() and then outside zap()
75      }
76     }
77
78     my @what = zap(); # @what contains @things
79
80 =head1 DESCRIPTION
81
82 This module lets you defer actions I<at run-time> that will take place when the control flow returns into an upper scope.
83 Currently, you can:
84
85 =over 4
86
87 =item *
88
89 hook an upper scope end with L</reap> ;
90
91 =item *
92
93 localize variables, array/hash values or deletions of elements in higher contexts with respectively L</localize>, L</localize_elem> and L</localize_delete> ;
94
95 =item *
96
97 return values immediately to an upper level with L</unwind>, and know which context was in use then with L</want_at>.
98
99 =back
100
101 =head1 FUNCTIONS
102
103 In all those functions, C<$context> refers to the target scope.
104
105 You have to use one or a combination of L</WORDS> to build the C<$context> passed to these functions.
106 This is needed in order to ensure that the module still works when your program is ran in the debugger.
107 The only thing you can assume is that it is an I<absolute> indicator of the frame, which means that you can safely store it at some point and use it when needed, and it will still denote the original scope.
108
109 =cut
110
111 BEGIN {
112  require XSLoader;
113  XSLoader::load(__PACKAGE__, $VERSION);
114 }
115
116 =head2 C<reap $callback, $context>
117
118 Add a destructor that calls C<$callback> when the upper scope represented by C<$context> ends.
119
120 =head2 C<localize $what, $value, $context>
121
122 A C<local> delayed to the time of first return into the upper scope denoted by C<$context>.
123 C<$what> can be :
124
125 =over 4
126
127 =item *
128
129 A glob, in which case C<$value> can either be a glob or a reference.
130 L</localize> follows then the same syntax as C<local *x = $value>.
131 For example, if C<$value> is a scalar reference, then the C<SCALAR> slot of the glob will be set to C<$$value> - just like C<local *x = \1> sets C<$x> to C<1>.
132
133 =item *
134
135 A string beginning with a sigil, representing the symbol to localize and to assign to.
136 If the sigil is C<'$'>, L</localize> follows the same syntax as C<local $x = $value>, i.e. C<$value> isn't dereferenced.
137 For example,
138
139     localize '$x', \'foo' => HERE;
140
141 will set C<$x> to a reference to the string C<'foo'>.
142 Other sigils (C<'@'>, C<'%'>, C<'&'> and C<'*'>) require C<$value> to be a reference of the corresponding type.
143
144 When the symbol is given by a string, it is resolved when the actual localization takes place and not when C<localize> is called.
145 This means that
146
147     sub tag { localize '$x', $_[0] => UP }
148
149 will localize in the caller's namespace.
150
151 =back
152
153 =head2 C<localize_elem $what, $key, $value, $context>
154
155 Similar to L</localize> but for array and hash elements.
156 If C<$what> is a glob, the slot to fill is determined from which type of reference C<$value> is ; otherwise it's inferred from the sigil.
157 C<$key> is either an array index or a hash key, depending of which kind of variable you localize.
158
159 =head2 C<localize_delete $what, $key, $context>
160
161 Similiar to L</localize>, but for deleting variables or array/hash elements.
162 C<$what> can be:
163
164 =over 4
165
166 =item *
167
168 A glob, in which case C<$key> is ignored and the call is equivalent to C<local *x>.
169
170 =item *
171
172 A string beginning with C<'@'> or C<'%'>, for which the call is equivalent to respectiveley C<local $a[$key]; delete $a[$key]> and C<local $h{$key}; delete $h{$key}>.
173
174 =item *
175
176 A string beginning with C<'&'>, which more or less does C<undef &func> in the upper scope.
177 It's actually more powerful, as C<&func> won't even C<exists> anymore.
178 C<$key> is ignored.
179
180 =back
181
182 =head2 C<unwind @values, $context>
183
184 Returns C<@values> I<from> the context pointed by C<$context>, i.e. from the subroutine, eval or format just above C<$context>, and immediately restart the program flow at this point - thus effectively returning to (or from, depending on how you see it) an upper context.
185
186 The upper context isn't coerced onto C<@values>, which is hence always evaluated in list context.
187 This means that
188
189     my $num = sub {
190      my @a = ('a' .. 'z');
191      unwind @a => HERE;
192     }->();
193
194 will set C<$num> to C<'z'>.
195 You can use L</want_at> to handle these cases.
196
197 =head2 C<want_at $context>
198
199 Like C<wantarray>, but for the subroutine/eval/format just above C<$context>.
200
201 The previous example can then be "corrected" :
202
203     my $num = sub {
204      my @a = ('a' .. 'z');
205      unwind +(want_at(HERE) ? @a : scalar @a) => HERE;
206     }->();
207
208 will righteously set C<$num> to C<26>.
209
210 =head1 WORDS
211
212 =head2 Constants
213
214 =head3 C<TOP>
215
216 Returns the context that currently represents the highest scope.
217
218 =head3 C<HERE>
219
220 The context of the current scope.
221
222 =head2 Getting a context from a context
223
224 For any of those functions, C<$from> is expected to be a context.
225 When omitted, it defaults to the the current context.
226
227 =head3 C<UP $from>
228
229 The context of the scope just above C<$from>.
230
231 =head3 C<SUB $from>
232
233 The context of the closest subroutine above C<$from>.
234 Note that C<$from> is returned if it is already a subroutine context ; hence C<SUB SUB == SUB>.
235
236 =head3 C<EVAL $from>
237
238 The context of the closest eval above C<$from>.
239 Note that C<$from> is returned if it is already an eval context ; hence C<EVAL EVAL == EVAL>.
240
241 =head2 Getting a context from a level
242
243 Here, C<$level> should denote a number of scopes above the current one.
244 When omitted, it defaults to C<0> and those functions return the same context as L</HERE>.
245
246 =head3 C<SCOPE $level>
247
248 The C<$level>-th upper context, regardless of its type.
249
250 =head3 C<CALLER $level>
251
252 The context of the C<$level>-th upper subroutine/eval/format.
253 It kind of corresponds to the context represented by C<caller $level>, but while e.g. C<caller 0> refers to the caller context, C<CALLER 0> will refer to the top scope in the current context.
254
255 =head2 Examples
256
257 Where L</reap> fires depending on the C<$cxt> :
258
259     sub {
260      eval {
261       sub {
262        {
263         reap \&cleanup => $cxt;
264         ...
265        }     # $cxt = SCOPE(0), or HERE
266        ...
267       }->(); # $cxt = SCOPE(1), or UP, or SUB, or CALLER, or CALLER(0)
268       ...
269      };      # $cxt = SCOPE(2), or UP UP, or UP SUB, or EVAL, or CALLER(1)
270      ...
271     }->();   # $cxt = SCOPE(3), or SUB UP SUB, or SUB EVAL, or CALLER(2)
272     ...
273
274 Where L</localize>, L</localize_elem> and L</localize_delete> act depending on the C<$cxt> :
275
276     sub {
277      eval {
278       sub {
279        {
280         localize '$x' => 1 => $cxt;
281         # $cxt = SCOPE(0), or HERE
282         ...
283        }
284        # $cxt = SCOPE(1), or UP, or SUB, or CALLER, or CALLER(0)
285        ...
286       }->();
287       # $cxt = SCOPE(2), or UP UP, or UP SUB, or EVAL, or CALLER(1)
288       ...
289      };
290      # $cxt = SCOPE(3), or SUB UP SUB, or SUB EVAL, or CALLER(2)
291      ...
292     }->();
293     # $cxt = SCOPE(4), UP SUB UP SUB, or UP SUB EVAL, or UP CALLER(2), or TOP
294     ...
295
296 Where L</unwind> and L</want_at> point to depending on the C<$cxt>:
297
298     sub {
299      eval {
300       sub {
301        {
302         unwind @things => $cxt;
303         ...
304        }
305        ...
306       }->(); # $cxt = SCOPE(0 .. 1), or HERE, or UP, or SUB, or CALLER(0)
307       ...
308      };      # $cxt = SCOPE(2), or UP UP, or UP SUB, or EVAL, or CALLER(1)
309      ...
310     }->();   # $cxt = SCOPE(3), or SUB UP SUB, or SUB EVAL, or CALLER(2)
311     ...
312
313 =head1 EXPORT
314
315 The functions L</reap>, L</localize>, L</localize_elem>, L</localize_delete>,  L</unwind> and L</want_at> are only exported on request, either individually or by the tags C<':funcs'> and C<':all'>.
316
317 Same goes for the words L</TOP>, L</HERE>, L</UP>, L</SUB>, L</EVAL>, L</SCOPE> and L</CALLER> that are only exported on request, individually or by the tags C<':words'> and C<':all'>.
318
319 =cut
320
321 use base qw/Exporter/;
322
323 our @EXPORT      = ();
324 our %EXPORT_TAGS = (
325  funcs => [ qw/reap localize localize_elem localize_delete unwind want_at/ ],
326  words => [ qw/TOP HERE UP SUB EVAL SCOPE CALLER/ ],
327 );
328 our @EXPORT_OK   = map { @$_ } values %EXPORT_TAGS;
329 $EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
330
331 =head1 CAVEATS
332
333 Be careful that local variables are restored in the reverse order in which they were localized.
334 Consider those examples:
335
336     local $x = 0;
337     {
338      reap sub { print $x } => HERE;
339      local $x = 1;
340      ...
341     }
342     # prints '0'
343     ...
344     {
345      local $x = 1;
346      reap sub { $x = 2 } => HERE;
347      ...
348     }
349     # $x is 0
350
351 The first case is "solved" by moving the C<local> before the C<reap>, and the second by using L</localize> instead of L</reap>.
352
353 The effects of L</reap>, L</localize> and L</localize_elem> can't cross C<BEGIN> blocks, hence calling those functions in C<import> is deemed to be useless.
354 This is an hopeless case because C<BEGIN> blocks are executed once while localizing constructs should do their job at each run.
355 However, it's possible to hook the end of the current scope compilation with L<B::Hooks::EndOfScope>.
356
357 Some rare oddities may still happen when running inside the debugger.
358 It may help to use a perl higher than 5.8.9 or 5.10.0, as they contain some context-related fixes.
359
360 =head1 DEPENDENCIES
361
362 L<XSLoader> (standard since perl 5.006).
363
364 =head1 SEE ALSO
365
366 L<Alias>, L<Hook::Scope>, L<Scope::Guard>, L<Guard>.
367
368 =head1 AUTHOR
369
370 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
371
372 You can contact me by mail or on C<irc.perl.org> (vincent).
373
374 =head1 BUGS
375
376 Please report any bugs or feature requests to C<bug-scope-upper at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Scope-Upper>.  I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
377
378 =head1 SUPPORT
379
380 You can find documentation for this module with the perldoc command.
381
382     perldoc Scope::Upper
383
384 Tests code coverage report is available at L<http://www.profvince.com/perl/cover/Scope-Upper>.
385
386 =head1 ACKNOWLEDGEMENTS
387
388 Inspired by Ricardo Signes.
389
390 Thanks to Shawn M. Moore for motivation.
391
392 =head1 COPYRIGHT & LICENSE
393
394 Copyright 2008-2009 Vincent Pit, all rights reserved.
395
396 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
397
398 =cut
399
400 1; # End of Scope::Upper