lib/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.06
  13
  14 =cut
  15
  16 our $VERSION;
  17 BEGIN {
  18  $VERSION = '0.06';
  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 that will take place when the control flow returns into an upper scope.
  83 Currently, you can hook an upper scope end, or localize variables, array/hash values or deletions of elements in higher contexts.
  84 You can also return to an upper level and know which context was in use then.
  85
  86 =head1 FUNCTIONS
  87
  88 In all those functions, C<$context> refers to the target scope.
  89
  90 You have to use one or a combination of L</WORDS> to build the C<$context> to pass to these functions.
  91 This is needed in order to ensure that the module still works when your program is ran in the debugger.
  92 Don't try to use a raw value or things will get messy.
  93
  94 The only thing you can assume is that it is an I<absolute> indicator of the frame.
  95 This means that you can safely store it at some point and use it when needed, and it will still denote the original scope.
  96
  97 =cut
  98
  99 BEGIN {
 100  require XSLoader;
 101  XSLoader::load(__PACKAGE__, $VERSION);
 102 }
 103
 104 =head2 C<reap $callback, $context>
 105
 106 Add a destructor that calls C<$callback> when the upper scope represented by C<$context> ends.
 107
 108 =head2 C<localize $what, $value, $context>
 109
 110 A C<local> delayed to the time of first return into the upper scope denoted by C<$context>.
 111 C<$what> can be :
 112
 113 =over 4
 114
 115 =item *
 116
 117 A glob, in which case C<$value> can either be a glob or a reference.
 118 L</localize> follows then the same syntax as C<local *x = $value>.
 119 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>.
 120
 121 =item *
 122
 123 A string beginning with a sigil, representing the symbol to localize and to assign to.
 124 If the sigil is C<'$'>, L</localize> follows the same syntax as C<local $x = $value>, i.e. C<$value> isn't dereferenced.
 125 For example,
 126
 127     localize '$x', \'foo' => HERE;
 128
 129 will set C<$x> to a reference to the string C<'foo'>.
 130 Other sigils (C<'@'>, C<'%'>, C<'&'> and C<'*'>) require C<$value> to be a reference of the corresponding type.
 131
 132 When the symbol is given by a string, it is resolved when the actual localization takes place and not when C<localize> is called.
 133 This means that
 134
 135     sub tag { localize '$x', $_[0] => UP }
 136
 137 will localize in the caller's namespace.
 138
 139 =back
 140
 141 =head2 C<localize_elem $what, $key, $value, $context>
 142
 143 Similar to L</localize> but for array and hash elements.
 144 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.
 145 C<$key> is either an array index or a hash key, depending of which kind of variable you localize.
 146
 147 =head2 C<localize_delete $what, $key, $context>
 148
 149 Similiar to L</localize>, but for deleting variables or array/hash elements.
 150 C<$what> can be:
 151
 152 =over 4
 153
 154 =item *
 155
 156 A glob, in which case C<$key> is ignored and the call is equivalent to C<local *x>.
 157
 158 =item *
 159
 160 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}>.
 161
 162 =item *
 163
 164 A string beginning with C<'&'>, which more or less does C<undef &func> in the upper scope.
 165 It's actually more powerful, as C<&func> won't even C<exists> anymore.
 166 C<$key> is ignored.
 167
 168 =back
 169
 170 =head2 C<unwind @values, $context>
 171
 172 Returns C<@values> I<from> the context pointed by C<$context>, i.e. from the subroutine, eval or format just above C<$context>.
 173
 174 The upper context isn't coerced onto C<@values>, which is hence always evaluated in list context.
 175 This means that
 176
 177     my $num = sub {
 178      my @a = ('a' .. 'z');
 179      unwind @a => HERE;
 180     }->();
 181
 182 will set C<$num> to C<'z'>.
 183 You can use L</want_at> to handle these cases.
 184
 185 =head2 C<want_at $context>
 186
 187 Like C<wantarray>, but for the subroutine/eval/format just above C<$context>.
 188
 189 The previous example can then be "corrected" :
 190
 191     my $num = sub {
 192      my @a = ('a' .. 'z');
 193      unwind +(want_at(HERE) ? @a : scalar @a) => HERE;
 194     }->();
 195
 196 will righteously set C<$num> to C<26>.
 197
 198 =head1 WORDS
 199
 200 =head2 Constants
 201
 202 =head3 C<TOP>
 203
 204 Returns the context that currently represents the highest scope.
 205
 206 =head3 C<HERE>
 207
 208 The context of the current scope.
 209
 210 =head2 Getting a context from a context
 211
 212 For any of those functions, C<$from> is expected to be a context.
 213 When omitted, it defaults to the the current context.
 214
 215 =head3 C<UP $from>
 216
 217 The context of the scope just above C<$from>.
 218
 219 =head3 C<SUB $from>
 220
 221 The context of the closest subroutine above C<$from>.
 222
 223 =head3 C<EVAL $from>
 224
 225 The context of the closest eval above C<$from>.
 226
 227 =head2 Getting a context from a level
 228
 229 Here, C<$level> should denote a number of scopes above the current one.
 230 When omitted, it defaults to C<0> and those functions return the same context as L</HERE>.
 231
 232 =head3 C<SCOPE $level>
 233
 234 The C<$level>-th upper context, regardless of its type.
 235
 236 =head3 C<CALLER $level>
 237
 238 The context of the C<$level>-th upper subroutine/eval/format.
 239 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.
 240
 241 =head1 EXPORT
 242
 243 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'>.
 244
 245 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'>.
 246
 247 =cut
 248
 249 use base qw/Exporter/;
 250
 251 our @EXPORT      = ();
 252 our %EXPORT_TAGS = (
 253  funcs => [ qw/reap localize localize_elem localize_delete unwind want_at/ ],
 254  words => [ qw/TOP HERE UP SUB EVAL SCOPE CALLER/ ],
 255 );
 256 our @EXPORT_OK   = map { @$_ } values %EXPORT_TAGS;
 257 $EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
 258
 259 =head1 CAVEATS
 260
 261 Be careful that local variables are restored in the reverse order in which they were localized.
 262 Consider those examples:
 263
 264     local $x = 0;
 265     {
 266      reap sub { print $x } => HERE;
 267      local $x = 1;
 268      ...
 269     }
 270     # prints '0'
 271     ...
 272     {
 273      local $x = 1;
 274      reap sub { $x = 2 } => HERE;
 275      ...
 276     }
 277     # $x is 0
 278
 279 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>.
 280
 281 L</reap>, L</localize> and L</localize_elem> effects can't cross C<BEGIN> blocks, hence calling those functions in C<import> is deemed to be useless.
 282 This is an hopeless case because C<BEGIN> blocks are executed once while localizing constructs should do their job at each run.
 283
 284 Some rare oddities may still happen when running inside the debugger.
 285 It may help to use a perl higher than 5.8.9 or 5.10.0, as they contain some context fixes.
 286
 287 =head1 DEPENDENCIES
 288
 289 L<XSLoader> (standard since perl 5.006).
 290
 291 =head1 SEE ALSO
 292
 293 L<Alias>, L<Hook::Scope>, L<Scope::Guard>, L<Guard>.
 294
 295 =head1 AUTHOR
 296
 297 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
 298
 299 You can contact me by mail or on C<irc.perl.org> (vincent).
 300
 301 =head1 BUGS
 302
 303 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.
 304
 305 =head1 SUPPORT
 306
 307 You can find documentation for this module with the perldoc command.
 308
 309     perldoc Scope::Upper
 310
 311 Tests code coverage report is available at L<http://www.profvince.com/perl/cover/Scope-Upper>.
 312
 313 =head1 ACKNOWLEDGEMENTS
 314
 315 Inspired by Ricardo Signes.
 316
 317 Thanks to Shawn M. Moore for motivation.
 318
 319 =head1 COPYRIGHT & LICENSE
 320
 321 Copyright 2008-2009 Vincent Pit, all rights reserved.
 322
 323 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 324
 325 =cut
 326
 327 1; # End of Scope::Upper