X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FVariable%2FMagic.pm;h=ac1f80676074026591be2e87afd3f54e0dad5006;hb=7d7ecf0199c007b554b0d8297c1486edfcb99464;hp=556e9954356263af5da0fd5d98843ad680ec1e5c;hpb=465116de630d8f9964b584e370ca991bd14cf542;p=perl%2Fmodules%2FVariable-Magic.git

diff --git a/lib/Variable/Magic.pm b/lib/Variable/Magic.pm
index 556e995..ac1f806 100644
--- a/lib/Variable/Magic.pm
+++ b/lib/Variable/Magic.pm
@@ -13,25 +13,40 @@ Variable::Magic - Associate user-defined magic to variables from Perl.
 
 =head1 VERSION
 
-Version 0.30
+Version 0.31
 
 =cut
 
 our $VERSION;
 BEGIN {
- $VERSION = '0.30';
+ $VERSION = '0.31';
 }
 
 =head1 SYNOPSIS
 
-    use Variable::Magic qw/wizard cast dispell/;
+    use Variable::Magic qw/wizard cast VMG_OP_INFO_NAME/;
 
-    my $wiz = wizard set => sub { print STDERR "now set to ${$_[0]}!\n" };
-    my $a = 1;
-    cast $a, $wiz;
-    $a = 2;          # "now set to 2!"
-    dispell $a, $wiz;
-    $a = 3           # (nothing)
+    { # A variable tracer
+     my $wiz = wizard set  => sub { print "now set to ${$_[0]}!\n" },
+                      free => sub { print "destroyed!\n" };
+
+     my $a = 1;
+     cast $a, $wiz;
+     $a = 2;        # "now set to 2!"
+    }               # "destroyed!"
+
+    { # A hash with a default value
+     my $wiz = wizard data     => sub { $_[1] },
+                      fetch    => sub { $_[2] = $_[1] unless exists $_[0]->{$_[2]}; () },
+                      store    => sub { print "key $_[2] stored in $_[-1]\n" },
+                      copy_key => 1,
+                      op_info  => VMG_OP_INFO_NAME;
+
+     my %h = (_default => 0, apple => 2);
+     cast %h, $wiz, '_default';
+     print $h{banana}, "\n"; # "0", because the 'banana' key doesn't exist in %h
+     $h{pear} = 1;           # "key pear stored in helem"
+    }
 
 =head1 DESCRIPTION
 
@@ -336,6 +351,48 @@ For example, if you want to call C<POSIX::tzset> each time the C<'TZ'> environme
 
 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.
 
+C<cast> can be called from any magical callback, and in particular from C<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 C<%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 C<cast>.
+
 =head2 C<getdata>
 
     getdata [$@%&*]var, [$wiz|$sig]
@@ -479,8 +536,7 @@ The C<push> part was already covered by I<p25854>.
 The functions L</wizard>, L</gensig>, L</getsig>, L</cast>, L</getdata> and L</dispell> are only exported on request.
 All of them are exported by the tags C<':funcs'> and C<':all'>.
 
-The constants L</SIG_MIN>, L</SIG_MAX>, L</SIG_NBR>, L</MGf_COPY>, L</MGf_DUP>, L</MGf_LOCAL> and L</VMG_UVAR> are also only exported on request.
-They are all exported by the tags C<':consts'> and C<':all'>.
+All the constants are also only exported on request, either individually or by the tags C<':consts'> and C<':all'>.
 
 =cut