Commit | Line | Data |
---|---|---|
e46c382e YK |
1 | package overloading; |
2 | use warnings; | |
3 | ||
4 | use Carp (); | |
5 | ||
6 | our $VERSION = '0.01'; | |
7 | ||
effb3d11 RGS |
8 | my $HINT_NO_AMAGIC = 0x01000000; # see perl.h |
9 | ||
5538866c | 10 | require 5.010001; |
e46c382e YK |
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}; | |
effb3d11 | 31 | $^H &= ~$HINT_NO_AMAGIC; |
e46c382e YK |
32 | } |
33 | } else { | |
34 | delete $^H{overloading}; | |
effb3d11 | 35 | $^H &= ~$HINT_NO_AMAGIC; |
e46c382e YK |
36 | } |
37 | } | |
38 | ||
39 | sub unimport { | |
40 | my ( $class, @ops ) = @_; | |
41 | ||
effb3d11 | 42 | if ( exists $^H{overloading} or not $^H & $HINT_NO_AMAGIC ) { |
e46c382e YK |
43 | if ( @ops ) { |
44 | vec($^H{overloading} ||= '', $_, 1) = 1 for _ops_to_nums(@ops); | |
45 | } else { | |
46 | delete $^H{overloading}; | |
47 | } | |
48 | } | |
49 | ||
effb3d11 | 50 | $^H |= $HINT_NO_AMAGIC; |
e46c382e YK |
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; | |
23f6cb28 | 64 | my $str = "$object"; # doesn't call stringification overload |
e46c382e YK |
65 | } |
66 | ||
67 | # it's lexical, so this stringifies: | |
68 | warn "$object"; | |
69 | ||
70 | # it can be enabled per op | |
71 | no overloading qw(""); | |
23f6cb28 | 72 | warn "$object"; |
e46c382e YK |
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 | ||
23f6cb28 | 89 | Disables only specific overloads in the current lexical scope. |
e46c382e YK |
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 |