blob: 98d4f3f28a576da70bcd5581fdfda99d425562da (
plain)
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
|
package caller;
our $VERSION = "1.0";
=head1 NAME
caller - inherit pragmatic attributes from the context of the caller
=head1 SYNOPSIS
use caller qw(encoding);
=head1 DESCRIPTION
This pragma allows a module to inherit some attributes from the
context which loaded it.
Inheriting attributes takes place at compile time; this means
only attributes that are visible in the calling context at compile
time will be propagated.
Currently, the only supported attribute is C<encoding>.
=over
=item encoding
Indicates that the character set encoding of the caller's context
must be inherited. This can be used to inherit the C<use utf8>
setting in the calling context.
=back
=cut
my %bitmask = (
# only HINT_UTF8 supported for now
encoding => 0x8
);
sub bits {
my $bits = 0;
for my $s (@_) { $bits |= $bitmask{$s} || 0; };
$bits;
}
sub import {
shift;
my @cxt = caller(3);
if (@cxt and $cxt[7]) { # was our parent require-d?
$^H |= bits(@_) & $cxt[8];
}
}
sub unimport {
# noop currently
}
1;
|
