Profile of /usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Variable/Magic.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For 05.Domain_and_Item.t
Run on Tue May 4 17:21:41 2010
Reported on Tue May 4 17:22:21 2010

File | /usr/local/lib/perl5/site_perl/5.10.1/darwin-2level/Variable/Magic.pm
Statements Executed | 37
Statement Execution Time | 819µs

Subroutines — ordered by exclusive time
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 24µs | 38µs | Variable::Magic::::wizardVariable::Magic::wizard
4 | 1 | 2 | 23µs | 29µs | Variable::Magic::::castVariable::Magic::cast (xsub)
1 | 1 | 1 | 22µs | 22µs | Variable::Magic::::BEGIN@3Variable::Magic::BEGIN@3
1 | 1 | 2 | 14µs | 14µs | Variable::Magic::::_wizardVariable::Magic::_wizard (xsub)
1 | 1 | 1 | 10µs | 287µs | Variable::Magic::::BEGIN@204Variable::Magic::BEGIN@204
1 | 1 | 1 | 8µs | 51µs | Variable::Magic::::BEGIN@560Variable::Magic::BEGIN@560
1 | 1 | 1 | 8µs | 40µs | Variable::Magic::::BEGIN@8Variable::Magic::BEGIN@8
1 | 1 | 1 | 7µs | 9µs | Variable::Magic::::BEGIN@5Variable::Magic::BEGIN@5
1 | 1 | 1 | 7µs | 15µs | Variable::Magic::::BEGIN@6Variable::Magic::BEGIN@6
4 | 1 | 2 | 4µs | 4µs | Variable::Magic::::getdataVariable::Magic::getdata (xsub)
1 | 1 | 1 | 3µs | 3µs | Variable::Magic::::BEGIN@21Variable::Magic::BEGIN@21

Call graph for these subroutines as a Graphviz dot language file.

