package Variable::Magic;
-use 5.007003;
+use 5.008;
use strict;
use warnings;
=head1 VERSION
-Version 0.26
+Version 0.31
=cut
our $VERSION;
BEGIN {
- $VERSION = '0.26';
+ $VERSION = '0.31';
}
=head1 SYNOPSIS
- use Variable::Magic qw/wizard cast dispell/;
+ use Variable::Magic qw/wizard cast VMG_OP_INFO_NAME/;
- my $wiz = wizard set => sub { print STDERR "now set to ${$_[0]}!\n" };
- my $a = 1;
- cast $a, $wiz;
- $a = 2; # "now set to 2!"
- dispell $a, $wiz;
- $a = 3 # (nothing)
+ { # A variable tracer
+ my $wiz = wizard set => sub { print "now set to ${$_[0]}!\n" },
+ free => sub { print "destroyed!\n" };
+
+ my $a = 1;
+ cast $a, $wiz;
+ $a = 2; # "now set to 2!"
+ } # "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 %h = (_default => 0, apple => 2);
+ cast %h, $wiz, '_default';
+ print $h{banana}, "\n"; # "0", because the 'banana' key doesn't exist in %h
+ $h{pear} = 1; # "key pear stored in helem"
+ }
=head1 DESCRIPTION
Magic is Perl way of enhancing objects.
-This mechanism let the user add extra data to any variable and hook syntaxical operations (such as access, assignation or destruction) that can be applied to it.
-With this module, you can add your own magic to any variable without the pain of the C API.
+This mechanism lets the user add extra data to any variable and hook syntaxical operations (such as access, assignment or destruction) that can be applied to it.
+With this module, you can add your own magic to any variable without having to write a single line of XS.
+
+You'll realize that these magic variables look a lot like tied variables.
+It's not surprising, as tied variables are implemented as a special kind of magic, just like any 'irregular' Perl variable : scalars like C<$!>, C<$(> or C<$^W>, the C<%ENV> and C<%SIG> hashes, the C<@ISA> array, C<vec()> and C<substr()> lvalues, L<thread::shared> variables...
+They all share the same underlying C API, and this module gives you direct access to it.
-Magic differs from tieing and overloading in several ways :
+Still, the magic made available by this module differs from tieing and overloading in several ways :
=over 4
=item *
-Magic isn't copied on assignation (as for blessed references) : you attach it to variables, not values.
+It isn't copied on assignment.
+
+You attach it to variables, not values (as for blessed references).
+
+=item *
+
+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<tie>, where you have to provide fallbacks methods for all actions by usually inheriting from the correct C<Tie::Std*> class and overriding individual methods in your own class.
=item *
-It doesn't replace the original semantics : magic callbacks trigger before the original action take place, and can't prevent it to happen.
+It's type-agnostic.
+
+The same magic can be applied on scalars, arrays, hashes, subs or globs.
+But the same hook (see below for a list) may trigger differently depending on the the type of the variable.
=item *
-It's mostly invisible at the Perl level : magical and non-magical variables cannot be distinguished with C<ref>, C<reftype> or another trick.
+It's mostly invisible at the Perl level.
+
+Magical and non-magical variables cannot be distinguished with C<ref>, C<tied> or another trick.
=item *
-It's notably faster, since perl's way of handling magic is lighter by nature, and there's no need for any method resolution.
+It's notably faster.
+
+Mainly because perl's way of handling magic is lighter by nature, and because there's no need for any method resolution.
+Also, since you don't have to reimplement all the variable semantics, you only pay for what you actually use.
=back
C<len>
This magic is a little special : it is called when the 'size' or the 'length' of the variable has to be known by Perl.
-Typically, it's the magic involved when an array is evaluated in scalar context, but also on array assignation and loops (C<for>, C<map> or C<grep>).
+Typically, it's the magic involved when an array is evaluated in scalar context, but also on array assignment and loops (C<for>, C<map> or C<grep>).
The callback has then to return the length as an integer.
=item *
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).
-=head1 PERL MAGIC HISTORY
+=head1 FUNCTIONS
-The places where magic is invoked have changed a bit through perl history.
-Here's a little list of the most recent ones.
+=cut
+
+BEGIN {
+ require XSLoader;
+ XSLoader::load(__PACKAGE__, $VERSION);
+}
+
+=head2 C<wizard>
+
+ 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 :
=over 4
=item *
-B<5.6.x>
+C<sig>
-I<p14416> : 'copy' and 'dup' magic.
+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 *
-B<5.8.9>
-
-I<p28160> : Integration of I<p25854> (see below).
+C<data>
-I<p32542> : Integration of I<p31473> (see below).
+A code 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</cast>.
=item *
-B<5.9.3>
+C<get>, C<set>, C<len>, C<clear>, C<free>, C<copy>, C<local>, C<fetch>, C<store>, C<exists> and C<delete>
-I<p25854> : 'len' magic is no longer called when pushing an element into a magic array.
+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<undef> when no private data constructor was supplied).
-I<p26569> : 'local' magic.
+Moreover, when you pass C<< op_info => $num >> to C<wizard>, the last element of C<@_> will be the current op name if C<$num == VMG_OP_INFO_NAME> and a C<B::OP> 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.
-=item *
+Other arguments are specific to the magic hooked :
-B<5.9.5>
+=over 8
-I<p31064> : Meaningful 'uvar' magic.
+=item *
-I<p31473> : 'clear' magic wasn't invoked when undefining an array.
-The bug is fixed as of this version.
+C<len>
+
+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<undef> to default to the normal length.
=item *
-B<5.10.0>
+C<copy>
-Since C<PERL_MAGIC_uvar> is uppercased, C<hv_magic_check()> triggers 'copy' magic on hash stores for (non-tied) hashes that also have 'uvar' magic.
+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 *
-B<5.11.x>
+C<fetch>, C<store>, C<exists> and C<delete>
-I<p32969> : 'len' magic is no longer invoked when calling C<length> with a magical scalar.
+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</wizard>, 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.
-I<p34908> : 'len' magic is no longer called when pushing / unshifting an element into a magical array in void context.
-The C<push> part was already covered by I<p25854>.
+=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<len> callback currently holds a meaning.
=back
+ # 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" }
+
+=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/;
+ 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;
+ }
+ return $ret;
+}
+
+=head2 C<gensig>
+
+With this tool, you can manually generate random magic signature between SIG_MIN and SIG_MAX inclusive.
+That's the way L</wizard> creates them when no signature is supplied.
+
+ # Generate a signature
+ my $sig = gensig;
+
+=head2 C<getsig>
+
+ getsig $wiz
+
+This accessor returns the magic signature of this wizard.
+
+ # Get $wiz signature
+ my $sig = getsig $wiz;
+
+=head2 C<cast>
+
+ cast [$@%&*]var, [$wiz|$sig], ...
+
+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, C<0> on error, and C<undef> when no magic corresponds to the given signature (in case C<$sig> was supplied).
+All extra arguments specified after C<$wiz> are passed to the private data constructor.
+If the variable isn't a hash, any C<uvar> callback of the wizard is safely ignored.
+
+ # Casts $wiz onto $x. If $wiz isn't a signature, undef can't be returned.
+ my $x;
+ die 'error' unless cast $x, $wiz;
+
+The C<var> 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<POSIX::tzset> 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<store> uvar magic.
+
+C<cast> can be called from any magical callback, and in particular from C<data>.
+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<cast>.
+
+=head2 C<getdata>
+
+ getdata [$@%&*]var, [$wiz|$sig]
+
+This accessor fetches the private data associated with the magic C<$wiz> (or the signature C<$sig>) in the variable.
+C<undef> is returned when no such magic or data is found, or when C<$sig> does not represent a current valid magic object.
+
+ # Get the attached data.
+ my $data = getdata $x, $wiz or die 'no such magic or magic has no data';
+
+=head2 C<dispell>
+
+ dispell [$@%&*]variable, [$wiz|$sig]
+
+The exact opposite of L</cast> : it dissociates C<$wiz> magic from the variable.
+You can also pass the magic signature C<$sig> as the second argument.
+True is returned on success, C<0> on error or when no magic represented by C<$wiz> could be found in the variable, and C<undef> when no magic corresponds to the given signature (in case C<$sig> was supplied).
+
+ # Dispell now. If $wiz isn't a signature, undef can't be returned.
+ die 'no such magic or error' unless dispell $x, $wiz;
+
=head1 CONSTANTS
=head2 C<SIG_MIN>
True iff this module could have been built with thread-safety features enabled.
-=head1 FUNCTIONS
+=head2 C<VMG_OP_INFO_NAME>
-=cut
+Value to pass with C<op_info> to get the current op name in the magic callbacks.
-BEGIN {
- require XSLoader;
- XSLoader::load(__PACKAGE__, $VERSION);
-}
+=head2 C<VMG_OP_INFO_OBJECT>
-=head2 C<wizard>
+Value to pass with C<op_info> to get a C<B::OP> object representing the current op in the magic callbacks.
- 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) = @_; ... }
+=head1 PERL MAGIC HISTORY
-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 :
+The places where magic is invoked have changed a bit through perl history.
+Here's a little list of the most recent ones.
=over 4
=item *
-C<sig>
-
-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<data>
+B<5.6.x>
-A code 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</cast>.
+I<p14416> : 'copy' and 'dup' magic.
=item *
-C<get>, C<set>, C<len>, C<clear>, C<free>, C<copy>, C<local>, C<fetch>, C<store>, C<exists> and C<delete>
-
-Code references to 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<undef> when no private data constructor was supplied).
-In the special case of C<len> magic and when the variable is an array, C<$_[2]> contains its normal length.
-C<$_[2]> is the current key in C<copy>, C<fetch>, C<store>, C<exists> and C<delete> callbacks, although for C<copy> it may just be a copy of the actual key so it's useless to (for example) cast magic on it.
-C<copy> magic also receives the current element (i.e. the value) in C<$_[3]>.
-
-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<len> callback currently holds a meaning.
-
-=back
-
- # 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" }
-
-=cut
-
-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) };
- if (my $err = $@) {
- $err =~ s/\sat\s+.*?\n//;
- croak $err;
- }
- return $ret;
-}
-
-=head2 C<gensig>
+B<5.8.9>
-With this tool, you can manually generate random magic signature between SIG_MIN and SIG_MAX inclusive.
-That's the way L</wizard> creates them when no signature is supplied.
+I<p28160> : Integration of I<p25854> (see below).
- # Generate a signature
- my $sig = gensig;
+I<p32542> : Integration of I<p31473> (see below).
-=head2 C<getsig>
+=item *
- getsig $wiz
+B<5.9.3>
-This accessor returns the magic signature of this wizard.
+I<p25854> : 'len' magic is no longer called when pushing an element into a magic array.
- # Get $wiz signature
- my $sig = getsig $wiz;
+I<p26569> : 'local' magic.
-=head2 C<cast>
+=item *
- cast [$@%&*]var, [$wiz|$sig], ...
+B<5.9.5>
-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, C<0> on error, and C<undef> when no magic corresponds to the given signature (in case C<$sig> was supplied).
-All extra arguments specified after C<$wiz> are passed to the private data constructor.
-If the variable isn't a hash, any C<uvar> callback of the wizard is safely ignored.
+I<p31064> : Meaningful 'uvar' magic.
- # Casts $wiz onto $x. If $wiz isn't a signature, undef can't be returned.
- my $x;
- die 'error' unless cast $x, $wiz;
+I<p31473> : 'clear' magic wasn't invoked when undefining an array.
+The bug is fixed as of this version.
-=head2 C<getdata>
+=item *
- getdata [$@%&*]var, [$wiz|$sig]
+B<5.10.0>
-This accessor fetches the private data associated with the magic C<$wiz> (or the signature C<$sig>) in the variable.
-C<undef> is returned when no such magic or data is found, or when C<$sig> does not represent a current valid magic object.
+Since C<PERL_MAGIC_uvar> is uppercased, C<hv_magic_check()> triggers 'copy' magic on hash stores for (non-tied) hashes that also have 'uvar' magic.
- # Get the attached data.
- my $data = getdata $x, $wiz or die 'no such magic or magic has no data';
+=item *
-=head2 C<dispell>
+B<5.11.x>
- dispell [$@%&*]variable, [$wiz|$sig]
+I<p32969> : 'len' magic is no longer invoked when calling C<length> with a magical scalar.
-The exact opposite of L</cast> : it dissociates C<$wiz> magic from the variable.
-You can also pass the magic signature C<$sig> as the second argument.
-True is returned on success, C<0> on error or when no magic represented by C<$wiz> could be found in the variable, and C<undef> when no magic corresponds to the given signature (in case C<$sig> was supplied).
+I<p34908> : 'len' magic is no longer called when pushing / unshifting an element into a magical array in void context.
+The C<push> part was already covered by I<p25854>.
- # Dispell now. If $wiz isn't a signature, undef can't be returned.
- die 'no such magic or error' unless dispell $x, $wiz;
+=back
=head1 EXPORT
The functions L</wizard>, L</gensig>, L</getsig>, L</cast>, L</getdata> and L</dispell> are only exported on request.
All of them are exported by the tags C<':funcs'> and C<':all'>.
-The constants L</SIG_MIN>, L</SIG_MAX>, L</SIG_NBR>, L</MGf_COPY>, L</MGf_DUP>, L</MGf_LOCAL> and L</VMG_UVAR> are also only exported on request.
-They are all exported by the tags C<':consts'> and C<':all'>.
+All the constants are also only exported on request, either individually or by the tags C<':consts'> and C<':all'>.
=cut
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 ];
=head1 CAVEATS
-If you store a magic object in the private data slot, the magic won't be accessible by L</getdata> since it's not copied by assignation.
+If you store a magic object in the private data slot, the magic won't be accessible by L</getdata> since it's not copied by assignment.
The only way to address this would be to return a reference.
If you define a wizard with a C<free> callback and cast it on itself, this destructor won't be called because the wizard will be destroyed first.
-Using C<get> and C<clear> magics on hashes may cause segfaults.
-
=head1 DEPENDENCIES
-L<perl> 5.7.3.
+L<perl> 5.8.
L<Carp> (standard since perl 5), L<XSLoader> (standard since perl 5.006).