lib/overloading.pm

   1 package overloading;
   2 use warnings;
   3
   4 use Carp ();
   5
   6 our $VERSION = '0.01';
   7
   8 my $HINT_NO_AMAGIC = 0x01000000; # see perl.h
   9
  10 require 5.010001;
  11
  12 sub _ops_to_nums {
  13     require overload::numbers;
  14
  15     map { exists $overload::numbers::names{"($_"}
  16         ? $overload::numbers::names{"($_"}
  17         : Carp::croak("'$_' is not a valid overload")
  18     } @_;
  19 }
  20
  21 sub import {
  22     my ( $class, @ops ) = @_;
  23
  24     if ( @ops ) {
  25         if ( $^H{overloading} ) {
  26             vec($^H{overloading} , $_, 1) = 0 for _ops_to_nums(@ops);
  27         }
  28
  29         if ( $^H{overloading} !~ /[^\0]/ ) {
  30             delete $^H{overloading};
  31             $^H &= ~$HINT_NO_AMAGIC;
  32         }
  33     } else {
  34         delete $^H{overloading};
  35         $^H &= ~$HINT_NO_AMAGIC;
  36     }
  37 }
  38
  39 sub unimport {
  40     my ( $class, @ops ) = @_;
  41
  42     if ( exists $^H{overloading} or not $^H & $HINT_NO_AMAGIC ) {
  43         if ( @ops ) {
  44             vec($^H{overloading} ||= '', $_, 1) = 1 for _ops_to_nums(@ops);
  45         } else {
  46             delete $^H{overloading};
  47         }
  48     }
  49
  50     $^H |= $HINT_NO_AMAGIC;
  51 }
  52
  53 1;
  54 __END__
  55
  56 =head1 NAME
  57
  58 overloading - perl pragma to lexically control overloading
  59
  60 =head1 SYNOPSIS
  61
  62     {
  63         no overloading;
  64         my $str = "$object"; # doesn't call stringification overload
  65     }
  66
  67     # it's lexical, so this stringifies:
  68     warn "$object";
  69
  70     # it can be enabled per op
  71     no overloading qw("");
  72     warn "$object";
  73
  74     # and also reenabled
  75     use overloading;
  76
  77 =head1 DESCRIPTION
  78
  79 This pragma allows you to lexically disable or enable overloading.
  80
  81 =over 6
  82
  83 =item C<no overloading>
  84
  85 Disables overloading entirely in the current lexical scope.
  86
  87 =item C<no overloading @ops>
  88
  89 Disables only specific overloads in the current lexical scope.
  90
  91 =item C<use overloading>
  92
  93 Reenables overloading in the current lexical scope.
  94
  95 =item C<use overloading @ops>
  96
  97 Reenables overloading only for specific ops in the current lexical scope.
  98
  99 =back
 100
 101 =cut