samples/tag.pl

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