lib/overloading.pm

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