Line | State ments | Time on line | Calls | Time in subs | Code
--- | --- | --- | --- | --- | ---
1 |  |  |  |  | package Variable::Magic;
2 |  |  |  |  |
3 | 3 | 32µs | 1 | 22µs | # spent 22µs within Variable::Magic::BEGIN@3 which was called # once (22µs+0s) by B::Hooks::EndOfScope::BEGIN@7 at line 3 use 5.008; # spent 22µs making 1 call to Variable::Magic::BEGIN@3
4 |  |  |  |  |
5 | 3 | 17µs | 2 | 12µs | # spent 9µs (7+3) within Variable::Magic::BEGIN@5 which was called # once (7µs+3µs) by B::Hooks::EndOfScope::BEGIN@7 at line 5 use strict; # spent 9µs making 1 call to Variable::Magic::BEGIN@5 # spent 2µs making 1 call to strict::import
6 | 3 | 20µs | 2 | 24µs | # spent 15µs (7+8) within Variable::Magic::BEGIN@6 which was called # once (7µs+8µs) by B::Hooks::EndOfScope::BEGIN@7 at line 6 use warnings; # spent 15µs making 1 call to Variable::Magic::BEGIN@6 # spent 8µs making 1 call to warnings::import
7 |  |  |  |  |
8 | 3 | 35µs | 2 | 72µs | # spent 40µs (8+32) within Variable::Magic::BEGIN@8 which was called # once (8µs+32µs) by B::Hooks::EndOfScope::BEGIN@7 at line 8 use Carp qw/croak/; # spent 40µs making 1 call to Variable::Magic::BEGIN@8 # spent 32µs making 1 call to Exporter::import
9 |  |  |  |  |
10 |  |  |  |  | =head1 NAME
11 |  |  |  |  |
12 |  |  |  |  | Variable::Magic - Associate user-defined magic to variables from Perl.
13 |  |  |  |  |
14 |  |  |  |  | =head1 VERSION
15 |  |  |  |  |
16 |  |  |  |  | Version 0.39
17 |  |  |  |  |
18 |  |  |  |  | =cut
19 |  |  |  |  |
20 | 1 | 100ns |  |  | our $VERSION;
21 |  |  |  |  | # spent 3µs within Variable::Magic::BEGIN@21 which was called # once (3µs+0s) by B::Hooks::EndOfScope::BEGIN@7 at line 23 BEGIN {
22 | 1 | 11µs |  |  | $VERSION = '0.39';
23 | 1 | 54µs | 1 | 3µs | } # spent 3µs making 1 call to Variable::Magic::BEGIN@21
24 |  |  |  |  |
25 |  |  |  |  | =head1 SYNOPSIS
26 |  |  |  |  |
27 |  |  |  |  | use Variable::Magic qw/wizard cast VMG_OP_INFO_NAME/;
28 |  |  |  |  |
29 |  |  |  |  | { # A variable tracer
30 |  |  |  |  | my $wiz = wizard set => sub { print "now set to ${$_[0]}!\n" },
31 |  |  |  |  | free => sub { print "destroyed!\n" };
32 |  |  |  |  |
33 |  |  |  |  | my $a = 1;
34 |  |  |  |  | cast $a, $wiz;
35 |  |  |  |  | $a = 2; # "now set to 2!"
36 |  |  |  |  | } # "destroyed!"
37 |  |  |  |  |
38 |  |  |  |  | { # A hash with a default value
39 |  |  |  |  | my $wiz = wizard data => sub { $_[1] },
40 |  |  |  |  | fetch => sub { $_[2] = $_[1] unless exists $_[0]->{$_[2]}; () },
41 |  |  |  |  | store => sub { print "key $_[2] stored in $_[-1]\n" },
42 |  |  |  |  | copy_key => 1,
43 |  |  |  |  | op_info => VMG_OP_INFO_NAME;
44 |  |  |  |  |
45 |  |  |  |  | my %h = (_default => 0, apple => 2);
46 |  |  |  |  | cast %h, $wiz, '_default';
47 |  |  |  |  | print $h{banana}, "\n"; # "0", because the 'banana' key doesn't exist in %h
48 |  |  |  |  | $h{pear} = 1; # "key pear stored in helem"
49 |  |  |  |  | }
50 |  |  |  |  |
51 |  |  |  |  | =head1 DESCRIPTION
52 |  |  |  |  |
53 |  |  |  |  | Magic is Perl way of enhancing objects.
54 |  |  |  |  | This mechanism lets the user add extra data to any variable and hook syntaxical operations (such as access, assignment or destruction) that can be applied to it.
55 |  |  |  |  | With this module, you can add your own magic to any variable without having to write a single line of XS.
56 |  |  |  |  |
57 |  |  |  |  | You'll realize that these magic variables look a lot like tied variables.
58 |  |  |  |  | It's not surprising, as tied variables are implemented as a special kind of magic, just like any 'irregular' Perl variable : scalars like C<$!>, C<$(> or C<$^W>, the C<%ENV> and C<%SIG> hashes, the C<@ISA> array, C<vec()> and C<substr()> lvalues, L<threads::shared> variables...
59 |  |  |  |  | They all share the same underlying C API, and this module gives you direct access to it.
60 |  |  |  |  |
61 |  |  |  |  | Still, the magic made available by this module differs from tieing and overloading in several ways :
62 |  |  |  |  |
63 |  |  |  |  | =over 4
64 |  |  |  |  |
65 |  |  |  |  | =item *
66 |  |  |  |  |
67 |  |  |  |  | It isn't copied on assignment.
68 |  |  |  |  |
69 |  |  |  |  | You attach it to variables, not values (as for blessed references).
70 |  |  |  |  |
71 |  |  |  |  | =item *
72 |  |  |  |  |
73 |  |  |  |  | It doesn't replace the original semantics.
74 |  |  |  |  |
75 |  |  |  |  | Magic callbacks usually trigger before the original action take place, and can't prevent it to happen.
76 |  |  |  |  | This also makes catching individual events easier than with C<tie>, where you have to provide fallbacks methods for all actions by usually inheriting from the correct C<Tie::Std*> class and overriding individual methods in your own class.
77 |  |  |  |  |
78 |  |  |  |  | =item *
79 |  |  |  |  |
80 |  |  |  |  | It's type-agnostic.
81 |  |  |  |  |
82 |  |  |  |  | The same magic can be applied on scalars, arrays, hashes, subs or globs.
83 |  |  |  |  | But the same hook (see below for a list) may trigger differently depending on the the type of the variable.
84 |  |  |  |  |
85 |  |  |  |  | =item *
86 |  |  |  |  |
87 |  |  |  |  | It's mostly invisible at the Perl level.
88 |  |  |  |  |
89 |  |  |  |  | Magical and non-magical variables cannot be distinguished with C<ref>, C<tied> or another trick.
90 |  |  |  |  |
91 |  |  |  |  | =item *
92 |  |  |  |  |
93 |  |  |  |  | It's notably faster.
94 |  |  |  |  |
95 |  |  |  |  | Mainly because perl's way of handling magic is lighter by nature, and because there's no need for any method resolution.
96 |  |  |  |  | Also, since you don't have to reimplement all the variable semantics, you only pay for what you actually use.
97 |  |  |  |  |
98 |  |  |  |  | =back
99 |  |  |  |  |
100 |  |  |  |  | The operations that can be overloaded are :
101 |  |  |  |  |
102 |  |  |  |  | =over 4
103 |  |  |  |  |
104 |  |  |  |  | =item *
105 |  |  |  |  |
106 |  |  |  |  | C<get>
107 |  |  |  |  |
108 |  |  |  |  | This magic is invoked when the variable is evaluated.
109 |  |  |  |  | It is never called for arrays and hashes.
110 |  |  |  |  |
111 |  |  |  |  | =item *
112 |  |  |  |  |
113 |  |  |  |  | C<set>
114 |  |  |  |  |
115 |  |  |  |  | This one is triggered each time the value of the variable changes.
116 |  |  |  |  | It is called for array subscripts and slices, but never for hashes.
117 |  |  |  |  |
118 |  |  |  |  | =item *
119 |  |  |  |  |
120 |  |  |  |  | C<len>
121 |  |  |  |  |
122 |  |  |  |  | This magic is a little special : it is called when the 'size' or the 'length' of the variable has to be known by Perl.
123 |  |  |  |  | Typically, it's the magic involved when an array is evaluated in scalar context, but also on array assignment and loops (C<for>, C<map> or C<grep>).
124 |  |  |  |  | The callback has then to return the length as an integer.
125 |  |  |  |  |
126 |  |  |  |  | =item *
127 |  |  |  |  |
128 |  |  |  |  | C<clear>
129 |  |  |  |  |
130 |  |  |  |  | This magic is invoked when the variable is reset, such as when an array is emptied.
131 |  |  |  |  | Please note that this is different from undefining the variable, even though the magic is called when the clearing is a result of the undefine (e.g. for an array, but actually a bug prevent it to work before perl 5.9.5 - see the L<history|/PERL MAGIC HISTORY>).
132 |  |  |  |  |
133 |  |  |  |  | =item *
134 |  |  |  |  |
135 |  |  |  |  | C<free>
136 |  |  |  |  |
137 |  |  |  |  | This one can be considered as an object destructor.
138 |  |  |  |  | It happens when the variable goes out of scope, but not when it is undefined.
139 |  |  |  |  |
140 |  |  |  |  | =item *
141 |  |  |  |  |
142 |  |  |  |  | C<copy>
143 |  |  |  |  |
144 |  |  |  |  | This magic only applies to tied arrays and hashes.
145 |  |  |  |  | It fires when you try to access or change their elements.
146 |  |  |  |  | It is available on your perl iff C<MGf_COPY> is true.
147 |  |  |  |  |
148 |  |  |  |  | =item *
149 |  |  |  |  |
150 |  |  |  |  | C<dup>
151 |  |  |  |  |
152 |  |  |  |  | Invoked when the variable is cloned across threads.
153 |  |  |  |  | Currently not available.
154 |  |  |  |  |
155 |  |  |  |  | =item *
156 |  |  |  |  |
157 |  |  |  |  | C<local>
158 |  |  |  |  |
159 |  |  |  |  | When this magic is set on a variable, all subsequent localizations of the variable will trigger the callback.
160 |  |  |  |  | It is available on your perl iff C<MGf_LOCAL> is true.
161 |  |  |  |  |
162 |  |  |  |  | =back
163 |  |  |  |  |
164 |  |  |  |  | The following actions only apply to hashes and are available iff C<VMG_UVAR> is true.
165 |  |  |  |  | They are referred to as C<uvar> magics.
166 |  |  |  |  |
167 |  |  |  |  | =over 4
168 |  |  |  |  |
169 |  |  |  |  | =item *
170 |  |  |  |  |
171 |  |  |  |  | C<fetch>
172 |  |  |  |  |
173 |  |  |  |  | This magic happens each time an element is fetched from the hash.
174 |  |  |  |  |
175 |  |  |  |  | =item *
176 |  |  |  |  |
177 |  |  |  |  | C<store>
178 |  |  |  |  |
179 |  |  |  |  | This one is called when an element is stored into the hash.
180 |  |  |  |  |
181 |  |  |  |  | =item *
182 |  |  |  |  |
183 |  |  |  |  | C<exists>
184 |  |  |  |  |
185 |  |  |  |  | This magic fires when a key is tested for existence in the hash.
186 |  |  |  |  |
187 |  |  |  |  | =item *
188 |  |  |  |  |
189 |  |  |  |  | C<delete>
190 |  |  |  |  |
191 |  |  |  |  | This last one triggers when a key is deleted in the hash, regardless of whether the key actually exists in it.
192 |  |  |  |  |
193 |  |  |  |  | =back
194 |  |  |  |  |
195 |  |  |  |  | You can refer to the tests to have more insight of where the different magics are invoked.
196 |  |  |  |  |
197 |  |  |  |  | To prevent any clash between different magics defined with this module, an unique numerical signature is attached to each kind of magic (i.e. each set of callbacks for magic operations).
198 |  |  |  |  | At the C level, magic tokens owned by magic created by this module have their C<< mg->mg_private >> field set to C<0x3891> or C<0x3892>, so please don't use these magic (sic) numbers in other extensions.
199 |  |  |  |  |
200 |  |  |  |  | =head1 FUNCTIONS
201 |  |  |  |  |
202 |  |  |  |  | =cut
203 |  |  |  |  |
204 |  |  |  |  | # spent 287µs (10+277) within Variable::Magic::BEGIN@204 which was called # once (10µs+277µs) by B::Hooks::EndOfScope::BEGIN@7 at line 207 BEGIN {
205 | 2 | 286µs |  |  | require XSLoader;
206 |  |  |  |  | XSLoader::load(__PACKAGE__, $VERSION); # spent 277µs making 1 call to XSLoader::load
207 | 1 | 183µs | 1 | 287µs | } # spent 287µs making 1 call to Variable::Magic::BEGIN@204
208 |  |  |  |  |
209 |  |  |  |  | =head2 C<wizard>
210 |  |  |  |  |
211 |  |  |  |  | wizard data => sub { ... },
212 |  |  |  |  | get => sub { my ($ref, $data [, $op]) = @_; ... },
213 |  |  |  |  | set => sub { my ($ref, $data [, $op]) = @_; ... },
214 |  |  |  |  | len => sub { my ($ref, $data, $len [, $op]) = @_; ... ; return $newlen; },
215 |  |  |  |  | clear => sub { my ($ref, $data [, $op]) = @_; ... },
216 |  |  |  |  | free => sub { my ($ref, $data [, $op]) = @_, ... },
217 |  |  |  |  | copy => sub { my ($ref, $data, $key, $elt [, $op]) = @_; ... },
218 |  |  |  |  | local => sub { my ($ref, $data [, $op]) = @_; ... },
219 |  |  |  |  | fetch => sub { my ($ref, $data, $key [, $op]) = @_; ... },
220 |  |  |  |  | store => sub { my ($ref, $data, $key [, $op]) = @_; ... },
221 |  |  |  |  | exists => sub { my ($ref, $data, $key [, $op]) = @_; ... },
222 |  |  |  |  | delete => sub { my ($ref, $data, $key [, $op]) = @_; ... },
223 |  |  |  |  | copy_key => $bool,
224 |  |  |  |  | op_info => [ 0 | VMG_OP_INFO_NAME | VMG_OP_INFO_OBJECT ]
225 |  |  |  |  |
226 |  |  |  |  | This function creates a 'wizard', an opaque type that holds the magic information.
227 |  |  |  |  | It takes a list of keys / values as argument, whose keys can be :
228 |  |  |  |  |
229 |  |  |  |  | =over 4
230 |  |  |  |  |
231 |  |  |  |  | =item *
232 |  |  |  |  |
233 |  |  |  |  | C<data>
234 |  |  |  |  |
235 |  |  |  |  | A code (or string) reference to a private data constructor.
236 |  |  |  |  | It is called each time this magic is cast on a variable, and the scalar returned is used as private data storage for it.
237 |  |  |  |  | C<$_[0]> is a reference to the magic object and C<@_[1 .. @_-1]> are all extra arguments that were passed to L</cast>.
238 |  |  |  |  |
239 |  |  |  |  | =item *
240 |  |  |  |  |
241 |  |  |  |  | C<get>, C<set>, C<len>, C<clear>, C<free>, C<copy>, C<local>, C<fetch>, C<store>, C<exists> and C<delete>
242 |  |  |  |  |
243 |  |  |  |  | Code (or string) references to the corresponding magic callbacks.
244 |  |  |  |  | You don't have to specify all of them : the magic associated with undefined entries simply won't be hooked.
245 |  |  |  |  | In those callbacks, C<$_[0]> is always a reference to the magic object and C<$_[1]> is always the private data (or C<undef> when no private data constructor was supplied).
246 |  |  |  |  |
247 |  |  |  |  | Moreover, when you pass C<< op_info => $num >> to C<wizard>, the last element of C<@_> will be the current op name if C<$num == VMG_OP_INFO_NAME> and a C<B::OP> object representing the current op if C<$num == VMG_OP_INFO_OBJECT>.
248 |  |  |  |  | Both have a performance hit, but just getting the name is lighter than getting the op object.
249 |  |  |  |  |
250 |  |  |  |  | Other arguments are specific to the magic hooked :
251 |  |  |  |  |
252 |  |  |  |  | =over 8
253 |  |  |  |  |
254 |  |  |  |  | =item *
255 |  |  |  |  |
256 |  |  |  |  | C<len>
257 |  |  |  |  |
258 |  |  |  |  | When the variable is an array or a scalar, C<$_[2]> contains the non-magical length.
259 |  |  |  |  | The callback can return the new scalar or array length to use, or C<undef> to default to the normal length.
260 |  |  |  |  |
261 |  |  |  |  | =item *
262 |  |  |  |  |
263 |  |  |  |  | C<copy>
264 |  |  |  |  |
265 |  |  |  |  | C<$_[2]> is a either a copy or an alias of the current key, which means that it is useless to try to change or cast magic on it.
266 |  |  |  |  | C<$_[3]> is an alias to the current element (i.e. the value).
267 |  |  |  |  |
268 |  |  |  |  | =item *
269 |  |  |  |  |
270 |  |  |  |  | C<fetch>, C<store>, C<exists> and C<delete>
271 |  |  |  |  |
272 |  |  |  |  | C<$_[2]> is an alias to the current key.
273 |  |  |  |  | Nothing prevents you from changing it, but be aware that there lurk dangerous side effects.
274 |  |  |  |  | For example, it may rightfully be readonly if the key was a bareword.
275 |  |  |  |  | You can get a copy instead by passing C<< copy_key => 1 >> to L</wizard>, which allows you to safely assign to C<$_[2]> in order to e.g. redirect the action to another key.
276 |  |  |  |  | This however has a little performance drawback because of the copy.
277 |  |  |  |  |
278 |  |  |  |  | =back
279 |  |  |  |  |
280 |  |  |  |  | All the callbacks are expected to return an integer, which is passed straight to the perl magic API.
281 |  |  |  |  | However, only the return value of the C<len> callback currently holds a meaning.
282 |  |  |  |  |
283 |  |  |  |  | =back
284 |  |  |  |  |
285 |  |  |  |  | Each callback can be specified as a code or a string reference, in which case the function denoted by the string will be used as the callback.
286 |  |  |  |  |
287 |  |  |  |  | Note that C<free> callbacks are I<never> called during global destruction, as there's no way to ensure that the wizard and the C<free> callback weren't destroyed before the variable.
288 |  |  |  |  |
289 |  |  |  |  | Here's a simple usage example :
290 |  |  |  |  |
291 |  |  |  |  | # A simple scalar tracer
292 |  |  |  |  | my $wiz = wizard get => sub { print STDERR "got ${$_[0]}\n" },
293 |  |  |  |  | set => sub { print STDERR "set to ${$_[0]}\n" },
294 |  |  |  |  | free => sub { print STDERR "${$_[0]} was deleted\n" }
295 |  |  |  |  |
296 |  |  |  |  | =cut
297 |  |  |  |  |
298 |  |  |  |  | # spent 38µs (24+14) within Variable::Magic::wizard which was called # once (24µs+14µs) by namespace::clean::BEGIN@14 at line 47 of B/Hooks/EndOfScope.pm sub wizard {
299 | 11 | 39µs |  |  | croak 'Wrong number of arguments for wizard()' if @_ % 2;
300 |  |  |  |  | my %opts = @_;
301 |  |  |  |  | my @keys = qw/data op_info get set len clear free/;
302 |  |  |  |  | push @keys, 'copy' if MGf_COPY;
303 |  |  |  |  | push @keys, 'dup' if MGf_DUP;
304 |  |  |  |  | push @keys, 'local' if MGf_LOCAL;
305 |  |  |  |  | push @keys, qw/fetch store exists delete copy_key/ if VMG_UVAR;
306 |  |  |  |  | my $ret = eval { _wizard(map $opts{$_}, @keys) }; # spent 14µs making 1 call to Variable::Magic::_wizard
307 |  |  |  |  | if (my $err = $@) {
308 |  |  |  |  | $err =~ s/\sat\s+.*?\n//;
309 |  |  |  |  | croak $err;
310 |  |  |  |  | }
311 |  |  |  |  | return $ret;
312 |  |  |  |  | }
313 |  |  |  |  |
314 |  |  |  |  | =head2 C<cast>
315 |  |  |  |  |
316 |  |  |  |  | cast [$@%&*]var, $wiz, ...
317 |  |  |  |  |
318 |  |  |  |  | This function associates C<$wiz> magic to the variable supplied, without overwriting any other kind of magic.
319 |  |  |  |  | It returns true on success or when C<$wiz> magic is already present, and croaks on error.
320 |  |  |  |  | All extra arguments specified after C<$wiz> are passed to the private data constructor in C<@_[1 .. @_-1]>.
321 |  |  |  |  | If the variable isn't a hash, any C<uvar> callback of the wizard is safely ignored.
322 |  |  |  |  |
323 |  |  |  |  | # Casts $wiz onto $x, and pass '1' to the data constructor.
324 |  |  |  |  | my $x;
325 |  |  |  |  | cast $x, $wiz, 1;
326 |  |  |  |  |
327 |  |  |  |  | The C<var> argument can be an array or hash value.
328 |  |  |  |  | Magic for those behaves like for any other scalar, except that it is dispelled when the entry is deleted from the container.
329 |  |  |  |  | For example, if you want to call C<POSIX::tzset> each time the C<'TZ'> environment variable is changed in C<%ENV>, you can use :
330 |  |  |  |  |
331 |  |  |  |  | use POSIX;
332 |  |  |  |  | cast $ENV{TZ}, wizard set => sub { POSIX::tzset(); () };
333 |  |  |  |  |
334 |  |  |  |  | If you want to overcome the possible deletion of the C<'TZ'> entry, you have no choice but to rely on C<store> uvar magic.
335 |  |  |  |  |
336 |  |  |  |  | =head2 C<getdata>
337 |  |  |  |  |
338 |  |  |  |  | getdata [$@%&*]var, $wiz
339 |  |  |  |  |
340 |  |  |  |  | This accessor fetches the private data associated with the magic C<$wiz> in the variable.
341 |  |  |  |  | It croaks when C<$wiz> do not represent a valid magic object, and returns an empty list if no such magic is attached to the variable or when the wizard has no data constructor.
342 |  |  |  |  |
343 |  |  |  |  | # Get the attached data, or undef if the wizard does not attach any.
344 |  |  |  |  | my $data = getdata $x, $wiz;
345 |  |  |  |  |
346 |  |  |  |  | =head2 C<dispell>
347 |  |  |  |  |
348 |  |  |  |  | dispell [$@%&*]variable, $wiz
349 |  |  |  |  |
350 |  |  |  |  | The exact opposite of L</cast> : it dissociates C<$wiz> magic from the variable.
351 |  |  |  |  | This function returns true on success, C<0> when no magic represented by C<$wiz> could be found in the variable, and croaks if the supplied wizard is invalid.
352 |  |  |  |  |
353 |  |  |  |  | # Dispell now.
354 |  |  |  |  | die 'no such magic in $x' unless dispell $x, $wiz;
355 |  |  |  |  |
356 |  |  |  |  | =head1 CONSTANTS
357 |  |  |  |  |
358 |  |  |  |  | =head2 C<MGf_COPY>
359 |  |  |  |  |
360 |  |  |  |  | Evaluates to true iff the 'copy' magic is available.
361 |  |  |  |  |
362 |  |  |  |  | =head2 C<MGf_DUP>
363 |  |  |  |  |
364 |  |  |  |  | Evaluates to true iff the 'dup' magic is available.
365 |  |  |  |  |
366 |  |  |  |  | =head2 C<MGf_LOCAL>
367 |  |  |  |  |
368 |  |  |  |  | Evaluates to true iff the 'local' magic is available.
369 |  |  |  |  |
370 |  |  |  |  | =head2 C<VMG_UVAR>
371 |  |  |  |  |
372 |  |  |  |  | When this constant is true, you can use the C<fetch,store,exists,delete> callbacks on hashes.
373 |  |  |  |  |
374 |  |  |  |  | =head2 C<VMG_COMPAT_ARRAY_PUSH_NOLEN>
375 |  |  |  |  |
376 |  |  |  |  | True for perls that don't call 'len' magic when you push an element in a magical array.
377 |  |  |  |  | Starting from perl 5.11.0, this only refers to pushes in non-void context and hence is false.
378 |  |  |  |  |
379 |  |  |  |  | =head2 C<VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID>
380 |  |  |  |  |
381 |  |  |  |  | True for perls that don't call 'len' magic when you push in void context an element in a magical array.
382 |  |  |  |  |
383 |  |  |  |  | =head2 C<VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID>
384 |  |  |  |  |
385 |  |  |  |  | True for perls that don't call 'len' magic when you unshift in void context an element in a magical array.
386 |  |  |  |  |
387 |  |  |  |  | =head2 C<VMG_COMPAT_ARRAY_UNDEF_CLEAR>
388 |  |  |  |  |
389 |  |  |  |  | True for perls that call 'clear' magic when undefining magical arrays.
390 |  |  |  |  |
391 |  |  |  |  | =head2 C<VMG_COMPAT_SCALAR_LENGTH_NOLEN>
392 |  |  |  |  |
393 |  |  |  |  | True for perls that don't call 'len' magic when taking the C<length> of a magical scalar.
394 |  |  |  |  |
395 |  |  |  |  | =head2 C<VMG_PERL_PATCHLEVEL>
396 |  |  |  |  |
397 |  |  |  |  | The perl patchlevel this module was built with, or C<0> for non-debugging perls.
398 |  |  |  |  |
399 |  |  |  |  | =head2 C<VMG_THREADSAFE>
400 |  |  |  |  |
401 |  |  |  |  | True iff this module could have been built with thread-safety features enabled.
402 |  |  |  |  |
403 |  |  |  |  | =head2 C<VMG_FORKSAFE>
404 |  |  |  |  |
405 |  |  |  |  | True iff this module could have been built with fork-safety features enabled.
406 |  |  |  |  | This will always be true except on Windows where it's false for perl 5.10.0 and below .
407 |  |  |  |  |
408 |  |  |  |  | =head2 C<VMG_OP_INFO_NAME>
409 |  |  |  |  |
410 |  |  |  |  | Value to pass with C<op_info> to get the current op name in the magic callbacks.
411 |  |  |  |  |
412 |  |  |  |  | =head2 C<VMG_OP_INFO_OBJECT>
413 |  |  |  |  |
414 |  |  |  |  | Value to pass with C<op_info> to get a C<B::OP> object representing the current op in the magic callbacks.
415 |  |  |  |  |
416 |  |  |  |  | =head1 COOKBOOK
417 |  |  |  |  |
418 |  |  |  |  | =head2 Associate an object to any perl variable
419 |  |  |  |  |
420 |  |  |  |  | This can be useful for passing user data through limited APIs.
421 |  |  |  |  |
422 |  |  |  |  | {
423 |  |  |  |  | package Magical::UserData;
424 |  |  |  |  |
425 |  |  |  |  | use Variable::Magic qw/wizard cast getdata/;
426 |  |  |  |  |
427 |  |  |  |  | my $wiz = wizard data => sub { \$_[1] };
428 |  |  |  |  |
429 |  |  |  |  | sub ud (\[$@%*&]) : lvalue {
430 |  |  |  |  | my ($var) = @_;
431 |  |  |  |  | my $data = &getdata($var, $wiz);
432 |  |  |  |  | unless (defined $data) {
433 |  |  |  |  | &cast($var, $wiz);
434 |  |  |  |  | $data = &getdata($var, $wiz);
435 |  |  |  |  | die "Couldn't cast UserData magic onto the variable" unless defined $data;
436 |  |  |  |  | }
437 |  |  |  |  | $$data;
438 |  |  |  |  | }
439 |  |  |  |  | }
440 |  |  |  |  |
441 |  |  |  |  | {
442 |  |  |  |  | BEGIN { *ud = \&Magical::UserData::ud }
443 |  |  |  |  |
444 |  |  |  |  | my $cb;
445 |  |  |  |  | $cb = sub { print 'Hello, ', ud(&$cb), "!\n" };
446 |  |  |  |  |
447 |  |  |  |  | ud(&$cb) = 'world';
448 |  |  |  |  | $cb->(); # Hello, world!
449 |  |  |  |  | }
450 |  |  |  |  |
451 |  |  |  |  | =head2 Recursively cast magic on datastructures
452 |  |  |  |  |
453 |  |  |  |  | C<cast> can be called from any magical callback, and in particular from C<data>.
454 |  |  |  |  | This allows you to recursively cast magic on datastructures :
455 |  |  |  |  |
456 |  |  |  |  | my $wiz;
457 |  |  |  |  | $wiz = wizard data => sub {
458 |  |  |  |  | my ($var, $depth) = @_;
459 |  |  |  |  | $depth ||= 0;
460 |  |  |  |  | my $r = ref $var;
461 |  |  |  |  | if ($r eq 'ARRAY') {
462 |  |  |  |  | &cast((ref() ? $_ : \$_), $wiz, $depth + 1) for @$var;
463 |  |  |  |  | } elsif ($r eq 'HASH') {
464 |  |  |  |  | &cast((ref() ? $_ : \$_), $wiz, $depth + 1) for values %$var;
465 |  |  |  |  | }
466 |  |  |  |  | return $depth;
467 |  |  |  |  | },
468 |  |  |  |  | free => sub {
469 |  |  |  |  | my ($var, $depth) = @_;
470 |  |  |  |  | my $r = ref $var;
471 |  |  |  |  | print "free $r at depth $depth\n";
472 |  |  |  |  | ();
473 |  |  |  |  | };
474 |  |  |  |  |
475 |  |  |  |  | {
476 |  |  |  |  | my %h = (
477 |  |  |  |  | a => [ 1, 2 ],
478 |  |  |  |  | b => { c => 3 }
479 |  |  |  |  | );
480 |  |  |  |  | cast %h, $wiz;
481 |  |  |  |  | }
482 |  |  |  |  |
483 |  |  |  |  | When C<%h> goes out of scope, this will print something among the lines of :
484 |  |  |  |  |
485 |  |  |  |  | free HASH at depth 0
486 |  |  |  |  | free HASH at depth 1
487 |  |  |  |  | free SCALAR at depth 2
488 |  |  |  |  | free ARRAY at depth 1
489 |  |  |  |  | free SCALAR at depth 3
490 |  |  |  |  | free SCALAR at depth 3
491 |  |  |  |  |
492 |  |  |  |  | Of course, this example does nothing with the values that are added after the C<cast>.
493 |  |  |  |  |
494 |  |  |  |  | =head1 PERL MAGIC HISTORY
495 |  |  |  |  |
496 |  |  |  |  | The places where magic is invoked have changed a bit through perl history.
497 |  |  |  |  | Here's a little list of the most recent ones.
498 |  |  |  |  |
499 |  |  |  |  | =over 4
500 |  |  |  |  |
501 |  |  |  |  | =item *
502 |  |  |  |  |
503 |  |  |  |  | B<5.6.x>
504 |  |  |  |  |
505 |  |  |  |  | I<p14416> : 'copy' and 'dup' magic.
506 |  |  |  |  |
507 |  |  |  |  | =item *
508 |  |  |  |  |
509 |  |  |  |  | B<5.8.9>
510 |  |  |  |  |
511 |  |  |  |  | I<p28160> : Integration of I<p25854> (see below).
512 |  |  |  |  |
513 |  |  |  |  | I<p32542> : Integration of I<p31473> (see below).
514 |  |  |  |  |
515 |  |  |  |  | =item *
516 |  |  |  |  |
517 |  |  |  |  | B<5.9.3>
518 |  |  |  |  |
519 |  |  |  |  | I<p25854> : 'len' magic is no longer called when pushing an element into a magic array.
520 |  |  |  |  |
521 |  |  |  |  | I<p26569> : 'local' magic.
522 |  |  |  |  |
523 |  |  |  |  | =item *
524 |  |  |  |  |
525 |  |  |  |  | B<5.9.5>
526 |  |  |  |  |
527 |  |  |  |  | I<p31064> : Meaningful 'uvar' magic.
528 |  |  |  |  |
529 |  |  |  |  | I<p31473> : 'clear' magic wasn't invoked when undefining an array.
530 |  |  |  |  | The bug is fixed as of this version.
531 |  |  |  |  |
532 |  |  |  |  | =item *
533 |  |  |  |  |
534 |  |  |  |  | B<5.10.0>
535 |  |  |  |  |
536 |  |  |  |  | Since C<PERL_MAGIC_uvar> is uppercased, C<hv_magic_check()> triggers 'copy' magic on hash stores for (non-tied) hashes that also have 'uvar' magic.
537 |  |  |  |  |
538 |  |  |  |  | =item *
539 |  |  |  |  |
540 |  |  |  |  | B<5.11.x>
541 |  |  |  |  |
542 |  |  |  |  | I<p32969> : 'len' magic is no longer invoked when calling C<length> with a magical scalar.
543 |  |  |  |  |
544 |  |  |  |  | I<p34908> : 'len' magic is no longer called when pushing / unshifting an element into a magical array in void context.
545 |  |  |  |  | The C<push> part was already covered by I<p25854>.
546 |  |  |  |  |
547 |  |  |  |  | I<g9cdcb38b> : 'len' magic is called again when pushing into a magical array in non-void context.
548 |  |  |  |  |
549 |  |  |  |  | =back
550 |  |  |  |  |
551 |  |  |  |  | =head1 EXPORT
552 |  |  |  |  |
553 |  |  |  |  | The functions L</wizard>, L</cast>, L</getdata> and L</dispell> are only exported on request.
554 |  |  |  |  | All of them are exported by the tags C<':funcs'> and C<':all'>.
555 |  |  |  |  |
556 |  |  |  |  | All the constants are also only exported on request, either individually or by the tags C<':consts'> and C<':all'>.
557 |  |  |  |  |
558 |  |  |  |  | =cut
559 |  |  |  |  |
560 | 3 | 103µs | 2 | 95µs | # spent 51µs (8+43) within Variable::Magic::BEGIN@560 which was called # once (8µs+43µs) by B::Hooks::EndOfScope::BEGIN@7 at line 560 use base qw/Exporter/; # spent 51µs making 1 call to Variable::Magic::BEGIN@560 # spent 43µs making 1 call to base::import
561 |  |  |  |  |
562 | 1 | 500ns |  |  | our @EXPORT = ();
563 | 1 | 6µs |  |  | our %EXPORT_TAGS = (
564 |  |  |  |  | 'funcs' => [ qw/wizard cast getdata dispell/ ],
565 |  |  |  |  | 'consts' => [
566 |  |  |  |  | qw/MGf_COPY MGf_DUP MGf_LOCAL VMG_UVAR/,
567 |  |  |  |  | qw/VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID/,
568 |  |  |  |  | qw/VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID/,
569 |  |  |  |  | qw/VMG_COMPAT_ARRAY_UNDEF_CLEAR/,
570 |  |  |  |  | qw/VMG_COMPAT_SCALAR_LENGTH_NOLEN/,
571 |  |  |  |  | qw/VMG_PERL_PATCHLEVEL/,
572 |  |  |  |  | qw/VMG_THREADSAFE VMG_FORKSAFE/,
573 |  |  |  |  | qw/VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT/
574 |  |  |  |  | ]
575 |  |  |  |  | );
576 | 1 | 15µs |  |  | our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
577 | 1 | 3µs |  |  | $EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
578 |  |  |  |  |
579 |  |  |  |  | =head1 CAVEATS
580 |  |  |  |  |
581 |  |  |  |  | If you store a magic object in the private data slot, the magic won't be accessible by L</getdata> since it's not copied by assignment.
582 |  |  |  |  | The only way to address this would be to return a reference.
583 |  |  |  |  |
584 |  |  |  |  | If you define a wizard with a C<free> callback and cast it on itself, this destructor won't be called because the wizard will be destroyed first.
585 |  |  |  |  |
586 |  |  |  |  | =head1 DEPENDENCIES
587 |  |  |  |  |
588 |  |  |  |  | L<perl> 5.8.
589 |  |  |  |  |
590 |  |  |  |  | L<Carp> (standard since perl 5), L<XSLoader> (standard since perl 5.006).
591 |  |  |  |  |
592 |  |  |  |  | Copy tests need L<Tie::Array> (standard since perl 5.005) and L<Tie::Hash> (since 5.002).
593 |  |  |  |  |
594 |  |  |  |  | Some uvar tests need L<Hash::Util::FieldHash> (standard since perl 5.009004).
595 |  |  |  |  |
596 |  |  |  |  | Glob tests need L<Symbol> (standard since perl 5.002).
597 |  |  |  |  |
598 |  |  |  |  | Threads tests need L<threads> and L<threads::shared>.
599 |  |  |  |  |
600 |  |  |  |  | =head1 SEE ALSO
601 |  |  |  |  |
602 |  |  |  |  | L<perlguts> and L<perlapi> for internal information about magic.
603 |  |  |  |  |
604 |  |  |  |  | L<perltie> and L<overload> for other ways of enhancing objects.
605 |  |  |  |  |
606 |  |  |  |  | =head1 AUTHOR
607 |  |  |  |  |
608 |  |  |  |  | Vincent Pit, C<< <perl at profvince.com> >>, L<http://www.profvince.com>.
609 |  |  |  |  |
610 |  |  |  |  | You can contact me by mail or on C<irc.perl.org> (vincent).
611 |  |  |  |  |
612 |  |  |  |  | =head1 BUGS
613 |  |  |  |  |
614 |  |  |  |  | Please report any bugs or feature requests to C<bug-variable-magic at rt.cpan.org>, or through the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Variable-Magic>. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes.
615 |  |  |  |  |
616 |  |  |  |  | =head1 SUPPORT
617 |  |  |  |  |
618 |  |  |  |  | You can find documentation for this module with the perldoc command.
619 |  |  |  |  |
620 |  |  |  |  | perldoc Variable::Magic
621 |  |  |  |  |
622 |  |  |  |  | Tests code coverage report is available at L<http://www.profvince.com/perl/cover/Variable-Magic>.
623 |  |  |  |  |
624 |  |  |  |  | =head1 COPYRIGHT & LICENSE
625 |  |  |  |  |
626 |  |  |  |  | Copyright 2007-2009 Vincent Pit, all rights reserved.
627 |  |  |  |  |
628 |  |  |  |  | This program is free software; you can redistribute it and/or modify it
629 |  |  |  |  | under the same terms as Perl itself.
630 |  |  |  |  |
631 |  |  |  |  | =cut
632 |  |  |  |  |
633 | 1 | 14µs |  |  | 1; # End of Variable::Magic
|  |  |  |  | # spent 14µs within Variable::Magic::_wizard which was called # once (14µs+0s) by Variable::Magic::wizard at line 306 of Variable/Magic.pm sub Variable::Magic::_wizard; # xsub
|  |  |  |  | # spent 29µs (23+6) within Variable::Magic::cast which was called 4 times, avg 7µs/call: # 4 times (23µs+6µs) by B::Hooks::EndOfScope::on_scope_end at line 58 of B/Hooks/EndOfScope.pm, avg 7µs/call sub Variable::Magic::cast; # xsub
|  |  |  |  | # spent 4µs within Variable::Magic::getdata which was called 4 times, avg 900ns/call: # 4 times (4µs+0s) by B::Hooks::EndOfScope::on_scope_end at line 54 of B/Hooks/EndOfScope.pm, avg 900ns/call sub Variable::Magic::getdata; # xsub