lib/caller.pm

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