1 package Scope::Context;
11 use Scope::Upper 0.18 ();
15 Scope::Context - Object-oriented interface for inspecting or acting upon upper scope frames.
23 our $VERSION = '0.01';
32 # create Scope::Context objects
33 my ($block, $sub, $eval, $loop);
35 $block = Scope::Context->new;
36 $sub = $block->sub; # = $block->up
37 $eval = $block->eval; # = $block->up(2)
38 $loop = $eval->up; # = $block->up(3)
42 # This will throw an exception, since $block has expired.
43 $block->localize('$x' => 1);
46 # This prints "hello" when the eval block above ends.
47 $eval->reap(sub { print "hello\n" });
49 # Ignore $SIG{__DIE__} just for the loop.
50 $loop->localize_delete('%SIG', '__DIE__');
52 # Execute the callback as if it ran in place of the sub.
53 my @values = $sub->uplevel(sub {
57 # Immediately return (1, 2, 3) from the sub, bypassing the eval.
58 $sub->unwind(@values, 3);
65 This class provides an object-oriented interface to L<Scope::Upper>'s functionalities.
66 A L<Scope::Context> object represents a currently active dynamic scope (or context), and encapsulates the corresponding L<Scope::Upper>-compatible context identifier.
67 All of L<Scope::Upper>'s functions are then made available as methods.
68 This gives you a prettier and safer interface when you are not reaching for extreme performance, but rest assured that the overhead of this module is minimal anyway.
70 The L<Scope::Context> methods actually do more than their subroutine counterparts from L<Scope::Upper> : before each call, the target context will be checked to ensure it is still active (which means that it is still present in the current call stack), and an exception will be thrown if you attempt to act on a context that has already expired.
75 $sc = Scope::Context->new;
77 $sc->reap(sub { print "hello\n });
79 will croak when L</reap> is called.
83 =head2 C<new [ $context ]>
85 Creates a new immutable L<Scope::Context> object from the L<Scope::Upper>-comptabile context C<$context>.
86 If omitted, C<$context> defaults to the current context.
91 my ($self, $cxt) = @_;
93 my $class = Scalar::Util::blessed($self);
94 unless (defined $class) {
95 $class = defined $self ? $self : __PACKAGE__;
98 $cxt = Scope::Upper::UP() unless defined $cxt;
102 uid => Scope::Upper::uid($cxt),
108 A synonym for L</new>.
124 Read-only accessor to the L<Scope::Upper> context corresponding to the topic L<Scope::Context> object.
128 Read-only accessor to the L<Scope::Upper> UID of the topic L<Scope::Context> object.
134 eval "sub $_ { \$_[0]->{$_} }; 1" or die $@ for qw<cxt uid>;
139 This class also overloads the C<==> operator, which will return true if and only if its two operands are L<Scope::Context> objects that have the same UID.
145 my ($left, $right) = @_;
147 unless (Scalar::Util::blessed($right) and $right->isa(__PACKAGE__)) {
148 $left->_croak('Cannot compare a Scope::Context object with something else');
151 $left->uid eq $right->uid;
158 Returns true if and only if the topic context is still valid (that is, it designates a scope that is higher than the topic context in the call stack).
162 sub is_valid { Scope::Upper::validate_uid($_[0]->uid) }
164 =head2 C<assert_valid>
166 Throws an exception if the topic context has expired and is no longer valid.
167 Returns true otherwise.
174 $self->_croak('Context has expired') unless $self->is_valid;
181 Returns the Perl context (in the sense of C<wantarray> : C<undef> for void context, C<''> for scalar context, and true for list context) in which is executed the scope corresponding to the topic L<Scope::Context> object.
190 Scope::Upper::want_at($self->cxt);
193 =head2 C<up [ $frames ]>
195 Returns a new L<Scope::Context> object pointing to the C<$frames>-th upper scope above the topic context.
197 This method can also be invoked as a class method, in which case it is equivalent to calling L</up> on a L<Scope::Context> object for the current context.
199 If omitted, C<$frames> defaults to C<1>.
204 my $up = Scope::Context->new->up(2); # = Scope::Context->up(2)
205 # $up points two contextes above this one, which is the sub.
213 my ($self, $frames) = @_;
215 if (Scalar::Util::blessed($self)) {
218 $self = $self->new(Scope::Upper::UP(Scope::Upper::SUB()));
221 $frames = 1 unless defined $frames;
223 my $cxt = $self->cxt;
224 $cxt = Scope::Upper::UP($cxt) for 1 .. $frames;
229 =head2 C<sub [ $frames ]>
231 Returns a new L<Scope::Context> object pointing to the C<$frames>-th subroutine scope above the topic context.
233 This method can also be invoked as a class method, in which case it is equivalent to calling L</sub> on a L<Scope::Context> object for the current context.
235 If omitted, C<$frames> defaults to C<0>, which results in the closest sub enclosing the topic context.
244 my $sub = Scope::Context->new->sub(1); # = Scope::Context->sub
245 # $sub points to the context for the outer() sub.
251 my ($self, $frames) = @_;
253 if (Scalar::Util::blessed($self)) {
256 $self = $self->new(Scope::Upper::UP(Scope::Upper::SUB()));
259 $frames = 0 unless defined $frames;
261 my $cxt = Scope::Upper::SUB($self->cxt);
262 $cxt = Scope::Upper::SUB(Scope::Upper::UP($cxt)) for 1 .. $frames;
267 =head2 C<eval [ $frames ]>
269 Returns a new L<Scope::Context> object pointing to the C<$frames>-th C<eval> scope above the topic context.
271 This method can also be invoked as a class method, in which case it is equivalent to calling L</eval> on a L<Scope::Context> object for the current context.
273 If omitted, C<$frames> defaults to C<0>, which results in the closest eval enclosing the topic context.
277 my $eval = Scope::Context->new->eval; # = Scope::Context->eval
278 # $eval points to the eval context.
285 my ($self, $frames) = @_;
287 if (Scalar::Util::blessed($self)) {
290 $self = $self->new(Scope::Upper::UP(Scope::Upper::SUB()));
293 $frames = 0 unless defined $frames;
295 my $cxt = Scope::Upper::EVAL($self->cxt);
296 $cxt = Scope::Upper::EVAL(Scope::Upper::UP($cxt)) for 1 .. $frames;
303 Execute C<$code> when the topic context ends.
305 See L<Scope::Upper/reap> for details.
310 my ($self, $code) = @_;
314 &Scope::Upper::reap($code, $self->cxt);
317 =head2 C<localize $what, $value>
319 Localize the variable described by C<$what> to the value C<$value> when the control flow returns to the scope pointed by the topic context.
321 See L<Scope::Upper/localize> for details.
326 my ($self, $what, $value) = @_;
330 Scope::Upper::localize($what, $value, $self->cxt);
333 =head2 C<localize_elem $what, $key, $value>
335 Localize the element C<$key> of the variable C<$what> to the value C<$value> when the control flow returns to the scope pointed by the topic context.
337 See L<Scope::Upper/localize_elem> for details.
342 my ($self, $what, $key, $value) = @_;
346 Scope::Upper::localize_elem($what, $key, $value, $self->cxt);
349 =head2 C<localize_delete $what, $key>
351 Delete the element C<$key> from the variable C<$what> when the control flow returns to the scope pointed by the topic context.
353 See L<Scope::Upper/localize_delete> for details.
357 sub localize_delete {
358 my ($self, $what, $key) = @_;
362 Scope::Upper::localize_delete($what, $key, $self->cxt);
365 =head2 C<unwind @values>
367 Immediately returns the scalars listed in C<@values> from the closest subroutine enclosing the topic context.
369 See L<Scope::Upper/unwind> for details.
378 Scope::Upper::unwind(@_ => $self->cxt);
381 =head2 C<uplevel $code, @args>
383 Executes the code reference C<$code> with arguments C<@args> in the same setting as the closest subroutine enclosing the topic context, then returns to the current scope the values returned by C<$code>.
385 See L<Scope::Upper/uplevel> for details.
395 &Scope::Upper::uplevel($code => @_ => $self->cxt);
400 L<Carp> (core module since perl 5), L<Scalar::Util> (since 5.7.3).
402 L<Scope::Upper> 0.18.
408 L<Continuation::Escape>.
412 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
414 You can contact me by mail or on C<irc.perl.org> (vincent).
418 Please report any bugs or feature requests to C<bug-scope-context at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Scope-Context>.
419 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
423 You can find documentation for this module with the perldoc command.
425 perldoc Scope::Context
427 =head1 COPYRIGHT & LICENSE
429 Copyright 2011 Vincent Pit, all rights reserved.
431 This program is free software; you can redistribute it and/or modify it
432 under the same terms as Perl itself.
436 1; # End of Scope::Context