/usr/share/doc/libscope-upper-perl/examples/tag.pl is in libscope-upper-perl 0.25-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 | #!/usr/bin/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"
|