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/;
  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__) => 1;
  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  } => 1;
  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  } => 1;
  31 }
  32
  33 package main;
  34
  35 use strict;
  36 use warnings;
  37
  38 {
  39  X::set_tag('pie');
  40  # $x is now a X object
  41  warn 'what'; # warns "pie: what"
  42 } # "pie: done" is printed