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