X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=lib%2FVariable%2FMagic.pm;h=eca6f03446ca6599c4e1291d9e4a30e023ffca19;hb=09eec5bc080312cd08d566d2ea1add367d57cdb7;hp=52425fb565e5fa04f8da3fa9ec9c20560d14e99f;hpb=8c49e5b8fe531ebdf14f14288ad05a68b49f4a79;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/lib/Variable/Magic.pm b/lib/Variable/Magic.pm index 52425fb..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.27 +Version 0.30 =cut our $VERSION; BEGIN { - $VERSION = '0.27'; + $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 @@ -278,19 +286,21 @@ BEGIN { =head2 C - 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) = @_; ... } + wizard sig => ..., + 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 : @@ -317,12 +327,42 @@ 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 corresponding magic callbacks. +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). -In the special case of C magic and when the variable is an array, C<$_[2]> contains its normal length. -C<$_[2]> is the current key in C, C, C, C and C callbacks, although for C it may just be a copy of the actual key so it's useless to (for example) cast magic on it. -C magic also receives the current element (i.e. the value) in C<$_[3]>. + +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 * + +C + +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 * + +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 * + +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. +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. + +=back All the callbacks are expected to return an integer, which is passed straight to the perl magic API. However, only the return value of the C callback currently holds a meaning. @@ -339,12 +379,12 @@ 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 @cbs = qw/sig data get set len clear free/; - push @cbs, 'copy' if MGf_COPY; - push @cbs, 'dup' if MGf_DUP; - push @cbs, 'local' if MGf_LOCAL; - push @cbs, qw/fetch store exists delete/ if VMG_UVAR; - my $ret = eval { _wizard(map $opts{$_}, @cbs) }; + 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; + push @keys, qw/fetch store exists delete copy_key/ if VMG_UVAR; + my $ret = eval { _wizard(map $opts{$_}, @keys) }; if (my $err = $@) { $err =~ s/\sat\s+.*?\n//; croak $err; @@ -383,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] @@ -419,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. @@ -435,11 +488,9 @@ 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. -Using simultaneously C and C magics on hashes may cause segfaults. - =head1 DEPENDENCIES -L 5.7.3. +L 5.8. L (standard since perl 5), L (standard since perl 5.006).