samples/synopsis.pl

   1 #!perl
   2
   3 use strict;
   4 use warnings;
   5
   6 use blib;
   7
   8 use Scope::Context;
   9
  10 local $" = ', ';
  11
  12 for my $run (1 .. 2) {
  13  my @values = sub {
  14   local $@;
  15
  16   eval {
  17    # Create Scope::Context objects for different upper frames :
  18    my ($block, $eval, $sub, $loop);
  19    {
  20     $block = Scope::Context->new;
  21     $eval  = $block->eval;   # == $block->up
  22     $sub   = $block->sub;    # == $block->up(2)
  23     $loop  = $sub->up;       # == $block->up(3)
  24    }
  25
  26    eval {
  27     # This throws an exception, since $block has expired :
  28     $block->localize('$x' => 1);
  29    };
  30    print "Caught an error at run $run: $@" if $@;
  31
  32    # This will print "End of eval scope..." when the current eval block ends :
  33    $eval->reap(sub { print "End of eval scope at run $run\n" });
  34
  35    # Ignore warnings just for the loop body :
  36    $loop->localize_elem('%SIG', __WARN__ => sub { });
  37    # But for now they are still processed :
  38    warn "This is a warning at run $run\n";
  39
  40    # Execute the callback as if it ran in place of the sub :
  41    my @values = $sub->uplevel(sub {
  42     return @_, 2;
  43    }, 1);
  44    print "After uplevel, \@values contains (@values) at run $run\n";
  45
  46    # Immediately return (1, 2, 3) from the sub, bypassing the eval :
  47    $sub->unwind(@values, 3);
  48
  49    # Not reached.
  50    return 'XXX';
  51   };
  52
  53   # Not reached.
  54   die $@ if $@;
  55  }->();
  56
  57  print "Values returned at run $run: (@values)\n";
  58
  59  # warnings are ignored, so this will be completely silent.
  60  warn "You will not see this at run $run\n";
  61 }
  62
  63 warn "Warnings have been restored\n";