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.04
  13
  14 =cut
  15
  16 our $VERSION;
  17 BEGIN {
  18  $VERSION = '0.04';
  19 }
  20
  21 =head1 SYNOPSIS
  22
  23     package X;
  24
  25     use Scope::Upper qw/reap localize localize_elem localize_delete/;
  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__) => 1;
  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      } => 1;
  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      } => 1;
  46
  47      localize_delete '@ARGV', $#ARGV => 1; # delete last @ARGV element
  48     }
  49
  50     package Y;
  51
  52     {
  53      X::set_tag('pie');
  54      # $x is now a X object, and @ARGV has one element less
  55      warn 'what'; # warns "pie: what at ..."
  56      ...
  57     } # "pie: done" is printed
  58
  59     package Z;
  60
  61     use Scope::Upper qw/unwind want_at :words/;
  62
  63     sub try (&) {
  64      my @result = shift->();
  65      my $cx = SUB UP SUB;
  66      unwind +(want_at($cx) ? @result : scalar @result) => $cx;
  67     }
  68
  69     ...
  70
  71     sub zap {
  72      try {
  73       return @things; # returns to try() and then outside zap()
  74      }
  75     }
  76
  77     my @what = zap(); # @what contains @things
  78
  79 =head1 DESCRIPTION
  80
  81 This module lets you defer actions that will take place when the control flow returns into an upper scope.
  82 Currently, you can hook an upper scope end, or localize variables, array/hash values or deletions of elements in higher contexts.
  83
  84 =head1 FUNCTIONS
  85
  86 =cut
  87
  88 BEGIN {
  89  require XSLoader;
  90  XSLoader::load(__PACKAGE__, $VERSION);
  91 }
  92
  93 =head2 C<reap $callback, $level>
  94
  95 Add a destructor that calls C<$callback> when the C<$level>-th upper scope ends, where C<0> corresponds to the current scope.
  96
  97 =head2 C<localize $what, $value, $level>
  98
  99 A C<local> delayed to the time of first return into the C<$level>-th upper scope.
 100 C<$what> can be :
 101
 102 =over 4
 103
 104 =item *
 105
 106 A glob, in which case C<$value> can either be a glob or a reference.
 107 L</localize> follows then the same syntax as C<local *x = $value>.
 108 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>.
 109
 110 =item *
 111
 112 A string beginning with a sigil, representing the symbol to localize and to assign to.
 113 If the sigil is C<'$'>, L</localize> follows the same syntax as C<local $x = $value>, i.e. C<$value> isn't dereferenced.
 114 For example,
 115
 116     localize '$x', \'foo' => 0;
 117
 118 will set C<$x> to a reference to the string C<'foo'>.
 119 Other sigils (C<'@'>, C<'%'>, C<'&'> and C<'*'>) require C<$value> to be a reference of the corresponding type.
 120
 121 When the symbol is given by a string, it is resolved when the actual localization takes place and not when C<localize> is called.
 122 This means that
 123
 124     sub tag { localize '$x', $_[0] => 1; }
 125
 126 will localize in the caller's namespace.
 127
 128 =back
 129
 130 =head2 C<localize_elem $what, $key, $value, $level>
 131
 132 Similar to L</localize> but for array and hash elements.
 133 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.
 134 C<$key> is either an array index or a hash key, depending of which kind of variable you localize.
 135
 136 =head2 C<localize_delete $what, $key, $level>
 137
 138 Similiar to L</localize>, but for deleting variables or array/hash elements.
 139 C<$what> can be:
 140
 141 =over 4
 142
 143 =item *
 144
 145 A glob, in which case C<$key> is ignored and the call is equivalent to C<local *x>.
 146
 147 =item *
 148
 149 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}>.
 150
 151 =item *
 152
 153 A string beginning with C<'&'>, which more or less does C<undef &func> in the upper scope.
 154 It's actually more powerful, as C<&func> won't even C<exists> anymore.
 155 C<$key> is ignored.
 156
 157 =back
 158
 159 =head2 C<unwind @values, $level>
 160
 161 Returns C<@values> I<from> the context indicated by C<$level>, i.e. from the subroutine, eval or format just above C<$level>.
 162 The upper level isn't coerced onto C<@values>, which is hence always evaluated in list context.
 163
 164 =head2 C<want_at $level>
 165
 166 Like C<wantarray>, but for the subroutine/eval/format context just above C<$level>.
 167
 168 =head1 WORDS
 169
 170 =head2 C<TOP>
 171
 172 Returns the level that currently represents the highest scope.
 173
 174 =head2 C<HERE>
 175
 176 The current level - i.e. C<0>.
 177
 178 =head2 C<UP $from>
 179
 180 The level of the scope just above C<$from>.
 181
 182 =head2 C<DOWN $from>
 183
 184 The level of the scope just below C<$from>.
 185
 186 =head2 C<SUB $from>
 187
 188 The level of the closest subroutine context above C<$from>.
 189
 190 =head2 C<EVAL $from>
 191
 192 The level of the closest eval context above C<$from>.
 193
 194 If C<$from> is omitted in any of those functions, the current level is used as the reference level.
 195
 196 =head2 C<CALLER $stack>
 197
 198 The level corresponding to the stack referenced by C<caller $stack>.
 199
 200 =head1 EXPORT
 201
 202 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'>.
 203
 204 Same goes for the words L</TOP>, L</HERE>, L</UP>, L</DOWN>, L</SUB>, L</EVAL> and L</CALLER> that are only exported on request, individually or by the tags C<':words'> and C<':all'>.
 205
 206 =cut
 207
 208 use base qw/Exporter/;
 209
 210 our @EXPORT      = ();
 211 our %EXPORT_TAGS = (
 212  funcs => [ qw/reap localize localize_elem localize_delete unwind want_at/ ],
 213  words => [ qw/TOP HERE UP DOWN SUB EVAL CALLER/ ],
 214 );
 215 our @EXPORT_OK   = map { @$_ } values %EXPORT_TAGS;
 216 $EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
 217
 218 =head1 CAVEATS
 219
 220 Be careful that local variables are restored in the reverse order in which they were localized.
 221 Consider those examples:
 222
 223     local $x = 0;
 224     {
 225      reap sub { print $x } => 0;
 226      local $x = 1;
 227      ...
 228     }
 229     # prints '0'
 230     ...
 231     {
 232      local $x = 1;
 233      reap sub { $x = 2 } => 0;
 234      ...
 235     }
 236     # $x is 0
 237
 238 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>.
 239
 240 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.
 241 This is an hopeless case because C<BEGIN> blocks are executed once while localizing constructs should do their job at each run.
 242
 243 =head1 DEPENDENCIES
 244
 245 L<XSLoader> (standard since perl 5.006).
 246
 247 =head1 SEE ALSO
 248
 249 L<Alias>, L<Hook::Scope>, L<Scope::Guard>, L<Guard>.
 250
 251 =head1 AUTHOR
 252
 253 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
 254
 255 You can contact me by mail or on C<irc.perl.org> (vincent).
 256
 257 =head1 BUGS
 258
 259 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.
 260
 261 =head1 SUPPORT
 262
 263 You can find documentation for this module with the perldoc command.
 264
 265     perldoc Scope::Upper
 266
 267 Tests code coverage report is available at L<http://www.profvince.com/perl/cover/Scope-Upper>.
 268
 269 =head1 ACKNOWLEDGEMENTS
 270
 271 Inspired by Ricardo Signes.
 272
 273 =head1 COPYRIGHT & LICENSE
 274
 275 Copyright 2008-2009 Vincent Pit, all rights reserved.
 276
 277 This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
 278
 279 =cut
 280
 281 1; # End of Scope::Upper