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