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