use Carp ();
use Scalar::Util ();
-use Scope::Upper 0.18 ();
+use Scope::Upper 0.21 ();
=head1 NAME
=head1 VERSION
-Version 0.01
+Version 0.03
=cut
-our $VERSION = '0.01';
+our $VERSION = '0.03';
=head1 SYNOPSIS
for (1 .. 5) {
sub {
eval {
- # Create Scope::Context objects for different upper frames.
- 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 body.
- $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
- # $SIG{__DIE__} is undefined.
+ # 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.
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
my $scope_upper_cxt = $cxt->cxt;
-Read-only accessor to the L<Scope::Upper> context corresponding to the topic L<Scope::Context> object.
+Read-only accessor to the L<Scope::Upper> context identifier associated with the invocant.
=head2 C<uid>
my $uid = $cxt->uid;
-Read-only accessor to the L<Scope::Upper> UID of the topic L<Scope::Context> object.
+Read-only accessor to the L<Scope::Upper> unique identifier representing the L<Scope::Upper> context associated with the invocant.
=cut
my $is_valid = $cxt->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).
+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
$cxt->assert_valid;
-Throws an exception if the topic context has expired and is no longer 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 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.
+
+=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>
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 corresponding to the topic L<Scope::Context> object.
+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.
=cut
my $up_cxt = $cxt->up($frames);
my $up_cxt = Scope::Context->up;
-Returns a new L<Scope::Context> object pointing to the C<$frames>-th upper scope above the topic 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 for the current context.
+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 {
{
{
- my $up = Scope::Context->new->up(2); # = Scope::Context->up(2)
+ my $up = Scope::Context->new->up(2); # == Scope::Context->up(2)
# $up points two contextes above this one, which is the sub.
}
}
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);
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(1)
+ 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);
my $eval_cxt = $cxt->eval($frames);
my $eval_cxt = Scope::Context->eval;
-Returns a new L<Scope::Context> object pointing to the C<$frames>-th C<eval> scope above the topic context.
+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 {
- my $eval = Scope::Context->new->eval; # = Scope::Context->eval
+ my $eval = Scope::Context->new->eval; # == Scope::Context->eval
# $eval points to the eval context.
}->()
}
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);
$cxt->reap($code);
-Execute C<$code> when the topic context ends.
+Executes C<$code> when the scope pointed by the invocant ends.
See L<Scope::Upper/reap> for details.
$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 topic context.
+Localizes the variable described by C<$what> to the value C<$value> when the control flow returns to the scope pointed by the invocant, until said scope ends.
See L<Scope::Upper/localize> for details.
$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.
+Localizes 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, until said scope ends.
See L<Scope::Upper/localize_elem> for details.
$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.
+Deletes the element C<$key> from the variable C<$what> when the control flow returns to the scope pointed by the invocant, and restores it to its original value when said scope ends.
See L<Scope::Upper/localize_delete> for details.
$cxt->unwind(@values);
-Immediately returns the scalars listed in C<@values> from the closest subroutine enclosing the topic context.
+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<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.
=head1 DEPENDENCIES
-L<Carp> (core module since perl 5), L<Scalar::Util> (since 5.7.3).
+L<Carp> (core module since perl 5), L<overload> (since 5.2.0), 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.