lib/caller.pm

   1 package caller;
   2 our $VERSION = "1.0";
   3
   4 =head1 NAME
   5
   6 caller - inherit pragmatic attributes from the context of the caller
   7
   8 =head1 SYNOPSIS
   9
  10         use caller qw(encoding);
  11
  12 =head1 DESCRIPTION
  13
  14 This pragma allows a module to inherit some attributes from the
  15 context which loaded it.
  16
  17 Inheriting attributes takes place at compile time; this means
  18 only attributes that are visible in the calling context at compile
  19 time will be propagated.
  20
  21 Currently, the only supported attribute is C<encoding>.
  22
  23 =over
  24
  25 =item encoding
  26
  27 Indicates that the character set encoding of the caller's context
  28 must be inherited.  This can be used to inherit the C<use utf8>
  29 setting in the calling context.
  30
  31 =back
  32
  33 =cut
  34
  35 my %bitmask = (
  36     # only HINT_UTF8 supported for now
  37     encoding => 0x8
  38 );
  39
  40 sub bits {
  41     my $bits = 0;
  42     for my $s (@_) { $bits |= $bitmask{$s} || 0; };
  43     $bits;
  44 }
  45
  46 sub import {
  47     shift;
  48     my @cxt = caller(3);
  49     if (@cxt and $cxt[7]) {     # was our parent require-d?
  50         $^H |= bits(@_) & $cxt[8];
  51     }
  52 }
  53
  54 sub unimport {
  55     # noop currently
  56 }
  57
  58 1;