r45376 - in /branches/upstream/libvariable-magic-perl/current: Changes META.yml Magic.xs Makefile.PL README lib/Variable/Magic.pm t/01-import.t t/31-array.t t/99-kwalitee.t
angelabad-guest at users.alioth.debian.org
angelabad-guest at users.alioth.debian.org
Mon Oct 5 11:38:32 UTC 2009
Author: angelabad-guest
Date: Mon Oct 5 11:38:26 2009
New Revision: 45376
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=45376
Log:
[svn-upgrade] Integrating new upstream version, libvariable-magic-perl (0.38)
Modified:
branches/upstream/libvariable-magic-perl/current/Changes
branches/upstream/libvariable-magic-perl/current/META.yml
branches/upstream/libvariable-magic-perl/current/Magic.xs
branches/upstream/libvariable-magic-perl/current/Makefile.PL
branches/upstream/libvariable-magic-perl/current/README
branches/upstream/libvariable-magic-perl/current/lib/Variable/Magic.pm
branches/upstream/libvariable-magic-perl/current/t/01-import.t
branches/upstream/libvariable-magic-perl/current/t/31-array.t
branches/upstream/libvariable-magic-perl/current/t/99-kwalitee.t
Modified: branches/upstream/libvariable-magic-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libvariable-magic-perl/current/Changes?rev=45376&op=diff
==============================================================================
--- branches/upstream/libvariable-magic-perl/current/Changes (original)
+++ branches/upstream/libvariable-magic-perl/current/Changes Mon Oct 5 11:38:26 2009
@@ -1,4 +1,19 @@
Revision history for Variable-Magic
+
+0.38 2009-10-04 16:10 UTC
+ + Dep : All the signature-related features are DEPRECATED and will be
+ removed in december 2009. This includes the 'sig' option to
+ wizard(), the getsig() and gensig() functions, and the SIG_*
+ constants.
+ Afaik those features were never used in real life, and they make
+ the XS code slow and brittle. If you want your wizards to be
+ globally available, you'll have to handle that yourself by
+ storing them in a hash.
+ + Doc : More examples in a new COOKBOOK section.
+ + Fix : Compatiblity with the 5.11.0 release. The new compatibility
+ constant VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID was added to cover
+ this.
+ + Fix : Work around Kwalitee test misfailures.
0.37 2009-08-25 15:25 UTC
+ Add : The new constant VMG_FORKSAFE can be tested to know whether the
Modified: branches/upstream/libvariable-magic-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libvariable-magic-perl/current/META.yml?rev=45376&op=diff
==============================================================================
--- branches/upstream/libvariable-magic-perl/current/META.yml (original)
+++ branches/upstream/libvariable-magic-perl/current/META.yml Mon Oct 5 11:38:26 2009
@@ -1,6 +1,6 @@
--- #YAML:1.0
name: Variable-Magic
-version: 0.37
+version: 0.38
abstract: Associate user-defined magic to variables from Perl.
author:
- Vincent Pit <perl at profvince.com>
@@ -10,10 +10,13 @@
Config: 0
ExtUtils::MakeMaker: 0
build_requires:
+ base: 0
Carp: 0
Config: 0
+ Exporter: 0
ExtUtils::MakeMaker: 0
Test::More: 0
+ XSLoader: 0
requires:
base: 0
Carp: 0
@@ -29,7 +32,8 @@
directory:
- t
- inc
-generated_by: ExtUtils::MakeMaker version 6.54
+generated_by: ExtUtils::MakeMaker version 6.55_02
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
version: 1.4
+dynamic_config: 1
Modified: branches/upstream/libvariable-magic-perl/current/Magic.xs
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libvariable-magic-perl/current/Magic.xs?rev=45376&op=diff
==============================================================================
--- branches/upstream/libvariable-magic-perl/current/Magic.xs (original)
+++ branches/upstream/libvariable-magic-perl/current/Magic.xs Mon Oct 5 11:38:26 2009
@@ -148,12 +148,21 @@
# define VMG_UVAR 0
#endif
-/* Applied to dev-5.9 as 25854, integrated to maint-5.8 as 28160 */
-#ifndef VMG_COMPAT_ARRAY_PUSH_NOLEN
-# if VMG_HAS_PERL_MAINT(5, 8, 9, 28160) || VMG_HAS_PERL_MAINT(5, 9, 3, 25854) || VMG_HAS_PERL(5, 10, 0)
+/* Applied to dev-5.9 as 25854, integrated to maint-5.8 as 28160, partially
+ * reverted to dev-5.11 as 9cdcb38b */
+#if VMG_HAS_PERL_MAINT(5, 8, 9, 28160) || VMG_HAS_PERL_MAINT(5, 9, 3, 25854) || VMG_HAS_PERL(5, 10, 0)
+# ifndef VMG_COMPAT_ARRAY_PUSH_NOLEN
# define VMG_COMPAT_ARRAY_PUSH_NOLEN 1
-# else
+# endif
+# ifndef VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID
+# define VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID 1
+# endif
+#else
+# ifndef VMG_COMPAT_ARRAY_PUSH_NOLEN
# define VMG_COMPAT_ARRAY_PUSH_NOLEN 0
+# endif
+# ifndef VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID
+# define VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID 0
# endif
#endif
@@ -1260,6 +1269,8 @@
newCONSTSUB(stash, "VMG_UVAR", newSVuv(VMG_UVAR));
newCONSTSUB(stash, "VMG_COMPAT_ARRAY_PUSH_NOLEN",
newSVuv(VMG_COMPAT_ARRAY_PUSH_NOLEN));
+ newCONSTSUB(stash, "VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID",
+ newSVuv(VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID));
newCONSTSUB(stash, "VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID",
newSVuv(VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID));
newCONSTSUB(stash, "VMG_COMPAT_ARRAY_UNDEF_CLEAR",
Modified: branches/upstream/libvariable-magic-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libvariable-magic-perl/current/Makefile.PL?rev=45376&op=diff
==============================================================================
--- branches/upstream/libvariable-magic-perl/current/Makefile.PL (original)
+++ branches/upstream/libvariable-magic-perl/current/Makefile.PL Mon Oct 5 11:38:26 2009
@@ -19,6 +19,7 @@
push @DEFINES, '-DVMG_PERL_PATCHLEVEL=' . $pl;
print $pl, "\n";
} else {
+ $pl = undef;
print "none\n";
}
@@ -40,6 +41,17 @@
}
print $is_as ? "yes\n" : "no\n";
+my $is_5110rel = 0;
+print "Checking if this is a released perl 5.11.0... ";
+if ($^V eq v5.11.0 and not defined $pl) {
+ my $describe = $Config{git_describe};
+ if (defined $describe and $describe !~ /^GitLive-/) {
+ $is_5110rel = 1;
+ push @DEFINES, '-DVMG_COMPAT_ARRAY_PUSH_NOLEN=0';
+ }
+}
+print $is_5110rel ? "yes\n" : "no\n";
+
# Threads, Windows and 5.8.x don't seem to be best friends
if ($^O eq 'MSWin32' && $^V lt v5.9.0) {
push @DEFINES, '-DVMG_MULTIPLICITY=0';
@@ -54,6 +66,18 @@
my $dist = 'Variable-Magic';
+(my $name = $dist) =~ s{-}{::}g;
+
+(my $file = $dist) =~ s{-}{/}g;
+$file = "lib/$file.pm";
+
+my %PREREQ_PM = (
+ 'Carp' => 0,
+ 'Exporter' => 0,
+ 'XSLoader' => 0,
+ 'base' => 0,
+);
+
my %META = (
configure_requires => {
'Config' => 0,
@@ -64,7 +88,9 @@
'Config' => 0,
'ExtUtils::MakeMaker' => 0,
'Test::More' => 0,
+ %PREREQ_PM,
},
+ dynamic_config => 1,
resources => {
bugtracker => "http://rt.cpan.org/NoAuth/ReportBug.html?Queue=$dist",
homepage => "http://search.cpan.org/dist/$dist/",
@@ -74,26 +100,21 @@
);
WriteMakefile(
- NAME => 'Variable::Magic',
- AUTHOR => 'Vincent Pit <perl at profvince.com>',
- LICENSE => 'perl',
- VERSION_FROM => 'lib/Variable/Magic.pm',
- ABSTRACT_FROM => 'lib/Variable/Magic.pm',
- PL_FILES => {},
- @DEFINES,
- PREREQ_PM => {
- 'Carp' => 0,
- 'Exporter' => 0,
- 'XSLoader' => 0,
- 'base' => 0,
- },
- MIN_PERL_VERSION => 5.008,
- META_MERGE => \%META,
- dist => {
- PREOP => 'pod2text lib/Variable/Magic.pm > $(DISTVNAME)/README',
- COMPRESS => 'gzip -9f', SUFFIX => 'gz'
- },
- clean => {
- FILES => "$dist-* *.gcov *.gcda *.gcno cover_db Debian_CPANTS.txt"
- },
+ NAME => $name,
+ AUTHOR => 'Vincent Pit <perl at profvince.com>',
+ LICENSE => 'perl',
+ VERSION_FROM => $file,
+ ABSTRACT_FROM => $file,
+ PL_FILES => {},
+ @DEFINES,
+ PREREQ_PM => \%PREREQ_PM,
+ MIN_PERL_VERSION => 5.008,
+ META_MERGE => \%META,
+ dist => {
+ PREOP => "pod2text $file > \$(DISTVNAME)/README",
+ COMPRESS => 'gzip -9f', SUFFIX => 'gz'
+ },
+ clean => {
+ FILES => "$dist-* *.gcov *.gcda *.gcno cover_db Debian_CPANTS.txt"
+ },
);
Modified: branches/upstream/libvariable-magic-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libvariable-magic-perl/current/README?rev=45376&op=diff
==============================================================================
--- branches/upstream/libvariable-magic-perl/current/README (original)
+++ branches/upstream/libvariable-magic-perl/current/README Mon Oct 5 11:38:26 2009
@@ -2,7 +2,7 @@
Variable::Magic - Associate user-defined magic to variables from Perl.
VERSION
- Version 0.37
+ Version 0.38
SYNOPSIS
use Variable::Magic qw/wizard cast VMG_OP_INFO_NAME/;
@@ -159,8 +159,7 @@
FUNCTIONS
"wizard"
- wizard sig => ...,
- data => sub { ... },
+ wizard data => sub { ... },
get => sub { my ($ref, $data [, $op]) = @_; ... },
set => sub { my ($ref, $data [, $op]) = @_; ... },
len => sub { my ($ref, $data, $len [, $op]) = @_; ... ; return $newlen; },
@@ -185,6 +184,8 @@
signature is generated. If the signature matches an already defined
magic, then the existant magic object is returned.
+ This option is deprecated and will be removed in december 2009.
+
* "data"
A code reference to a private data constructor. It is called each
@@ -256,6 +257,8 @@
# Generate a signature
my $sig = gensig;
+ This function is deprecated and will be removed in december 2009.
+
"getsig"
getsig $wiz
@@ -264,17 +267,17 @@
# Get $wiz signature
my $sig = getsig $wiz;
+ This function is deprecated and will be removed in december 2009.
+
"cast"
- cast [$@%&*]var, [$wiz|$sig], ...
+ cast [$@%&*]var, $wiz, ...
This function associates $wiz magic to the variable supplied, without
- overwriting any other kind of magic. You can also supply the numeric
- signature $sig instead of $wiz. It returns true on success or when $wiz
- magic is already present, and croaks on error or when no magic
- corresponds to the given signature (in case a $sig was supplied). All
- extra arguments specified after $wiz are passed to the private data
- constructor in @_[1 .. @_-1]. If the variable isn't a hash, any "uvar"
- callback of the wizard is safely ignored.
+ overwriting any other kind of magic. It returns true on success or when
+ $wiz magic is already present, and croaks on error. All extra arguments
+ specified after $wiz are passed to the private data constructor in @_[1
+ .. @_-1]. If the variable isn't a hash, any "uvar" callback of the
+ wizard is safely ignored.
# Casts $wiz onto $x, and pass '1' to the data constructor.
my $x;
@@ -292,28 +295,153 @@
If you want to overcome the possible deletion of the 'TZ' entry, you
have no choice but to rely on "store" uvar magic.
+ "getdata"
+ getdata [$@%&*]var, $wiz
+
+ This accessor fetches the private data associated with the magic $wiz in
+ the variable. It croaks when $wiz do not represent a valid magic object,
+ and returns an empty list if no such magic is attached to the variable
+ or when the wizard has no data constructor.
+
+ # Get the attached data, or undef if the wizard does not attach any.
+ my $data = getdata $x, $wiz;
+
+ "dispell"
+ dispell [$@%&*]variable, $wiz
+
+ The exact opposite of "cast" : it dissociates $wiz magic from the
+ variable. This function returns true on success, 0 when no magic
+ represented by $wiz could be found in the variable, and croaks if the
+ supplied wizard is invalid.
+
+ # Dispell now.
+ die 'no such magic in $x' unless dispell $x, $wiz;
+
+CONSTANTS
+ "SIG_MIN"
+ The minimum integer used as a signature for user-defined magic.
+
+ This constant is deprecated and will be removed in december 2009.
+
+ "SIG_MAX"
+ The maximum integer used as a signature for user-defined magic.
+
+ This constant is deprecated and will be removed in december 2009.
+
+ "SIG_NBR"
+ SIG_NBR = SIG_MAX - SIG_MIN + 1
+
+ This constant is deprecated and will be removed in december 2009.
+
+ "MGf_COPY"
+ Evaluates to true iff the 'copy' magic is available.
+
+ "MGf_DUP"
+ Evaluates to true iff the 'dup' magic is available.
+
+ "MGf_LOCAL"
+ Evaluates to true iff the 'local' magic is available.
+
+ "VMG_UVAR"
+ When this constant is true, you can use the "fetch,store,exists,delete"
+ callbacks on hashes.
+
+ "VMG_COMPAT_ARRAY_PUSH_NOLEN"
+ True for perls that don't call 'len' magic when you push an element in a
+ magical array. Starting from perl 5.11.0, this only refers to pushes in
+ non-void context and hence is false.
+
+ "VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID"
+ True for perls that don't call 'len' magic when you push in void context
+ an element in a magical array.
+
+ "VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID"
+ True for perls that don't call 'len' magic when you unshift in void
+ context an element in a magical array.
+
+ "VMG_COMPAT_ARRAY_UNDEF_CLEAR"
+ True for perls that call 'clear' magic when undefining magical arrays.
+
+ "VMG_COMPAT_SCALAR_LENGTH_NOLEN"
+ True for perls that don't call 'len' magic when taking the "length" of a
+ magical scalar.
+
+ "VMG_PERL_PATCHLEVEL"
+ The perl patchlevel this module was built with, or 0 for non-debugging
+ perls.
+
+ "VMG_THREADSAFE"
+ True iff this module could have been built with thread-safety features
+ enabled.
+
+ "VMG_FORKSAFE"
+ True iff this module could have been built with fork-safety features
+ enabled. This will always be true except on Windows where it's false for
+ perl 5.10.0 and below .
+
+ "VMG_OP_INFO_NAME"
+ Value to pass with "op_info" to get the current op name in the magic
+ callbacks.
+
+ "VMG_OP_INFO_OBJECT"
+ Value to pass with "op_info" to get a "B::OP" object representing the
+ current op in the magic callbacks.
+
+COOKBOOK
+ 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!
+ }
+
+ Recursively cast magic on datastructures
"cast" can be called from any magical callback, and in particular from
"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";
- ();
- };
+ $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 = (
@@ -336,89 +464,6 @@
Of course, this example does nothing with the values that are added
after the "cast".
- "getdata"
- getdata [$@%&*]var, [$wiz|$sig]
-
- This accessor fetches the private data associated with the magic $wiz
- (or the signature $sig) in the variable. It croaks when $wiz or $sig do
- not represent a valid magic object, and returns an empty list if no such
- magic is attached to the variable or when the wizard has no data
- constructor.
-
- # Get the attached data, or undef if the wizard does not attach any.
- my $data = getdata $x, $wiz;
-
- "dispell"
- dispell [$@%&*]variable, [$wiz|$sig]
-
- The exact opposite of "cast" : it dissociates $wiz magic from the
- variable. You can also pass the magic signature $sig as the second
- argument. This function returns true on success, 0 when no magic
- represented by $wiz or $sig could be found in the variable, and croaks
- if the supplied wizard or signature is invalid.
-
- # Dispell now.
- die 'no such magic in $x' unless dispell $x, $wiz;
-
-CONSTANTS
- "SIG_MIN"
- The minimum integer used as a signature for user-defined magic.
-
- "SIG_MAX"
- The maximum integer used as a signature for user-defined magic.
-
- "SIG_NBR"
- SIG_NBR = SIG_MAX - SIG_MIN + 1
-
- "MGf_COPY"
- Evaluates to true iff the 'copy' magic is available.
-
- "MGf_DUP"
- Evaluates to true iff the 'dup' magic is available.
-
- "MGf_LOCAL"
- Evaluates to true iff the 'local' magic is available.
-
- "VMG_UVAR"
- When this constant is true, you can use the "fetch,store,exists,delete"
- callbacks on hashes.
-
- "VMG_COMPAT_ARRAY_PUSH_NOLEN"
- True for perls that don't call 'len' magic when you push an element in a
- magical array.
-
- "VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID"
- True for perls that don't call 'len' magic when you unshift in void
- context an element in a magical array.
-
- "VMG_COMPAT_ARRAY_UNDEF_CLEAR"
- True for perls that call 'clear' magic when undefining magical arrays.
-
- "VMG_COMPAT_SCALAR_LENGTH_NOLEN"
- True for perls that don't call 'len' magic when taking the "length" of a
- magical scalar.
-
- "VMG_PERL_PATCHLEVEL"
- The perl patchlevel this module was built with, or 0 for non-debugging
- perls.
-
- "VMG_THREADSAFE"
- True iff this module could have been built with thread-safety features
- enabled.
-
- "VMG_FORKSAFE"
- True iff this module could have been built with fork-safety features
- enabled. This will always be true except on Windows where it's false for
- perl 5.10.0 and below .
-
- "VMG_OP_INFO_NAME"
- Value to pass with "op_info" to get the current op name in the magic
- callbacks.
-
- "VMG_OP_INFO_OBJECT"
- Value to pass with "op_info" to get a "B::OP" object representing the
- current op in the magic callbacks.
-
PERL MAGIC HISTORY
The places where magic is invoked have changed a bit through perl
history. Here's a little list of the most recent ones.
@@ -461,6 +506,9 @@
*p34908* : 'len' magic is no longer called when pushing / unshifting
an element into a magical array in void context. The "push" part was
already covered by *p25854*.
+
+ *g9cdcb38b* : 'len' magic is called again when pushing into a
+ magical array in non-void context.
EXPORT
The functions "wizard", "gensig", "getsig", "cast", "getdata" and
Modified: branches/upstream/libvariable-magic-perl/current/lib/Variable/Magic.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libvariable-magic-perl/current/lib/Variable/Magic.pm?rev=45376&op=diff
==============================================================================
--- branches/upstream/libvariable-magic-perl/current/lib/Variable/Magic.pm (original)
+++ branches/upstream/libvariable-magic-perl/current/lib/Variable/Magic.pm Mon Oct 5 11:38:26 2009
@@ -13,13 +13,13 @@
=head1 VERSION
-Version 0.37
+Version 0.38
=cut
our $VERSION;
BEGIN {
- $VERSION = '0.37';
+ $VERSION = '0.38';
}
=head1 SYNOPSIS
@@ -208,8 +208,7 @@
=head2 C<wizard>
- wizard sig => ...,
- data => sub { ... },
+ wizard data => sub { ... },
get => sub { my ($ref, $data [, $op]) = @_; ... },
set => sub { my ($ref, $data [, $op]) = @_; ... },
len => sub { my ($ref, $data, $len [, $op]) = @_; ... ; return $newlen; },
@@ -236,6 +235,8 @@
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 *
@@ -324,6 +325,8 @@
# Generate a signature
my $sig = gensig;
+This function is B<deprecated> and will be removed in december 2009.
+
=head2 C<getsig>
getsig $wiz
@@ -333,13 +336,14 @@
# 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|$sig], ...
+ cast [$@%&*]var, $wiz, ...
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, and croaks on error or when no magic corresponds to the given signature (in case a C<$sig> was supplied).
+It returns true on success or when C<$wiz> magic is already present, and croaks on error.
All extra arguments specified after C<$wiz> are passed to the private data constructor in C<@_[1 .. @_-1]>.
If the variable isn't a hash, any C<uvar> callback of the wizard is safely ignored.
@@ -356,28 +360,162 @@
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.
+=head2 C<getdata>
+
+ getdata [$@%&*]var, $wiz
+
+This accessor fetches the private data associated with the magic C<$wiz> in the variable.
+It croaks when C<$wiz> do not represent a valid magic object, and returns an empty list if no such magic is attached to the variable or when the wizard has no data constructor.
+
+ # Get the attached data, or undef if the wizard does not attach any.
+ my $data = getdata $x, $wiz;
+
+=head2 C<dispell>
+
+ dispell [$@%&*]variable, $wiz
+
+The exact opposite of L</cast> : it dissociates C<$wiz> magic from the variable.
+This function returns true on success, C<0> when no magic represented by C<$wiz> could be found in the variable, and croaks if the supplied wizard is invalid.
+
+ # Dispell now.
+ die 'no such magic in $x' unless dispell $x, $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.
+
+=head2 C<MGf_DUP>
+
+Evaluates to true iff the 'dup' magic is available.
+
+=head2 C<MGf_LOCAL>
+
+Evaluates to true iff the 'local' magic is available.
+
+=head2 C<VMG_UVAR>
+
+When this constant is true, you can use the C<fetch,store,exists,delete> callbacks on hashes.
+
+=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.
+Starting from perl 5.11.0, this only refers to pushes in non-void context and hence is false.
+
+=head2 C<VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID>
+
+True for perls that don't call 'len' magic when you push in void context an element in a magical array.
+
+=head2 C<VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID>
+
+True for perls that don't call 'len' magic when you unshift in void context an element in a magical array.
+
+=head2 C<VMG_COMPAT_ARRAY_UNDEF_CLEAR>
+
+True for perls that call 'clear' magic when undefining magical arrays.
+
+=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_PERL_PATCHLEVEL>
+
+The perl patchlevel this module was built with, or C<0> for non-debugging perls.
+
+=head2 C<VMG_THREADSAFE>
+
+True iff this module could have been built with thread-safety features enabled.
+
+=head2 C<VMG_FORKSAFE>
+
+True iff this module could have been built with fork-safety features enabled.
+This will always be true except on Windows where it's false for perl 5.10.0 and below .
+
+=head2 C<VMG_OP_INFO_NAME>
+
+Value to pass with C<op_info> to get the current op name in the magic callbacks.
+
+=head2 C<VMG_OP_INFO_OBJECT>
+
+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";
- ();
- };
+ $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 = (
@@ -398,94 +536,6 @@
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.
-It croaks when C<$wiz> or C<$sig> do not represent a valid magic object, and returns an empty list if no such magic is attached to the variable or when the wizard has no data constructor.
-
- # Get the attached data, or undef if the wizard does not attach any.
- my $data = getdata $x, $wiz;
-
-=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.
-This function returns true on success, C<0> when no magic represented by C<$wiz> or C<$sig> could be found in the variable, and croaks if the supplied wizard or signature is invalid.
-
- # Dispell now.
- die 'no such magic in $x' unless dispell $x, $wiz;
-
-=head1 CONSTANTS
-
-=head2 C<SIG_MIN>
-
-The minimum integer used as a signature for user-defined magic.
-
-=head2 C<SIG_MAX>
-
-The maximum integer used as a signature for user-defined magic.
-
-=head2 C<SIG_NBR>
-
- SIG_NBR = SIG_MAX - SIG_MIN + 1
-
-=head2 C<MGf_COPY>
-
-Evaluates to true iff the 'copy' magic is available.
-
-=head2 C<MGf_DUP>
-
-Evaluates to true iff the 'dup' magic is available.
-
-=head2 C<MGf_LOCAL>
-
-Evaluates to true iff the 'local' magic is available.
-
-=head2 C<VMG_UVAR>
-
-When this constant is true, you can use the C<fetch,store,exists,delete> callbacks on hashes.
-
-=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.
-
-=head2 C<VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID>
-
-True for perls that don't call 'len' magic when you unshift in void context an element in a magical array.
-
-=head2 C<VMG_COMPAT_ARRAY_UNDEF_CLEAR>
-
-True for perls that call 'clear' magic when undefining magical arrays.
-
-=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_PERL_PATCHLEVEL>
-
-The perl patchlevel this module was built with, or C<0> for non-debugging perls.
-
-=head2 C<VMG_THREADSAFE>
-
-True iff this module could have been built with thread-safety features enabled.
-
-=head2 C<VMG_FORKSAFE>
-
-True iff this module could have been built with fork-safety features enabled.
-This will always be true except on Windows where it's false for perl 5.10.0 and below .
-
-=head2 C<VMG_OP_INFO_NAME>
-
-Value to pass with C<op_info> to get the current op name in the magic callbacks.
-
-=head2 C<VMG_OP_INFO_OBJECT>
-
-Value to pass with C<op_info> to get a C<B::OP> object representing the current op in the magic callbacks.
-
=head1 PERL MAGIC HISTORY
The places where magic is invoked have changed a bit through perl history.
@@ -538,6 +588,8 @@
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>.
+
+I<g9cdcb38b> : 'len' magic is called again when pushing into a magical array in non-void context.
=back
@@ -557,7 +609,10 @@
'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 VMG_COMPAT_SCALAR_LENGTH_NOLEN/,
+ 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/,
+ qw/VMG_COMPAT_SCALAR_LENGTH_NOLEN/,
qw/VMG_PERL_PATCHLEVEL/,
qw/VMG_THREADSAFE VMG_FORKSAFE/,
qw/VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT/
Modified: branches/upstream/libvariable-magic-perl/current/t/01-import.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libvariable-magic-perl/current/t/01-import.t?rev=45376&op=diff
==============================================================================
--- branches/upstream/libvariable-magic-perl/current/t/01-import.t (original)
+++ branches/upstream/libvariable-magic-perl/current/t/01-import.t Mon Oct 5 11:38:26 2009
@@ -3,18 +3,32 @@
use strict;
use warnings;
-use Test::More tests => 22;
+use Test::More tests => 2 * 23;
require Variable::Magic;
-for (qw/wizard gensig getsig cast getdata dispell
- SIG_MIN SIG_MAX SIG_NBR
- MGf_COPY MGf_DUP MGf_LOCAL VMG_UVAR
- VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID
- VMG_COMPAT_ARRAY_UNDEF_CLEAR VMG_COMPAT_SCALAR_LENGTH_NOLEN
- VMG_PERL_PATCHLEVEL
- VMG_THREADSAFE VMG_FORKSAFE
- VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT/) {
+my %syms = (
+ wizard => undef,
+ gensig => '',
+ getsig => '$',
+ cast => '\[$@%&*]$@',
+ getdata => '\[$@%&*]$',
+ dispell => '\[$@%&*]$',
+ map { $_ => '' } qw/
+ SIG_MIN SIG_MAX SIG_NBR
+ MGf_COPY MGf_DUP MGf_LOCAL VMG_UVAR
+ 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_PERL_PATCHLEVEL
+ VMG_THREADSAFE VMG_FORKSAFE
+ VMG_OP_INFO_NAME VMG_OP_INFO_OBJECT
+ /
+);
+
+for (sort keys %syms) {
eval { Variable::Magic->import($_) };
- is($@, '', 'import ' . $_);
+ is $@, '', "import $_";
+ is prototype($_), $syms{$_}, "prototype $_";
}
Modified: branches/upstream/libvariable-magic-perl/current/t/31-array.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libvariable-magic-perl/current/t/31-array.t?rev=45376&op=diff
==============================================================================
--- branches/upstream/libvariable-magic-perl/current/t/31-array.t (original)
+++ branches/upstream/libvariable-magic-perl/current/t/31-array.t Mon Oct 5 11:38:26 2009
@@ -5,7 +5,7 @@
use Test::More tests => 2 * 27 + 13 + 1;
-use Variable::Magic qw/cast dispell VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID VMG_COMPAT_ARRAY_UNDEF_CLEAR/;
+use Variable::Magic qw/cast dispell VMG_COMPAT_ARRAY_PUSH_NOLEN VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID VMG_COMPAT_ARRAY_UNSHIFT_NOLEN_VOID VMG_COMPAT_ARRAY_UNDEF_CLEAR/;
use lib 't/lib';
use Variable::Magic::TestWatcher;
@@ -53,10 +53,12 @@
is $b, 2, 'array: length $# correctly';
watch { push @a, 'x'; () }
- { set => 1, (len => 1) x !VMG_COMPAT_ARRAY_PUSH_NOLEN },'push (void)';
+ { set => 1, (len => 1) x !VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID },
+ 'push (void)';
$b = watch { push @a, 'y' }
- { set => 1, (len => 1) x !VMG_COMPAT_ARRAY_PUSH_NOLEN }, 'push (scalar)';
+ { set => 1, (len => 1) x !VMG_COMPAT_ARRAY_PUSH_NOLEN },
+ 'push (scalar)';
is $b, 5, 'array: push (scalar) correctly';
$b = watch { pop @a } { set => 1, len => 1 }, 'pop';
Modified: branches/upstream/libvariable-magic-perl/current/t/99-kwalitee.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libvariable-magic-perl/current/t/99-kwalitee.t?rev=45376&op=diff
==============================================================================
--- branches/upstream/libvariable-magic-perl/current/t/99-kwalitee.t (original)
+++ branches/upstream/libvariable-magic-perl/current/t/99-kwalitee.t Mon Oct 5 11:38:26 2009
@@ -5,5 +5,17 @@
use Test::More;
-eval { require Test::Kwalitee; Test::Kwalitee->import() };
-plan( skip_all => 'Test::Kwalitee not installed; skipping' ) if $@;
+eval { require Test::Kwalitee; };
+plan(skip_all => 'Test::Kwalitee not installed') if $@;
+
+SKIP: {
+ eval { Test::Kwalitee->import(); };
+ if (my $err = $@) {
+ 1 while chomp $err;
+ require Test::Builder;
+ my $Test = Test::Builder->new;
+ my $plan = $Test->has_plan;
+ $Test->skip_all($err) if not defined $plan or $plan eq 'no_plan';
+ skip $err => $plan - $Test->current_test;
+ }
+}
More information about the Pkg-perl-cvs-commits
mailing list