#!perl

use strict;
use warnings;

use blib;

package Scope;

use Scope::Upper qw<reap localize localize_elem localize_delete :words>;

sub new {
 my ($class, $name) = @_;

 localize '$tag' => bless({ name => $name }, $class) => UP;

 reap { print Scope->tag->name, ": end\n" } UP;
}

# Get the tag stored in the caller namespace
sub tag {
 my $l   = 0;
 my $pkg = __PACKAGE__;
 $pkg    = caller $l++ while $pkg eq __PACKAGE__;

 no strict 'refs';
 ${$pkg . '::tag'};
}

sub name { shift->{name} }

# Locally capture warnings and reprint them with the name prefixed
sub catch {
 localize_elem '%SIG', '__WARN__' => sub {
  print Scope->tag->name, ': ', @_;
 } => UP;
}

# Locally clear @INC
sub private {
 for (reverse 0 .. $#INC) {
  # First UP is the for loop, second is the sub boundary
  localize_delete '@INC', $_ => UP UP;
 }
}

package UserLand;

{
 Scope->new("top");      # initializes $UserLand::tag

 {
  Scope->catch;
  my $one = 1 + undef;   # prints "top: Use of uninitialized value..."

  {
   Scope->private;
   eval { delete $INC{"Cwd.pm"}; require Cwd }; # blib loads Cwd
   print $@;             # prints "Can't locate Cwd.pm in @INC (@INC contains:) at..."
  }

  require Cwd;           # loads Cwd.pm
 }

}                        # prints "top: done"