1#!perl
2
3use strict;
4use warnings;
5
6use blib;
7
8package Scope;
9
10use Scope::Upper qw<reap localize localize_elem localize_delete :words>;
11
12sub new {
13 my ($class, $name) = @_;
14
15 localize '$tag' => bless({ name => $name }, $class) => UP;
16
17 reap { print Scope->tag->name, ": end\n" } UP;
18}
19
20# Get the tag stored in the caller namespace
21sub tag {
22 my $l   = 0;
23 my $pkg = __PACKAGE__;
24 $pkg    = caller $l++ while $pkg eq __PACKAGE__;
25
26 no strict 'refs';
27 ${$pkg . '::tag'};
28}
29
30sub name { shift->{name} }
31
32# Locally capture warnings and reprint them with the name prefixed
33sub catch {
34 localize_elem '%SIG', '__WARN__' => sub {
35  print Scope->tag->name, ': ', @_;
36 } => UP;
37}
38
39# Locally clear @INC
40sub private {
41 for (reverse 0 .. $#INC) {
42  # First UP is the for loop, second is the sub boundary
43  localize_delete '@INC', $_ => UP UP;
44 }
45}
46
47package UserLand;
48
49{
50 Scope->new("top");      # initializes $UserLand::tag
51
52 {
53  Scope->catch;
54  my $one = 1 + undef;   # prints "top: Use of uninitialized value..."
55
56  {
57   Scope->private;
58   eval { delete $INC{"Cwd.pm"}; require Cwd }; # blib loads Cwd
59   print $@;             # prints "Can't locate Cwd.pm in @INC (@INC contains:) at..."
60  }
61
62  require Cwd;           # loads Cwd.pm
63 }
64
65}                        # prints "top: done"
66