X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FScope-Context.git;a=blobdiff_plain;f=lib%2FScope%2FContext.pm;h=6658c3cfe8596208bdb09fd4ccca799230192cbf;hp=85fd57365e7eeacf839251b86a28d9f7075673ca;hb=3c4dd9fbf7894245f46e02300a54df2971e12a27;hpb=e8b777e025ed69b121b659618d6d6451541cee5a diff --git a/lib/Scope/Context.pm b/lib/Scope/Context.pm index 85fd573..6658c3c 100644 --- a/lib/Scope/Context.pm +++ b/lib/Scope/Context.pm @@ -16,11 +16,11 @@ Scope::Context - Object-oriented interface for inspecting or acting upon upper s =head1 VERSION -Version 0.01 +Version 0.02 =cut -our $VERSION = '0.01'; +our $VERSION = '0.02'; =head1 SYNOPSIS @@ -29,32 +29,33 @@ our $VERSION = '0.01'; 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. @@ -63,10 +64,13 @@ our $VERSION = '0.01'; # 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's functionalities. @@ -92,7 +96,7 @@ will croak when L is called. my $cxt = Scope::Context->new; my $cxt = Scope::Context->new($scope_upper_cxt); -Creates a new immutable L object from the L-comptabile context C<$context>. +Creates a new immutable L object from the L-comptabile context identifier C<$context>. If omitted, C<$context> defaults to the current context. =cut @@ -133,13 +137,13 @@ sub _croak { my $scope_upper_cxt = $cxt->cxt; -Read-only accessor to the L context corresponding to the topic L object. +Read-only accessor to the L context identifier associated with the invocant. =head2 C my $uid = $cxt->uid; -Read-only accessor to the L UID of the topic L object. +Read-only accessor to the L unique identifier representing the L context associated with the invocant. =cut @@ -171,7 +175,7 @@ use overload ( 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 @@ -181,7 +185,7 @@ sub is_valid { Scope::Upper::validate_uid($_[0]->uid) } $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 @@ -194,11 +198,115 @@ sub assert_valid { 1; } +=head2 C + + $cxt->package; + +Returns the namespace in use when the scope denoted by the invocant begins. + +=head2 C + + $cxt->file; + +Returns the name of the file where the scope denoted by the invocant belongs to. + +=head2 C + + $cxt->line; + +Returns the line number where the scope denoted by the invocant begins. + +=head2 C + + $cxt->sub_name; + +Returns the name of the subroutine called for this context, or C if this is not a subroutine context. + +=head2 C + + $cxt->sub_has_args; + +Returns a boolean indicating whether a new instance of C<@_> was set up for this context, or C if this is not a subroutine context. + +=head2 C + + $cxt->gimme; + +Returns the context (in the sense of L) in which the scope denoted by the invocant is executed. + +=head2 C + + $cxt->eval_text; + +Returns the contents of the string being compiled for this context, or C if this is not an eval context. + +=head2 C + + $cxt->is_require; + +Returns a boolean indicating whether this eval context was created by C, or C if this is not an eval context. + +=head2 C + + $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 + + $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 + + $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 my $want = $cxt->want; -Returns the Perl context (in the sense of C : C for void context, C<''> for scalar context, and true for list context) in which is executed the scope corresponding to the topic L object. +Returns the Perl context (in the sense of C : C for void context, C<''> for scalar context, and true for list context) in which is executed the scope pointed by the invocant. =cut @@ -216,9 +324,9 @@ sub want { my $up_cxt = $cxt->up($frames); my $up_cxt = Scope::Context->up; -Returns a new L object pointing to the C<$frames>-th upper scope above the topic context. +Returns a new L 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 on a L object for the current context. +This method can also be invoked as a class method, in which case it is equivalent to calling L on a L object representing the current context. If omitted, C<$frames> defaults to C<1>. @@ -257,11 +365,11 @@ sub up { my $sub_cxt = $cxt->sub($frames); my $sub_cxt = Scope::Context->sub; -Returns a new L object pointing to the C<$frames>-th subroutine scope above the topic context. +Returns a new L 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 on a L 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(); @@ -301,11 +409,11 @@ sub sub { my $eval_cxt = $cxt->eval($frames); my $eval_cxt = Scope::Context->eval; -Returns a new L object pointing to the C<$frames>-th C scope above the topic context. +Returns a new L object pointing to the C<$frames + 1>-th C 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 on a L 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 { @@ -339,7 +447,7 @@ sub eval { $cxt->reap($code); -Execute C<$code> when the topic context ends. +Execute C<$code> when the scope pointed by the invocant ends. See L for details. @@ -357,7 +465,7 @@ sub reap { $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. +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 for details. @@ -375,7 +483,7 @@ sub localize { $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 for details. @@ -393,7 +501,7 @@ sub localize_elem { $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 for details. @@ -411,7 +519,7 @@ sub localize_delete { $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 for details. @@ -429,7 +537,7 @@ sub unwind { $cxt->yield(@values); -Immediately returns the scalars listed in C<@values> from the topic context, whatever it may be (except a substitution eval context). +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 for details. @@ -447,7 +555,7 @@ sub yield { 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 for details. @@ -493,7 +601,7 @@ You can find documentation for this module with the perldoc command. =head1 COPYRIGHT & LICENSE -Copyright 2011,2012 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.