=head1 VERSION
-Version 0.37
+Version 0.40
=cut
our $VERSION;
BEGIN {
- $VERSION = '0.37';
+ $VERSION = '0.40';
}
=head1 SYNOPSIS
=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.
-
-This option is B<deprecated> and will be removed in december 2009.
-
-=item *
-
C<data>
-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</cast>.
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 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<undef> when no private data constructor was supplied).
=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<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" }
-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.
-
=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;
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;
-
-This function is B<deprecated> and will be removed in december 2009.
-
-=head2 C<getsig>
-
- getsig $wiz
-
-This accessor returns the magic signature of this wizard.
-
- # Get $wiz signature
- my $sig = getsig $wiz;
-
-This function is B<deprecated> and will be removed in december 2009.
-
=head2 C<cast>
cast [$@%&*]var, $wiz, ...
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
=head1 CONSTANTS
-=head2 C<SIG_MIN>
-
-The minimum integer used as a signature for user-defined magic.
-
-This constant is B<deprecated> and will be removed in december 2009.
-
-=head2 C<SIG_MAX>
-
-The maximum integer used as a signature for user-defined magic.
-
-This constant is B<deprecated> and will be removed in december 2009.
-
-=head2 C<SIG_NBR>
-
- SIG_NBR = SIG_MAX - SIG_MIN + 1
-
-This constant is B<deprecated> and will be removed in december 2009.
-
=head2 C<MGf_COPY>
Evaluates to true iff the 'copy' magic is available.
Value to pass with C<op_info> to get a C<B::OP> 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<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>.
+
=head1 PERL MAGIC HISTORY
The places where magic is invoked have changed a bit through perl history.
=head1 EXPORT
-The functions L</wizard>, L</gensig>, L</getsig>, L</cast>, L</getdata> and L</dispell> are only exported on request.
+The functions L</wizard>, 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'>.
All the constants are also only exported on request, either individually or by the tags C<':consts'> and C<':all'>.
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/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/,
=head1 COPYRIGHT & LICENSE
-Copyright 2007-2009 Vincent Pit, all rights reserved.
+Copyright 2007,2008,2009,2010 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.