X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FVariable%2FMagic.pm;h=eca6f03446ca6599c4e1291d9e4a30e023ffca19;hb=09eec5bc080312cd08d566d2ea1add367d57cdb7;hp=19ba55f68748ffaadf2620854187de321e629f15;hpb=8d1e537ed209474d537750620e118f79455a883f;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/lib/Variable/Magic.pm b/lib/Variable/Magic.pm index 19ba55f..eca6f03 100644 --- a/lib/Variable/Magic.pm +++ b/lib/Variable/Magic.pm @@ -1,6 +1,6 @@ package Variable::Magic; -use 5.007003; +use 5.008; use strict; use warnings; @@ -13,13 +13,13 @@ Variable::Magic - Associate user-defined magic to variables from Perl. =head1 VERSION -Version 0.28 +Version 0.30 =cut our $VERSION; BEGIN { - $VERSION = '0.28'; + $VERSION = '0.30'; } =head1 SYNOPSIS @@ -267,6 +267,14 @@ 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 + +Value to pass with C to get the current op name in the magic callbacks. + +=head2 C + +Value to pass with C to get a C object representing the current op in the magic callbacks. + =head1 FUNCTIONS =cut @@ -280,18 +288,19 @@ BEGIN { wizard sig => ..., data => sub { ... }, - get => sub { my ($ref, $data) = @_; ... }, - set => sub { my ($ref, $data) = @_; ... }, - len => sub { my ($ref, $data, $len) = @_; ... ; return $newlen; }, - clear => sub { my ($ref, $data) = @_; ... }, - free => sub { my ($ref, $data) = @_, ... }, - copy => sub { my ($ref, $data, $key, $elt) = @_; ... }, - local => sub { my ($ref, $data) = @_; ... }, - fetch => sub { my ($ref, $data, $key) = @_; ... }, - store => sub { my ($ref, $data, $key) = @_; ... }, - exists => sub { my ($ref, $data, $key) = @_; ... }, - delete => sub { my ($ref, $data, $key) = @_; ... }, - copy_key => $bool + 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 : @@ -321,25 +330,29 @@ C, C, C, C, C, C, C, C, C Code 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). + +Moreover, when you pass C<< op_info => $num >> to C, the last element of C<@_> will be the current op name if C<$num == VMG_OP_INFO_NAME> and a C object representing the current op if C<$num == VMG_OP_INFO_OBJECT>. +Both have a performance hit, but just getting the name is lighter than getting the op object. + Other arguments are specific to the magic hooked : =over 8 -=item - +=item * C -When the variable is an array, C<$_[2]> contains the normal length. -The callback is also expected to return the new scalar or array length. +When the variable is an array or a scalar, C<$_[2]> contains the non-magical length. +The callback can return the new scalar or array length to use, or C to default to the normal length. -=item - +=item * C C<$_[2]> is a either a copy or an alias of the current key, which means that it is useless to try to change or cast magic on it. C<$_[3]> is an alias to the current element (i.e. the value). -=item - +=item * C, C, C and C @@ -366,7 +379,7 @@ However, only the return value of the C callback currently holds a meaning. sub wizard { croak 'Wrong number of arguments for wizard()' if @_ % 2; my %opts = @_; - my @keys = qw/sig data get set len clear free/; + my @keys = qw/sig 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; @@ -410,6 +423,15 @@ If the variable isn't a hash, any C callback of the wizard is safely ignor my $x; die 'error' unless cast $x, $wiz; +The C argument can be an array or hash value. +Magic for those behaves like for any other scalar, except that it is dispelled when the entry is deleted from the container. +For example, if you want to call C each time the C<'TZ'> environment variable is changed in C<%ENV>, you can use : + + use POSIX; + cast $ENV{TZ}, wizard set => sub { POSIX::tzset(); () }; + +If you want to overcome the possible deletion of the C<'TZ'> entry, you have no choice but to rely on C uvar magic. + =head2 C getdata [$@%&*]var, [$wiz|$sig] @@ -446,15 +468,19 @@ use base qw/Exporter/; our @EXPORT = (); our %EXPORT_TAGS = ( 'funcs' => [ qw/wizard gensig getsig 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/, - qw/VMG_COMPAT_SCALAR_LENGTH_NOLEN/, + '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/VMG_PERL_PATCHLEVEL/, - qw/VMG_THREADSAFE/ ] + qw/VMG_THREADSAFE/, + qw/VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT/ + ] ); our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; $EXPORT_TAGS{'all'} = [ @EXPORT_OK ]; +END { _cleanup() } + =head1 CAVEATS If you store a magic object in the private data slot, the magic won't be accessible by L since it's not copied by assignation. @@ -464,7 +490,7 @@ If you define a wizard with a C callback and cast it on itself, this destr =head1 DEPENDENCIES -L 5.7.3. +L 5.8. L (standard since perl 5), L (standard since perl 5.006).