X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FVariable%2FMagic.pm;h=73402ac0262b328ff8002695d01150c49b6cdeaa;hb=f7f52ae0225ab0bf6304c21f5c8f53b2e9307bfa;hp=c10a8057505178e62918bfae94d7bad51df0f927;hpb=06f02edd22171ea5cdb1afca36e74ec65b772609;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/lib/Variable/Magic.pm b/lib/Variable/Magic.pm index c10a805..73402ac 100644 --- a/lib/Variable/Magic.pm +++ b/lib/Variable/Magic.pm @@ -11,22 +11,24 @@ Variable::Magic - Associate user-defined magic to variables from Perl. =head1 VERSION -Version 0.44 +Version 0.47 =cut our $VERSION; BEGIN { - $VERSION = '0.44'; + $VERSION = '0.47'; } =head1 SYNOPSIS - use Variable::Magic qw/wizard cast VMG_OP_INFO_NAME/; + 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" } @@ -159,7 +163,7 @@ It is available on your perl iff C is true. =back -The following actions only apply to hashes and are available iff C is true. +The following actions only apply to hashes and are available iff L is true. They are referred to as C magics. =over 4 @@ -192,9 +196,6 @@ This last one triggers when a key is deleted in the hash, regardless of whether You can refer to the tests to have more insight of where the different magics are invoked. -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). -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. - =head1 FUNCTIONS =cut @@ -206,20 +207,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 : @@ -280,16 +285,36 @@ However, only the return value of the C callback currently holds a meaning. =back -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. +Each callback can be specified as : + +=over 4 + +=item * + +a code reference, which will be called as a subroutine. + +=item * + +a string reference, where the string denotes which subroutine is to be called when magic is triggered. +If the subroutine name is not fully qualified, then the current package at the time the magic is invoked will be used instead. + +=item * + +a reference to C, in which case a no-op magic callback is installed instead of the default one. +This may especially be helpful for 'local' magic, where an empty callback prevents magic from being copied during localization. + +=back Note that C callbacks are I called during global destruction, as there's no way to ensure that the wizard and the C callback weren't destroyed before the variable. 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,11 +326,9 @@ sub wizard { my %opts = @_; - my @keys = qw/data op_info get set len clear free/; - push @keys, 'copy' if MGf_COPY; - push @keys, 'dup' if MGf_DUP; + my @keys = qw; push @keys, 'local' if MGf_LOCAL; - push @keys, qw/fetch store exists delete copy_key/ if VMG_UVAR; + push @keys, qw if VMG_UVAR; my ($wiz, $err); { @@ -381,6 +404,12 @@ Evaluates to true iff the 'local' magic is available. =head2 C When this constant is true, you can use the C callbacks on hashes. +Initial VMG_UVAR capability was introduced in perl 5.9.5, with a fully functional implementation +shipped with perl 5.10.0. + +=head2 C + +True for perls that don't call 'len' magic when taking the C of a magical scalar. =head2 C @@ -399,9 +428,9 @@ True for perls that don't call 'len' magic when you unshift in void context an e True for perls that call 'clear' magic when undefining magical arrays. -=head2 C +=head2 C -True for perls that don't call 'len' magic when taking the C of a magical scalar. +True for perls that don't call 'delete' uvar magic when you delete an element from a hash in void context. =head2 C @@ -438,7 +467,7 @@ It is similar to using inside-out objects, but without the drawback of having to { package Magical::UserData; - use Variable::Magic qw/wizard cast getdata/; + use Variable::Magic qw; my $wiz = wizard data => sub { \$_[1] }; @@ -448,7 +477,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; } @@ -573,22 +602,23 @@ All the constants are also only exported on request, either individually or by t =cut -use base qw/Exporter/; +use base qw; our @EXPORT = (); our %EXPORT_TAGS = ( - 'funcs' => [ qw/wizard cast getdata dispell/ ], - 'consts' => [ qw/ + 'funcs' => [ qw ], + 'consts' => [ qw< MGf_COPY MGf_DUP MGf_LOCAL VMG_UVAR + VMG_COMPAT_SCALAR_LENGTH_NOLEN VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID VMG_COMPAT_ARRAY_UNDEF_CLEAR - VMG_COMPAT_SCALAR_LENGTH_NOLEN + VMG_COMPAT_HASH_DELETE_NOUVAR_VOID VMG_COMPAT_GLOB_GET VMG_PERL_PATCHLEVEL VMG_THREADSAFE VMG_FORKSAFE VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT - / ], + > ], ); our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; $EXPORT_TAGS{'all'} = [ @EXPORT_OK ]; @@ -600,10 +630,15 @@ The only way to address this would be to return a reference. If you define a wizard with a C callback and cast it on itself, this destructor won't be called because the wizard will be destroyed first. +In order to define magic on hash members, you need at least L 5.10.0 (see L) + =head1 DEPENDENCIES L 5.8. +A C compiler. +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. + L (standard since perl 5), L (standard since perl 5.006). Copy tests need L (standard since perl 5.005) and L (since 5.002). @@ -640,7 +675,7 @@ Tests code coverage report is available at L