X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FVariable%2FMagic.pm;h=fd2c0ef6b3b73e7b3f3e186626a9b1fe9c0f211a;hb=800e9f939f181af9766c3a3024ac9f57b9799510;hp=141d966ab9f90ebe443deee6ba6dab8be1c3f2f5;hpb=cc99f7f4711b525f7d3b7c4480528b480eac0a48;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/lib/Variable/Magic.pm b/lib/Variable/Magic.pm index 141d966..fd2c0ef 100644 --- a/lib/Variable/Magic.pm +++ b/lib/Variable/Magic.pm @@ -25,8 +25,10 @@ BEGIN { use Variable::Magic qw; { # A variable tracer - my $wiz = wizard set => sub { print "now set to ${$_[0]}!\n" }, - free => sub { print "destroyed!\n" }; + my $wiz = wizard( + set => sub { print "now set to ${$_[0]}!\n" }, + free => sub { print "destroyed!\n" }, + ); my $a = 1; cast $a, $wiz; @@ -34,15 +36,17 @@ BEGIN { } # "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 $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 + print $h{banana}, "\n"; # "0" (there is no 'banana' key in %h) $h{pear} = 1; # "key pear stored in helem" } @@ -206,20 +210,24 @@ BEGIN { =head2 C - wizard data => sub { ... }, - get => sub { my ($ref, $data [, $op]) = @_; ... }, - set => sub { my ($ref, $data [, $op]) = @_; ... }, - len => sub { my ($ref, $data, $len [, $op]) = @_; ... ; return $newlen; }, - clear => sub { my ($ref, $data [, $op]) = @_; ... }, - free => sub { my ($ref, $data [, $op]) = @_, ... }, - copy => sub { my ($ref, $data, $key, $elt [, $op]) = @_; ... }, - local => sub { my ($ref, $data [, $op]) = @_; ... }, - fetch => sub { my ($ref, $data, $key [, $op]) = @_; ... }, - store => sub { my ($ref, $data, $key [, $op]) = @_; ... }, - exists => sub { my ($ref, $data, $key [, $op]) = @_; ... }, - delete => sub { my ($ref, $data, $key [, $op]) = @_; ... }, - copy_key => $bool, - op_info => [ 0 | VMG_OP_INFO_NAME | VMG_OP_INFO_OBJECT ] + wizard( + data => sub { ... }, + get => sub { my ($ref, $data [, $op]) = @_; ... }, + set => sub { my ($ref, $data [, $op]) = @_; ... }, + len => sub { + my ($ref, $data, $len [, $op]) = @_; ... ; return $newlen + }, + clear => sub { my ($ref, $data [, $op]) = @_; ... }, + free => sub { my ($ref, $data [, $op]) = @_, ... }, + copy => sub { my ($ref, $data, $key, $elt [, $op]) = @_; ... }, + local => sub { my ($ref, $data [, $op]) = @_; ... }, + fetch => sub { my ($ref, $data, $key [, $op]) = @_; ... }, + store => sub { my ($ref, $data, $key [, $op]) = @_; ... }, + exists => sub { my ($ref, $data, $key [, $op]) = @_; ... }, + delete => sub { my ($ref, $data, $key [, $op]) = @_; ... }, + copy_key => $bool, + op_info => [ 0 | VMG_OP_INFO_NAME | VMG_OP_INFO_OBJECT ], + ) This function creates a 'wizard', an opaque type that holds the magic information. It takes a list of keys / values as argument, whose keys can be : @@ -287,9 +295,11 @@ Note that C callbacks are I called during global destruction, as th Here's a simple usage example : # A simple scalar tracer - my $wiz = wizard get => sub { print STDERR "got ${$_[0]}\n" }, - set => sub { print STDERR "set to ${$_[0]}\n" }, - free => sub { print STDERR "${$_[0]} was deleted\n" } + my $wiz = wizard( + get => sub { print STDERR "got ${$_[0]}\n" }, + set => sub { print STDERR "set to ${$_[0]}\n" }, + free => sub { print STDERR "${$_[0]} was deleted\n" }, + ); =cut @@ -301,7 +311,7 @@ sub wizard { my %opts = @_; - my @keys = qw; + my @keys = qw; push @keys, 'copy' if MGf_COPY; push @keys, 'dup' if MGf_DUP; push @keys, 'local' if MGf_LOCAL; @@ -450,7 +460,7 @@ It is similar to using inside-out objects, but without the drawback of having to unless (defined $data) { $data = \(my $slot); &cast($var, $wiz, $slot) - or die "Couldn't cast UserData magic onto the variable"; + or die "Couldn't cast UserData magic onto the variable"; } $$data; }