1package overloading; 2use warnings; 3 4use Carp (); 5 6our $VERSION = '0.01'; 7 8my $HINT_NO_AMAGIC = 0x01000000; # see perl.h 9 10require 5.010001; 11 12sub _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 21sub 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 39sub 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 531; 54__END__ 55 56=head1 NAME 57 58overloading - 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 79This pragma allows you to lexically disable or enable overloading. 80 81=over 6 82 83=item C<no overloading> 84 85Disables overloading entirely in the current lexical scope. 86 87=item C<no overloading @ops> 88 89Disables only specific overloads in the current lexical scope. 90 91=item C<use overloading> 92 93Reenables overloading in the current lexical scope. 94 95=item C<use overloading @ops> 96 97Reenables overloading only for specific ops in the current lexical scope. 98 99=back 100 101=cut 102