=head1 VERSION
-Version 0.45
+Version 0.48
=cut
our $VERSION;
BEGIN {
- $VERSION = '0.45';
+ $VERSION = '0.48';
}
=head1 SYNOPSIS
- use Variable::Magic qw/wizard cast VMG_OP_INFO_NAME/;
+ use Variable::Magic qw<wizard cast VMG_OP_INFO_NAME>;
{ # 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;
} # "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"
}
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
=head2 C<wizard>
- 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 :
=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<undef>, 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<free> callbacks are I<never> called during global destruction, as there's no way to ensure that the wizard and the C<free> 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
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<op_info data get set len clear free copy dup>;
push @keys, 'local' if MGf_LOCAL;
- push @keys, qw/fetch store exists delete copy_key/ if VMG_UVAR;
+ push @keys, qw<fetch store exists delete copy_key> if VMG_UVAR;
my ($wiz, $err);
{
Initial VMG_UVAR capability was introduced in perl 5.9.5, with a fully functional implementation
shipped with perl 5.10.0.
+=head2 C<VMG_COMPAT_SCALAR_LENGTH_NOLEN>
+
+True for perls that don't call 'len' magic when taking the C<length> of a magical scalar.
+
=head2 C<VMG_COMPAT_ARRAY_PUSH_NOLEN>
True for perls that don't call 'len' magic when you push an element in a magical array.
True for perls that call 'clear' magic when undefining magical arrays.
-=head2 C<VMG_COMPAT_SCALAR_LENGTH_NOLEN>
+=head2 C<VMG_COMPAT_HASH_DELETE_NOUVAR_VOID>
-True for perls that don't call 'len' magic when taking the C<length> 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<VMG_COMPAT_GLOB_GET>
{
package Magical::UserData;
- use Variable::Magic qw/wizard cast getdata/;
+ use Variable::Magic qw<wizard cast getdata>;
my $wiz = wizard data => sub { \$_[1] };
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;
}
=cut
-use base qw/Exporter/;
+use base qw<Exporter>;
our @EXPORT = ();
our %EXPORT_TAGS = (
- 'funcs' => [ qw/wizard cast getdata dispell/ ],
- 'consts' => [ qw/
+ 'funcs' => [ qw<wizard cast getdata dispell> ],
+ '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 ];
=head1 COPYRIGHT & LICENSE
-Copyright 2007,2008,2009,2010 Vincent Pit, all rights reserved.
+Copyright 2007,2008,2009,2010,2011,2012 Vincent Pit, all rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.