samples/tag.pl

   1 #!perl
   2
   3 package X;
   4
   5 use strict;
   6 use warnings;
   7
   8 use blib;
   9
  10 use Scope::Upper qw/reap localize localize_elem localize_delete UP/;
  11
  12 sub desc { shift->{desc} }
  13
  14 sub set_tag {
  15  my ($desc) = @_;
  16
  17  # First localize $x so that it gets destroyed last
  18  localize '$x' => bless({ desc => $desc }, __PACKAGE__) => UP;
  19
  20  reap sub {
  21   my $pkg = caller;
  22   my $x = do { no strict 'refs'; ${$pkg.'::x'} }; # Get the $x in the scope
  23   print $x->desc . ": done\n";
  24  } => UP;
  25
  26  localize_elem '%SIG', '__WARN__' => sub {
  27   my $pkg = caller;
  28   my $x = do { no strict 'refs'; ${$pkg.'::x'} }; # Get the $x in the scope
  29   CORE::warn($x->desc . ': ' . join('', @_));
  30  } => UP;
  31
  32  localize_delete '@ARGV', $#ARGV => UP; # delete last @ARGV element
  33 }
  34
  35 package main;
  36
  37 use strict;
  38 use warnings;
  39
  40 {
  41  X::set_tag('pie');
  42  # $x is now a X object, and @ARGV has one element less
  43  warn 'what'; # warns "pie: what at ..."
  44 } # "pie: done" is printed