Profile of Variable/Magic.pm

← Index
NYTProf Performance Profile «block view•line view•sub view»
For xt/tapper-mcp-scheduler-with-db-longrun.t
Run on Tue May 22 17:18:39 2012
Reported on Tue May 22 17:23:43 2012

Filename | /2home/ss5/perl5/perlbrew/perls/perl-5.12.3/lib/site_perl/5.12.3/x86_64-linux/Variable/Magic.pm
Statements | Executed 34 statements in 939µs

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
29 | 1 | 1 | 202µs | 284µs | Variable::Magic::::castVariable::Magic::cast (xsub)
42 | 1 | 1 | 70µs | 70µs | Variable::Magic::::getdataVariable::Magic::getdata (xsub)
1 | 1 | 1 | 33µs | 45µs | Variable::Magic::::wizardVariable::Magic::wizard
1 | 1 | 1 | 19µs | 19µs | Variable::Magic::::BEGIN@3Variable::Magic::BEGIN@3
1 | 1 | 1 | 12µs | 95µs | Variable::Magic::::BEGIN@605Variable::Magic::BEGIN@605
1 | 1 | 1 | 12µs | 288µs | Variable::Magic::::BEGIN@203Variable::Magic::BEGIN@203
1 | 1 | 1 | 11µs | 11µs | Variable::Magic::::_wizardVariable::Magic::_wizard (xsub)
1 | 1 | 1 | 7µs | 14µs | Variable::Magic::::BEGIN@6Variable::Magic::BEGIN@6
1 | 1 | 1 | 6µs | 8µs | Variable::Magic::::BEGIN@5Variable::Magic::BEGIN@5
1 | 1 | 1 | 6µs | 6µs | Variable::Magic::::BEGIN@19Variable::Magic::BEGIN@19

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