1 package Scope::Context;
11 use Scope::Upper 0.21 ();
15 Scope::Context - Object-oriented interface for inspecting or acting upon upper scope frames.
23 our $VERSION = '0.02';
32 # Create Scope::Context objects for different upper frames :
33 my ($block, $eval, $sub, $loop);
35 $block = Scope::Context->new;
36 $eval = $block->eval; # == $block->up
37 $sub = $block->sub; # == $block->up(2)
38 $loop = $sub->up; # == $block->up(3)
42 # This throws an exception, since $block has expired :
43 $block->localize('$x' => 1);
46 # This will print "hello" when the current eval block ends :
47 $eval->reap(sub { print "hello\n" });
49 # Ignore warnings just for the loop body :
50 $loop->localize_elem('%SIG', __WARN__ => sub { });
52 # Execute the callback as if it ran in place of the sub :
53 my @values = $sub->uplevel(sub {
56 # @values now contains (1, 2).
58 # Immediately return (1, 2, 3) from the sub, bypassing the eval :
59 $sub->unwind(@values, 3);
67 # unwind() returns here. "hello\n" was printed, and now warnings are
71 # $SIG{__WARN__} has been restored to its original value, warnings are no
76 This class provides an object-oriented interface to L<Scope::Upper>'s functionalities.
77 A L<Scope::Context> object represents a currently active dynamic scope (or context), and encapsulates the corresponding L<Scope::Upper>-compatible context identifier.
78 All of L<Scope::Upper>'s functions are then made available as methods.
79 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.
81 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.
86 $cxt = Scope::Context->new;
88 $cxt->reap(sub { print "hello\n });
90 will croak when L</reap> is called.
96 my $cxt = Scope::Context->new;
97 my $cxt = Scope::Context->new($scope_upper_cxt);
99 Creates a new immutable L<Scope::Context> object from the L<Scope::Upper>-comptabile context identifier C<$context>.
100 If omitted, C<$context> defaults to the current context.
105 my ($self, $cxt) = @_;
107 my $class = Scalar::Util::blessed($self);
108 unless (defined $class) {
109 $class = defined $self ? $self : __PACKAGE__;
112 $cxt = Scope::Upper::UP() unless defined $cxt;
116 uid => Scope::Upper::uid($cxt),
122 A synonym for L</new>.
138 my $scope_upper_cxt = $cxt->cxt;
140 Read-only accessor to the L<Scope::Upper> context identifier associated with the invocant.
146 Read-only accessor to the L<Scope::Upper> unique identifier representing the L<Scope::Upper> context associated with the invocant.
152 eval "sub $_ { \$_[0]->{$_} }; 1" or die $@ for qw<cxt uid>;
157 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.
163 my ($left, $right) = @_;
165 unless (Scalar::Util::blessed($right) and $right->isa(__PACKAGE__)) {
166 $left->_croak('Cannot compare a Scope::Context object with something else');
169 $left->uid eq $right->uid;
176 my $is_valid = $cxt->is_valid;
178 Returns true if and only if the invocant is still valid (that is, it designates a scope that is higher on the call stack than the current scope).
182 sub is_valid { Scope::Upper::validate_uid($_[0]->uid) }
184 =head2 C<assert_valid>
188 Throws an exception if the invocant has expired and is no longer valid.
189 Returns true otherwise.
196 $self->_croak('Context has expired') unless $self->is_valid;
205 Returns the namespace in use when the scope denoted by the invocant begins.
211 Returns the name of the file where the scope denoted by the invocant belongs to.
217 Returns the line number where the scope denoted by the invocant begins.
223 Returns the name of the subroutine called for this context, or C<undef> if this is not a subroutine context.
225 =head2 C<sub_has_args>
229 Returns a boolean indicating whether a new instance of C<@_> was set up for this context, or C<undef> if this is not a subroutine context.
235 Returns the context (in the sense of C<perlfunc/wantarray> : C<undef> for void context, C<''> for scalar context, and true for list context) in which the scope denoted by the invocant is executed.
241 Returns the contents of the string being compiled for this context, or C<undef> if this is not an eval context.
247 Returns a boolean indicating whether this eval context was created by C<require>, or C<undef> if this is not an eval context.
253 Returns the value of the lexical hints bit mask (available as C<$^H> at compile time) in use when the scope denoted by the invocant begins.
255 =head2 C<warnings_bits>
259 Returns the bit string representing the warnings (available as C<${^WARNING_BITS}> at compile time) in use when the scope denoted by the invocant begins.
265 Returns a reference to the lexical hints hash (available as C<%^H> at compile time) in use when the scope denoted by the invocant begins.
266 This method is available only on perl 5.10 and greater.
282 (hints_hash => 10) x ("$]" >= 5.010),
285 for my $name (sort { $infos{$a} <=> $infos{$b} } keys %infos) {
286 my $idx = $infos{$name};
292 \$self->assert_valid;
294 my \$info = \$self->{info};
295 \$info = \$self->{info} = [ Scope::Upper::context_info(\$self->cxt) ]
298 return \$info->[$idx];
307 my $want = $cxt->want;
309 Returns the Perl context (in the sense of C<perlfunc/wantarray>) in which is executed the closest subroutine, eval or format enclosing the scope pointed by the invocant.
318 Scope::Upper::want_at($self->cxt);
323 my $up_cxt = $cxt->up;
324 my $up_cxt = $cxt->up($frames);
325 my $up_cxt = Scope::Context->up;
327 Returns a new L<Scope::Context> object pointing to the C<$frames>-th upper scope above the scope pointed by the invocant.
329 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 representing the current context.
331 If omitted, C<$frames> defaults to C<1>.
336 my $up = Scope::Context->new->up(2); # == Scope::Context->up(2)
337 # $up points two contextes above this one, which is the sub.
345 my ($self, $frames) = @_;
348 if (Scalar::Util::blessed($self)) {
352 $cxt = Scope::Upper::UP(Scope::Upper::SUB());
355 $frames = 1 unless defined $frames;
357 $cxt = Scope::Upper::UP($cxt) for 1 .. $frames;
364 my $sub_cxt = $cxt->sub;
365 my $sub_cxt = $cxt->sub($frames);
366 my $sub_cxt = Scope::Context->sub;
368 Returns a new L<Scope::Context> object pointing to the C<$frames + 1>-th subroutine scope above the scope pointed by the invocant.
370 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.
372 If omitted, C<$frames> defaults to C<0>, which results in the closest sub enclosing the scope pointed by the invocant.
381 my $sub = Scope::Context->new->sub(1); # == Scope::Context->sub(1)
382 # $sub points to the context for the outer() sub.
388 my ($self, $frames) = @_;
391 if (Scalar::Util::blessed($self)) {
395 $cxt = Scope::Upper::UP(Scope::Upper::SUB());
398 $frames = 0 unless defined $frames;
400 $cxt = Scope::Upper::SUB($cxt);
401 $cxt = Scope::Upper::SUB(Scope::Upper::UP($cxt)) for 1 .. $frames;
408 my $eval_cxt = $cxt->eval;
409 my $eval_cxt = $cxt->eval($frames);
410 my $eval_cxt = Scope::Context->eval;
412 Returns a new L<Scope::Context> object pointing to the C<$frames + 1>-th C<eval> scope above the scope pointed by the invocant.
414 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.
416 If omitted, C<$frames> defaults to C<0>, which results in the closest eval enclosing the scope pointed by the invocant.
420 my $eval = Scope::Context->new->eval; # == Scope::Context->eval
421 # $eval points to the eval context.
428 my ($self, $frames) = @_;
431 if (Scalar::Util::blessed($self)) {
435 $cxt = Scope::Upper::UP(Scope::Upper::SUB());
438 $frames = 0 unless defined $frames;
440 $cxt = Scope::Upper::EVAL($cxt);
441 $cxt = Scope::Upper::EVAL(Scope::Upper::UP($cxt)) for 1 .. $frames;
450 Execute C<$code> when the scope pointed by the invocant ends.
452 See L<Scope::Upper/reap> for details.
457 my ($self, $code) = @_;
461 &Scope::Upper::reap($code, $self->cxt);
466 $cxt->localize($what, $value);
468 Localize the variable described by C<$what> to the value C<$value> when the control flow returns to the scope pointed by the invocant.
470 See L<Scope::Upper/localize> for details.
475 my ($self, $what, $value) = @_;
479 Scope::Upper::localize($what, $value, $self->cxt);
482 =head2 C<localize_elem>
484 $cxt->localize_elem($what, $key, $value);
486 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 invocant.
488 See L<Scope::Upper/localize_elem> for details.
493 my ($self, $what, $key, $value) = @_;
497 Scope::Upper::localize_elem($what, $key, $value, $self->cxt);
500 =head2 C<localize_delete>
502 $cxt->localize_delete($what, $key);
504 Delete the element C<$key> from the variable C<$what> when the control flow returns to the scope pointed by the invocant.
506 See L<Scope::Upper/localize_delete> for details.
510 sub localize_delete {
511 my ($self, $what, $key) = @_;
515 Scope::Upper::localize_delete($what, $key, $self->cxt);
520 $cxt->unwind(@values);
522 Immediately returns the scalars listed in C<@values> from the closest subroutine enclosing the scope pointed by the invocant.
524 See L<Scope::Upper/unwind> for details.
533 Scope::Upper::unwind(@_ => $self->cxt);
538 $cxt->yield(@values);
540 Immediately returns the scalars listed in C<@values> from the scope pointed by the invocant, whatever it may be (except a substitution eval context).
542 See L<Scope::Upper/yield> for details.
551 Scope::Upper::yield(@_ => $self->cxt);
556 my @ret = $cxt->uplevel($code, @args);
558 Executes the code reference C<$code> with arguments C<@args> in the same setting as the closest subroutine enclosing the scope pointed by the invocant, then returns to the current scope the values returned by C<$code>.
560 See L<Scope::Upper/uplevel> for details.
570 &Scope::Upper::uplevel($code => @_ => $self->cxt);
575 L<Carp> (core module since perl 5), L<Scalar::Util> (since 5.7.3).
577 L<Scope::Upper> 0.21.
583 L<Continuation::Escape>.
587 Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
589 You can contact me by mail or on C<irc.perl.org> (vincent).
593 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>.
594 I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
598 You can find documentation for this module with the perldoc command.
600 perldoc Scope::Context
602 =head1 COPYRIGHT & LICENSE
604 Copyright 2011,2012,2013,2015 Vincent Pit, all rights reserved.
606 This program is free software; you can redistribute it and/or modify it
607 under the same terms as Perl itself.
611 1; # End of Scope::Context