+COOKBOOK
+ Associate an object to any perl variable
+ This can be useful for passing user data through limited APIs.
+
+ {
+ package Magical::UserData;
+
+ use Variable::Magic qw/wizard cast getdata/;
+
+ my $wiz = wizard data => sub { \$_[1] };
+
+ sub ud (\[$@%*&]) : lvalue {
+ my ($var) = @_;
+ my $data = &getdata($var, $wiz);
+ unless (defined $data) {
+ &cast($var, $wiz);
+ $data = &getdata($var, $wiz);
+ die "Couldn't cast UserData magic onto the variable" unless defined $data;
+ }
+ $$data;
+ }
+ }
+
+ {
+ BEGIN { *ud = \&Magical::UserData::ud }
+
+ my $cb;
+ $cb = sub { print 'Hello, ', ud(&$cb), "!\n" };
+
+ ud(&$cb) = 'world';
+ $cb->(); # Hello, world!
+ }
+
+ Recursively cast magic on datastructures
+ "cast" can be called from any magical callback, and in particular from
+ "data". This allows you to recursively cast magic on datastructures :
+
+ my $wiz;
+ $wiz = wizard data => sub {
+ my ($var, $depth) = @_;
+ $depth ||= 0;
+ my $r = ref $var;
+ if ($r eq 'ARRAY') {
+ &cast((ref() ? $_ : \$_), $wiz, $depth + 1) for @$var;
+ } elsif ($r eq 'HASH') {
+ &cast((ref() ? $_ : \$_), $wiz, $depth + 1) for values %$var;
+ }
+ return $depth;
+ },
+ free => sub {
+ my ($var, $depth) = @_;
+ my $r = ref $var;
+ print "free $r at depth $depth\n";
+ ();
+ };
+
+ {
+ my %h = (
+ a => [ 1, 2 ],
+ b => { c => 3 }
+ );
+ cast %h, $wiz;
+ }
+
+ When %h goes out of scope, this will print something among the lines of
+ :
+
+ free HASH at depth 0
+ free HASH at depth 1
+ free SCALAR at depth 2
+ free ARRAY at depth 1
+ free SCALAR at depth 3
+ free SCALAR at depth 3
+
+ Of course, this example does nothing with the values that are added
+ after the "cast".
+
projects / perl / modules / Variable-Magic.git / commitdiff