X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FVariable%2FMagic.pm;h=f599b7239861954b5d538368039f6b6c4a960956;hb=6c0a2afbec3921761d384fdebacba3f0407cb721;hp=9e24440331643d8857c1f19824f68e90d9380f6e;hpb=505fda7126b01811c0ca990552876a1c6d9dc7c3;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/lib/Variable/Magic.pm b/lib/Variable/Magic.pm index 9e24440..f599b72 100644 --- a/lib/Variable/Magic.pm +++ b/lib/Variable/Magic.pm @@ -13,13 +13,13 @@ Variable::Magic - Associate user-defined magic to variables from Perl. =head1 VERSION -Version 0.32 +Version 0.39 =cut our $VERSION; BEGIN { - $VERSION = '0.32'; + $VERSION = '0.39'; } =head1 SYNOPSIS @@ -72,8 +72,8 @@ You attach it to variables, not values (as for blessed references). It doesn't replace the original semantics. -Magic callbacks trigger before the original action take place, and can't prevent it to happen. -This makes catching individual events easier than with C, where you have to provide fallbacks methods for all actions by usually inheriting from the correct C class and overriding individual methods in your own class. +Magic callbacks usually trigger before the original action take place, and can't prevent it to happen. +This also makes catching individual events easier than with C, where you have to provide fallbacks methods for all actions by usually inheriting from the correct C class and overriding individual methods in your own class. =item * @@ -105,13 +105,15 @@ The operations that can be overloaded are : C -This magic is invoked when the variable is evaluated (does not include array/hash subscripts and slices). +This magic is invoked when the variable is evaluated. +It is never called for arrays and hashes. =item * C -This one is triggered each time the value of the variable changes (includes array/hash subscripts and slices). +This one is triggered each time the value of the variable changes. +It is called for array subscripts and slices, but never for hashes. =item * @@ -206,8 +208,7 @@ BEGIN { =head2 C - wizard sig => ..., - data => sub { ... }, + wizard data => sub { ... }, get => sub { my ($ref, $data [, $op]) = @_; ... }, set => sub { my ($ref, $data [, $op]) = @_; ... }, len => sub { my ($ref, $data, $len [, $op]) = @_; ... ; return $newlen; }, @@ -229,17 +230,9 @@ It takes a list of keys / values as argument, whose keys can be : =item * -C - -The numerical signature. -If not specified or undefined, a random signature is generated. -If the signature matches an already defined magic, then the existant magic object is returned. - -=item * - C -A code reference to a private data constructor. +A code (or string) reference to a private data constructor. It is called each time this magic is cast on a variable, and the scalar returned is used as private data storage for it. C<$_[0]> is a reference to the magic object and C<@_[1 .. @_-1]> are all extra arguments that were passed to L. @@ -247,7 +240,7 @@ C<$_[0]> is a reference to the magic object and C<@_[1 .. @_-1]> are all extra a C, C, C, C, C, C, C, C, C, C and C -Code references to the corresponding magic callbacks. +Code (or string) references to the corresponding magic callbacks. You don't have to specify all of them : the magic associated with undefined entries simply won't be hooked. In those callbacks, C<$_[0]> is always a reference to the magic object and C<$_[1]> is always the private data (or C when no private data constructor was supplied). @@ -278,7 +271,7 @@ C, C, C and C C<$_[2]> is an alias to the current key. Nothing prevents you from changing it, but be aware that there lurk dangerous side effects. -For example, it may righteously be readonly if the key was a bareword. +For example, it may rightfully be readonly if the key was a bareword. You can get a copy instead by passing C<< copy_key => 1 >> to L, which allows you to safely assign to C<$_[2]> in order to e.g. redirect the action to another key. This however has a little performance drawback because of the copy. @@ -289,19 +282,23 @@ 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. + +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" } -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. - =cut sub wizard { croak 'Wrong number of arguments for wizard()' if @_ % 2; my %opts = @_; - my @keys = qw/sig data op_info get set len clear free/; + my @keys = qw/data op_info get set len clear free/; push @keys, 'copy' if MGf_COPY; push @keys, 'dup' if MGf_DUP; push @keys, 'local' if MGf_LOCAL; @@ -314,30 +311,12 @@ sub wizard { return $ret; } -=head2 C - -With this tool, you can manually generate random magic signature between SIG_MIN and SIG_MAX inclusive. -That's the way L creates them when no signature is supplied. - - # Generate a signature - my $sig = gensig; - -=head2 C - - getsig $wiz - -This accessor returns the magic signature of this wizard. - - # Get $wiz signature - my $sig = getsig $wiz; - =head2 C - cast [$@%&*]var, [$wiz|$sig], ... + cast [$@%&*]var, $wiz, ... This function associates C<$wiz> magic to the variable supplied, without overwriting any other kind of magic. -You can also supply the numeric signature C<$sig> instead of C<$wiz>. -It returns true on success or when C<$wiz> magic is already present, and croaks on error or when no magic corresponds to the given signature (in case a C<$sig> was supplied). +It returns true on success or when C<$wiz> magic is already present, and croaks on error. All extra arguments specified after C<$wiz> are passed to the private data constructor in C<@_[1 .. @_-1]>. If the variable isn't a hash, any C callback of the wizard is safely ignored. @@ -354,83 +333,28 @@ For example, if you want to call C 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 uvar magic. -C can be called from any magical callback, and in particular from C. -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. - =head2 C - getdata [$@%&*]var, [$wiz|$sig] + getdata [$@%&*]var, $wiz -This accessor fetches the private data associated with the magic C<$wiz> (or the signature C<$sig>) in the variable. -It croaks when C<$wiz> or C<$sig> do not represent a current valid magic object attached to the variable, and returns C when the wizard has no data constructor or when the data is actually C. +This accessor fetches the private data associated with the magic C<$wiz> in the variable. +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. # Get the attached data, or undef if the wizard does not attach any. my $data = getdata $x, $wiz; =head2 C - dispell [$@%&*]variable, [$wiz|$sig] + dispell [$@%&*]variable, $wiz The exact opposite of L : it dissociates C<$wiz> magic from the variable. -You can also pass the magic signature C<$sig> as the second argument. -This function returns true on success, C<0> when no magic represented by C<$wiz> or C<$sig> could be found in the variable, and croaks if the supplied wizard or signature is invalid. +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. # Dispell now. die 'no such magic in $x' unless dispell $x, $wiz; =head1 CONSTANTS -=head2 C - -The minimum integer used as a signature for user-defined magic. - -=head2 C - -The maximum integer used as a signature for user-defined magic. - -=head2 C - - SIG_NBR = SIG_MAX - SIG_MIN + 1 - =head2 C Evaluates to true iff the 'copy' magic is available. @@ -450,6 +374,11 @@ When this constant is true, you can use the C callbac =head2 C True for perls that don't call 'len' magic when you push an element in a magical array. +Starting from perl 5.11.0, this only refers to pushes in non-void context and hence is false. + +=head2 C + +True for perls that don't call 'len' magic when you push in void context an element in a magical array. =head2 C @@ -471,6 +400,11 @@ The perl patchlevel this module was built with, or C<0> for non-debugging perls. True iff this module could have been built with thread-safety features enabled. +=head2 C + +True iff this module could have been built with fork-safety features enabled. +This will always be true except on Windows where it's false for perl 5.10.0 and below . + =head2 C Value to pass with C to get the current op name in the magic callbacks. @@ -479,6 +413,84 @@ Value to pass with C to get the current op name in the magic callbacks. Value to pass with C to get a C object representing the current op in the magic callbacks. +=head1 COOKBOOK + +=head2 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! + } + +=head2 Recursively cast magic on datastructures + +C can be called from any magical callback, and in particular from C. +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. + =head1 PERL MAGIC HISTORY The places where magic is invoked have changed a bit through perl history. @@ -532,11 +544,13 @@ I : 'len' magic is no longer invoked when calling C with a magic I : 'len' magic is no longer called when pushing / unshifting an element into a magical array in void context. The C part was already covered by I. +I : 'len' magic is called again when pushing into a magical array in non-void context. + =back =head1 EXPORT -The functions L, L, L, L, L and L are only exported on request. +The functions L, L, L and L are only exported on request. All of them are exported by the tags C<':funcs'> and C<':all'>. All the constants are also only exported on request, either individually or by the tags C<':consts'> and C<':all'>. @@ -547,12 +561,15 @@ use base qw/Exporter/; our @EXPORT = (); our %EXPORT_TAGS = ( - 'funcs' => [ qw/wizard gensig getsig cast getdata dispell/ ], + 'funcs' => [ qw/wizard cast getdata dispell/ ], 'consts' => [ - qw/SIG_MIN SIG_MAX SIG_NBR MGf_COPY MGf_DUP MGf_LOCAL VMG_UVAR/, - qw/VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID VMG_COMPAT_ARRAY_UNDEF_CLEAR VMG_COMPAT_SCALAR_LENGTH_NOLEN/, + qw/MGf_COPY MGf_DUP MGf_LOCAL VMG_UVAR/, + qw/VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID/, + qw/VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID/, + qw/VMG_COMPAT_ARRAY_UNDEF_CLEAR/, + qw/VMG_COMPAT_SCALAR_LENGTH_NOLEN/, qw/VMG_PERL_PATCHLEVEL/, - qw/VMG_THREADSAFE/, + qw/VMG_THREADSAFE VMG_FORKSAFE/, qw/VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT/ ] );