use Carp ();
use Scalar::Util ();
-use Scope::Upper 0.18 ();
+use Scope::Upper 0.21 ();
=head1 NAME
=head1 VERSION
-Version 0.01
+Version 0.02
=cut
-our $VERSION = '0.01';
+our $VERSION = '0.02';
=head1 SYNOPSIS
for (1 .. 5) {
sub {
eval {
- # create Scope::Context objects
- my ($block, $sub, $eval, $loop);
+ # Create Scope::Context objects for different upper frames :
+ my ($block, $eval, $sub, $loop);
{
$block = Scope::Context->new;
- $sub = $block->sub; # = $block->up
- $eval = $block->eval; # = $block->up(2)
- $loop = $eval->up; # = $block->up(3)
+ $eval = $block->eval; # == $block->up
+ $sub = $block->sub; # == $block->up(2)
+ $loop = $sub->up; # == $block->up(3)
}
eval {
- # This will throw an exception, since $block has expired.
+ # This throws an exception, since $block has expired :
$block->localize('$x' => 1);
};
- # This prints "hello" when the eval block above ends.
+ # This will print "hello" when the current eval block ends :
$eval->reap(sub { print "hello\n" });
- # Ignore $SIG{__DIE__} just for the loop.
- $loop->localize_delete('%SIG', '__DIE__');
+ # Ignore warnings just for the loop body :
+ $loop->localize_elem('%SIG', __WARN__ => sub { });
- # Execute the callback as if it ran in place of the sub.
+ # Execute the callback as if it ran in place of the sub :
my @values = $sub->uplevel(sub {
return @_, 2;
}, 1);
+ # @values now contains (1, 2).
- # Immediately return (1, 2, 3) from the sub, bypassing the eval.
+ # Immediately return (1, 2, 3) from the sub, bypassing the eval :
$sub->unwind(@values, 3);
+
+ # Not reached.
}
+
+ # Not reached.
}->();
+
+ # unwind() returns here. "hello\n" was printed, and now warnings are
+ # ignored.
}
+ # $SIG{__WARN__} has been restored to its original value, warnings are no
+ # longer ignored.
+
=head1 DESCRIPTION
This class provides an object-oriented interface to L<Scope::Upper>'s functionalities.
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.
This means that :
- my $sc;
+ my $cxt;
{
- $sc = Scope::Context->new;
+ $cxt = Scope::Context->new;
}
- $sc->reap(sub { print "hello\n });
+ $cxt->reap(sub { print "hello\n });
will croak when L</reap> is called.
=head1 METHODS
-=head2 C<new [ $context ]>
+=head2 C<new>
+
+ my $cxt = Scope::Context->new;
+ my $cxt = Scope::Context->new($scope_upper_cxt);
-Creates a new immutable L<Scope::Context> object from the L<Scope::Upper>-comptabile context C<$context>.
+Creates a new immutable L<Scope::Context> object from the L<Scope::Upper>-comptabile context identifier C<$context>.
If omitted, C<$context> defaults to the current context.
=cut
=head2 C<cxt>
-Read-only accessor to the L<Scope::Upper> context corresponding to the topic L<Scope::Context> object.
+ my $scope_upper_cxt = $cxt->cxt;
+
+Read-only accessor to the L<Scope::Upper> context identifier associated with the invocant.
=head2 C<uid>
-Read-only accessor to the L<Scope::Upper> UID of the topic L<Scope::Context> object.
+ my $uid = $cxt->uid;
+
+Read-only accessor to the L<Scope::Upper> unique identifier representing the L<Scope::Upper> context associated with the invocant.
=cut
=head2 C<is_valid>
-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).
+ my $is_valid = $cxt->is_valid;
+
+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).
=cut
=head2 C<assert_valid>
-Throws an exception if the topic context has expired and is no longer valid.
+ $cxt->assert_valid;
+
+Throws an exception if the invocant has expired and is no longer valid.
Returns true otherwise.
=cut
1;
}
+=head2 C<package>
+
+ $cxt->package;
+
+Returns the namespace in use when the scope denoted by the invocant begins.
+
+=head2 C<file>
+
+ $cxt->file;
+
+Returns the name of the file where the scope denoted by the invocant belongs to.
+
+=head2 C<line>
+
+ $cxt->line;
+
+Returns the line number where the scope denoted by the invocant begins.
+
+=head2 C<sub_name>
+
+ $cxt->sub_name;
+
+Returns the name of the subroutine called for this context, or C<undef> if this is not a subroutine context.
+
+=head2 C<sub_has_args>
+
+ $cxt->sub_has_args;
+
+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.
+
+=head2 C<gimme>
+
+ $cxt->gimme;
+
+Returns the context (in the sense of L<perlfunc/wantarray>) in which the scope denoted by the invocant is executed.
+
+=head2 C<eval_text>
+
+ $cxt->eval_text;
+
+Returns the contents of the string being compiled for this context, or C<undef> if this is not an eval context.
+
+=head2 C<is_require>
+
+ $cxt->is_require;
+
+Returns a boolean indicating whether this eval context was created by C<require>, or C<undef> if this is not an eval context.
+
+=head2 C<hints_bits>
+
+ $cxt->hints_bits;
+
+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.
+
+=head2 C<warnings_bits>
+
+ $cxt->warnings_bits;
+
+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.
+
+=head2 C<hints_hash>
+
+ $cxt->hints_hash;
+
+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.
+This method is available only on perl 5.10 and greater.
+
+=cut
+
+BEGIN {
+ my %infos = (
+ package => 0,
+ file => 1,
+ line => 2,
+ sub_name => 3,
+ sub_has_args => 4,
+ gimme => 5,
+ eval_text => 6,
+ is_require => 7,
+ hints_bits => 8,
+ warnings_bits => 9,
+ (hints_hash => 10) x ("$]" >= 5.010),
+ );
+
+ for my $name (sort { $infos{$a} <=> $infos{$b} } keys %infos) {
+ my $idx = $infos{$name};
+ local $@;
+ eval <<" TEMPLATE";
+ sub $name {
+ my \$self = shift;
+
+ \$self->assert_valid;
+
+ my \$info = \$self->{info};
+ \$info = \$self->{info} = [ Scope::Upper::context_info(\$self->cxt) ]
+ unless \$info;
+
+ return \$info->[$idx];
+ }
+ TEMPLATE
+ die $@ if $@;
+ }
+}
+
=head2 C<want>
-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.
+ my $want = $cxt->want;
+
+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 pointed by the invocant.
=cut
Scope::Upper::want_at($self->cxt);
}
-=head2 C<up [ $frames ]>
+=head2 C<up>
-Returns a new L<Scope::Context> object pointing to the C<$frames>-th upper scope above the topic context.
+ my $up_cxt = $cxt->up;
+ my $up_cxt = $cxt->up($frames);
+ my $up_cxt = Scope::Context->up;
-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.
+Returns a new L<Scope::Context> object pointing to the C<$frames>-th upper scope above the scope pointed by the invocant.
+
+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.
If omitted, C<$frames> defaults to C<1>.
sub up {
my ($self, $frames) = @_;
+ my $cxt;
if (Scalar::Util::blessed($self)) {
$self->assert_valid;
+ $cxt = $self->cxt;
} else {
- $self = $self->new(Scope::Upper::UP(Scope::Upper::SUB()));
+ $cxt = Scope::Upper::UP(Scope::Upper::SUB());
}
$frames = 1 unless defined $frames;
- my $cxt = $self->cxt;
$cxt = Scope::Upper::UP($cxt) for 1 .. $frames;
$self->new($cxt);
}
-=head2 C<sub [ $frames ]>
+=head2 C<sub>
+
+ my $sub_cxt = $cxt->sub;
+ my $sub_cxt = $cxt->sub($frames);
+ my $sub_cxt = Scope::Context->sub;
-Returns a new L<Scope::Context> object pointing to the C<$frames>-th subroutine scope above the topic context.
+Returns a new L<Scope::Context> object pointing to the C<$frames + 1>-th subroutine scope above the scope pointed by the invocant.
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.
-If omitted, C<$frames> defaults to C<0>, which results in the closest sub enclosing the topic context.
+If omitted, C<$frames> defaults to C<0>, which results in the closest sub enclosing the scope pointed by the invocant.
outer();
}
sub inner {
- my $sub = Scope::Context->new->sub(1); # = Scope::Context->sub
+ my $sub = Scope::Context->new->sub(1); # = Scope::Context->sub(1)
# $sub points to the context for the outer() sub.
}
sub sub {
my ($self, $frames) = @_;
+ my $cxt;
if (Scalar::Util::blessed($self)) {
$self->assert_valid;
+ $cxt = $self->cxt;
} else {
- $self = $self->new(Scope::Upper::UP(Scope::Upper::SUB()));
+ $cxt = Scope::Upper::UP(Scope::Upper::SUB());
}
$frames = 0 unless defined $frames;
- my $cxt = Scope::Upper::SUB($self->cxt);
+ $cxt = Scope::Upper::SUB($cxt);
$cxt = Scope::Upper::SUB(Scope::Upper::UP($cxt)) for 1 .. $frames;
$self->new($cxt);
}
-=head2 C<eval [ $frames ]>
+=head2 C<eval>
-Returns a new L<Scope::Context> object pointing to the C<$frames>-th C<eval> scope above the topic context.
+ my $eval_cxt = $cxt->eval;
+ my $eval_cxt = $cxt->eval($frames);
+ my $eval_cxt = Scope::Context->eval;
+
+Returns a new L<Scope::Context> object pointing to the C<$frames + 1>-th C<eval> scope above the scope pointed by the invocant.
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.
-If omitted, C<$frames> defaults to C<0>, which results in the closest eval enclosing the topic context.
+If omitted, C<$frames> defaults to C<0>, which results in the closest eval enclosing the scope pointed by the invocant.
eval {
sub {
sub eval {
my ($self, $frames) = @_;
+ my $cxt;
if (Scalar::Util::blessed($self)) {
$self->assert_valid;
+ $cxt = $self->cxt;
} else {
- $self = $self->new(Scope::Upper::UP(Scope::Upper::SUB()));
+ $cxt = Scope::Upper::UP(Scope::Upper::SUB());
}
$frames = 0 unless defined $frames;
- my $cxt = Scope::Upper::EVAL($self->cxt);
+ $cxt = Scope::Upper::EVAL($cxt);
$cxt = Scope::Upper::EVAL(Scope::Upper::UP($cxt)) for 1 .. $frames;
$self->new($cxt);
}
-=head2 C<reap $code>
+=head2 C<reap>
+
+ $cxt->reap($code);
-Execute C<$code> when the topic context ends.
+Execute C<$code> when the scope pointed by the invocant ends.
See L<Scope::Upper/reap> for details.
&Scope::Upper::reap($code, $self->cxt);
}
-=head2 C<localize $what, $value>
+=head2 C<localize>
-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.
+ $cxt->localize($what, $value);
+
+Localize the variable described by C<$what> to the value C<$value> when the control flow returns to the scope pointed by the invocant.
See L<Scope::Upper/localize> for details.
Scope::Upper::localize($what, $value, $self->cxt);
}
-=head2 C<localize_elem $what, $key, $value>
+=head2 C<localize_elem>
+
+ $cxt->localize_elem($what, $key, $value);
-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.
+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.
See L<Scope::Upper/localize_elem> for details.
Scope::Upper::localize_elem($what, $key, $value, $self->cxt);
}
-=head2 C<localize_delete $what, $key>
+=head2 C<localize_delete>
+
+ $cxt->localize_delete($what, $key);
-Delete the element C<$key> from the variable C<$what> when the control flow returns to the scope pointed by the topic context.
+Delete the element C<$key> from the variable C<$what> when the control flow returns to the scope pointed by the invocant.
See L<Scope::Upper/localize_delete> for details.
Scope::Upper::localize_delete($what, $key, $self->cxt);
}
-=head2 C<unwind @values>
+=head2 C<unwind>
-Immediately returns the scalars listed in C<@values> from the closest subroutine enclosing the topic context.
+ $cxt->unwind(@values);
+
+Immediately returns the scalars listed in C<@values> from the closest subroutine enclosing the scope pointed by the invocant.
See L<Scope::Upper/unwind> for details.
Scope::Upper::unwind(@_ => $self->cxt);
}
-=head2 C<uplevel $code, @args>
+=head2 C<yield>
+
+ $cxt->yield(@values);
+
+Immediately returns the scalars listed in C<@values> from the scope pointed by the invocant, whatever it may be (except a substitution eval context).
+
+See L<Scope::Upper/yield> for details.
+
+=cut
+
+sub yield {
+ my $self = shift;
+
+ $self->assert_valid;
+
+ Scope::Upper::yield(@_ => $self->cxt);
+}
+
+=head2 C<uplevel>
+
+ my @ret = $cxt->uplevel($code, @args);
-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>.
+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>.
See L<Scope::Upper/uplevel> for details.
L<Carp> (core module since perl 5), L<Scalar::Util> (since 5.7.3).
-L<Scope::Upper> 0.18.
+L<Scope::Upper> 0.21.
=head1 SEE ALSO
=head1 COPYRIGHT & LICENSE
-Copyright 2011 Vincent Pit, all rights reserved.
+Copyright 2011,2012,2013,2015 Vincent Pit, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
projects / perl / modules / Scope-Context.git / blobdiff