--- /dev/null
+blib*
+pm_to_blib*
+
+Makefile{,.old}
+Build
+_build*
+
+*.tar.gz
+Variable-Magic-*
+
+core.*
+*.{c,o,so,bs,out,def,exp}
+
+cover_db
+*.{gcda,gcov,gcno}
+
--- /dev/null
+Revision history for Variable-Magic
+
+0.01 2007-07-25 16:15 UTC
+ First version, released on an unsuspecting world.
+
--- /dev/null
+Changes
+MANIFEST
+META.yml # Will be created by "make dist"
+Magic.xs
+Makefile.PL
+README
+lib/Variable/Magic.pm
+samples/magic.pl
+t/00-load.t
+t/01-import.t
+t/10-simple.t
+t/11-multiple.t
+t/12-data.t
+t/20-get.t
+t/21-set.t
+t/22-len.t
+t/23-clear.t
+t/24-free.t
+t/30-scalar.t
+t/31-array.t
+t/32-hash.t
+t/33-code.t
+t/boilerplate.t
+t/kwalitee.t
+t/pod-coverage.t
+t/pod.t
--- /dev/null
+--- #YAML:1.0
+name: Variable-Magic
+version: 0.01
+abstract: Associate user-defined magic to variables from Perl.
+license: perl
+generated_by: ExtUtils::MakeMaker version 6.36
+distribution_type: module
+requires:
+ Carp: 0
+ constant: 0
+ Test::More: 0
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
+author:
+ - Vincent Pit <perl@profvince.com>
--- /dev/null
+#define PERL_NO_GET_CONTEXT
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+#define SIG_WIZ ((U16) (1u << 8 - 1))
+
+#define R(S) fprintf(stderr, "R(" #S ") = %d\n", SvREFCNT(sv))
+
+typedef struct {
+ MGVTBL *vtbl;
+ U16 sig;
+ SV *cb_get, *cb_set, *cb_len, *cb_clear, *cb_free, *cb_data;
+} MGWIZ;
+
+#define MGWIZ2SV(W) (newSVuv(PTR2UV(W)))
+#define SV2MGWIZ(S) (INT2PTR(MGWIZ*, SvUVX((SV *) (S))))
+
+/* ... Construct private data .............................................. */
+
+STATIC SV *vmg_data_new(pTHX_ SV *ctor, SV *sv) {
+#define vmg_data_new(C, S) vmg_data_new(aTHX_ (C), (S))
+ SV *nsv;
+
+ dSP;
+ int count;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(SP);
+ XPUSHs(sv);
+ PUTBACK;
+
+ count = call_sv(ctor, G_SCALAR);
+
+ SPAGAIN;
+
+ if (count != 1) { croak("Callback needs to return 1 scalar\n"); }
+ nsv = POPs;
+ SvREFCNT_inc(nsv); /* Or it will be destroyed in FREETMPS */
+
+ PUTBACK;
+
+ FREETMPS;
+ LEAVE;
+
+ return nsv;
+}
+
+STATIC SV *vmg_data_get(SV *sv, U16 sig) {
+ MAGIC *mg, *moremagic;
+ MGWIZ *w;
+
+ if (SvTYPE(sv) >= SVt_PVMG) {
+ for (mg = SvMAGIC(sv); mg; mg = moremagic) {
+ moremagic = mg->mg_moremagic;
+ if ((mg->mg_type == PERL_MAGIC_ext) && (mg->mg_private == sig)) { break; }
+ }
+ if (mg) { return mg->mg_obj; }
+ }
+
+ return NULL;
+}
+
+/* ... Magic cast/dispell .................................................. */
+
+STATIC UV vmg_cast(pTHX_ SV *sv, SV *wiz) {
+#define vmg_cast(S, W) vmg_cast(aTHX_ (S), (W))
+ MAGIC *mg = NULL, *moremagic = NULL;
+ MGWIZ *w;
+ SV *data;
+
+ w = SV2MGWIZ(wiz);
+
+ if (SvTYPE(sv) >= SVt_PVMG) {
+ for (mg = SvMAGIC(sv); mg; mg = moremagic) {
+ moremagic = mg->mg_moremagic;
+ if ((mg->mg_type == PERL_MAGIC_ext) && (mg->mg_private == w->sig)) { break; }
+ }
+ if (mg) { return 1; }
+ }
+
+ data = (w->cb_data) ? vmg_data_new(w->cb_data, sv) : NULL;
+ mg = sv_magicext(sv, data, PERL_MAGIC_ext, w->vtbl,
+ (const char *) wiz, HEf_SVKEY);
+ mg->mg_private = w->sig;
+
+ return 1;
+}
+
+STATIC UV vmg_dispell(pTHX_ SV *sv, U16 sig) {
+#define vmg_dispell(S, Z) vmg_dispell(aTHX_ (S), (Z))
+ MAGIC *mg, *prevmagic, *moremagic = NULL;
+ MGWIZ *w;
+
+ if (SvTYPE(sv) < SVt_PVMG) { return 0; }
+
+ for (prevmagic = NULL, mg = SvMAGIC(sv); mg; prevmagic = mg, mg = moremagic) {
+ moremagic = mg->mg_moremagic;
+ if ((mg->mg_type == PERL_MAGIC_ext) && (mg->mg_private == sig)) { break; }
+ }
+ if (!mg) { return 0; }
+
+ if (prevmagic) {
+ prevmagic->mg_moremagic = moremagic;
+ } else {
+ SvMAGIC_set(sv, moremagic);
+ }
+ mg->mg_moremagic = NULL;
+
+ if (mg->mg_obj != sv) { SvREFCNT_dec(mg->mg_obj); } /* Destroy private data */
+ SvREFCNT_dec((SV *) mg->mg_ptr); /* Unreference the wizard */
+ Safefree(mg);
+
+ return 1;
+}
+
+/* ... svt callbacks ....................................................... */
+
+STATIC int vmg_cb_call(pTHX_ SV *cb, SV *sv, SV *data) {
+#define vmg_cb_call(I, S, D) vmg_cb_call(aTHX_ (I), (S), (D))
+ int ret;
+
+ dSP;
+ int count;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(SP);
+ switch (SvTYPE(sv)) {
+ case SVt_PVAV:
+ case SVt_PVHV: XPUSHs(sv_2mortal(newRV_inc(sv))); break;
+ default: XPUSHs(sv);
+ }
+ if (data) { XPUSHs(data); }
+ PUTBACK;
+
+ count = call_sv(cb, G_SCALAR);
+
+ SPAGAIN;
+
+ if (count != 1) { croak("Callback needs to return 1 scalar\n"); }
+ ret = POPi;
+
+ PUTBACK;
+
+ FREETMPS;
+ LEAVE;
+
+ return ret;
+}
+
+STATIC int vmg_svt_get(pTHX_ SV *sv, MAGIC *mg) {
+ return vmg_cb_call(SV2MGWIZ(mg->mg_ptr)->cb_get, sv, mg->mg_obj);
+}
+
+STATIC int vmg_svt_set(pTHX_ SV *sv, MAGIC *mg) {
+ return vmg_cb_call(SV2MGWIZ(mg->mg_ptr)->cb_set, sv, mg->mg_obj);
+}
+
+STATIC U32 vmg_svt_len(pTHX_ SV *sv, MAGIC *mg) {
+ U32 ret;
+
+ dSP;
+ int count;
+
+ ENTER;
+ SAVETMPS;
+
+ PUSHMARK(SP);
+ switch (SvTYPE(sv)) {
+ case SVt_PVAV:
+ case SVt_PVHV: XPUSHs(sv_2mortal(newRV_inc(sv))); break;
+ default: XPUSHs(sv);
+ }
+ XPUSHs((mg->mg_obj) ? (mg->mg_obj) : &PL_sv_undef);
+ if (SvTYPE(sv) == SVt_PVAV) {
+ XPUSHs(sv_2mortal(newSViv(av_len((AV *) sv) + 1)));
+ }
+ PUTBACK;
+
+ count = call_sv(SV2MGWIZ(mg->mg_ptr)->cb_len, G_SCALAR);
+
+ SPAGAIN;
+
+ if (count != 1) { croak("Callback needs to return 1 scalar\n"); }
+ ret = POPi;
+
+ PUTBACK;
+
+ FREETMPS;
+ LEAVE;
+
+ return ret - 1;
+}
+
+STATIC int vmg_svt_clear(pTHX_ SV *sv, MAGIC *mg) {
+ return vmg_cb_call(SV2MGWIZ(mg->mg_ptr)->cb_clear, sv, mg->mg_obj);
+}
+
+STATIC int vmg_svt_free(pTHX_ SV *sv, MAGIC *mg) {
+ /* So that it can survive tmp cleanup in vmg_cb_call */
+ if (SvREFCNT(sv) <= 0) { SvREFCNT_inc(sv); }
+ /* Perl_mg_free will get rid of the magic and decrement mg->mg_obj and
+ * mg->mg_ptr reference count */
+ return vmg_cb_call(SV2MGWIZ(mg->mg_ptr)->cb_free, sv, mg->mg_obj);
+}
+
+/* ... Wizard destructor ................................................... */
+
+STATIC int vmg_wizard_free(pTHX_ SV *wiz, MAGIC *mg) {
+ MGWIZ *w = SV2MGWIZ(wiz);
+
+ if (w->cb_get != NULL) { SvREFCNT_dec(SvRV(w->cb_get)); }
+ if (w->cb_set != NULL) { SvREFCNT_dec(SvRV(w->cb_set)); }
+ if (w->cb_len != NULL) { SvREFCNT_dec(SvRV(w->cb_len)); }
+ if (w->cb_clear != NULL) { SvREFCNT_dec(SvRV(w->cb_clear)); }
+ if (w->cb_free != NULL) { SvREFCNT_dec(SvRV(w->cb_free)); }
+ if (w->cb_data != NULL) { SvREFCNT_dec(SvRV(w->cb_data)); }
+ Safefree(w->vtbl);
+ Safefree(w);
+
+ return 0;
+}
+
+STATIC MGVTBL vmg_wizard_vtbl = {
+ NULL, /* get */
+ NULL, /* set */
+ NULL, /* len */
+ NULL, /* clear */
+ vmg_wizard_free, /* free */
+#ifdef MGf_COPY
+ NULL, /* copy */
+#endif /* MGf_COPY */
+#ifdef MGf_DUP
+ NULL, /* dup */
+#endif /* MGf_DUP */
+};
+
+STATIC const char vmg_invalid_wiz[] = "Invalid wizard object";
+STATIC const char vmg_invalid_sv[] = "Invalid variable";
+STATIC const char vmg_invalid_sig[] = "Invalid numeric signature";
+
+/* --- XS ------------------------------------------------------------------ */
+
+MODULE = Variable::Magic PACKAGE = Variable::Magic
+
+PROTOTYPES: ENABLE
+
+SV *_wizard(SV *sig, SV *cb_get, SV *cb_set, SV *cb_len, SV *cb_clear, SV *cb_free, SV *cb_data)
+PROTOTYPE: $&&&&&
+PREINIT:
+ MGWIZ *w;
+ MGVTBL *t;
+ MAGIC *mg;
+ SV *sv;
+CODE:
+ if (!SvIOK(sig)) { croak(vmg_invalid_sig); }
+
+ Newx(t, 1, MGVTBL);
+ t->svt_get = (SvOK(cb_get)) ? vmg_svt_get : NULL;
+ t->svt_set = (SvOK(cb_set)) ? vmg_svt_set : NULL;
+ t->svt_len = (SvOK(cb_len)) ? vmg_svt_len : NULL;
+ t->svt_clear = (SvOK(cb_clear)) ? vmg_svt_clear : NULL;
+ t->svt_free = (SvOK(cb_free)) ? vmg_svt_free : NULL;
+#ifdef MGf_COPY
+ t->svt_copy = NULL;
+#endif /* MGf_COPY */
+#ifdef MGf_DUP
+ t->svt_dup = NULL;
+#endif /* MGf_DUP */
+
+ Newx(w, 1, MGWIZ);
+ w->vtbl = t;
+ w->sig = SvUVX(sig);
+ w->cb_get = (SvROK(cb_get)) ? newRV_inc(SvRV(cb_get)) : NULL;
+ w->cb_set = (SvROK(cb_set)) ? newRV_inc(SvRV(cb_set)) : NULL;
+ w->cb_len = (SvROK(cb_len)) ? newRV_inc(SvRV(cb_len)) : NULL;
+ w->cb_clear = (SvROK(cb_clear)) ? newRV_inc(SvRV(cb_clear)) : NULL;
+ w->cb_free = (SvROK(cb_free)) ? newRV_inc(SvRV(cb_free)) : NULL;
+ w->cb_data = (SvROK(cb_data)) ? newRV_inc(SvRV(cb_data)) : NULL;
+
+ sv = MGWIZ2SV(w);
+ mg = sv_magicext(sv, NULL, PERL_MAGIC_ext, &vmg_wizard_vtbl, NULL, -1);
+ mg->mg_private = SIG_WIZ;
+
+ RETVAL = newRV_noinc(sv);
+OUTPUT:
+ RETVAL
+
+SV *getsig(SV *wiz)
+PROTOTYPE: $
+CODE:
+ if (!SvROK(wiz)) { croak(vmg_invalid_wiz); }
+ RETVAL = newSVuv(SV2MGWIZ(SvRV(wiz))->sig);
+OUTPUT:
+ RETVAL
+
+SV *cast(SV *sv, SV *wiz)
+PROTOTYPE: \[$@%&*]$
+CODE:
+ if (!SvROK(wiz)) { croak(vmg_invalid_wiz); }
+ RETVAL = newSVuv(vmg_cast(SvRV(sv), SvRV(wiz)));
+OUTPUT:
+ RETVAL
+
+SV *getdata(SV *sv, SV *wiz)
+PROTOTYPE: \[$@%&*]$
+PREINIT:
+ SV *data;
+CODE:
+ if (!SvROK(wiz)) { croak(vmg_invalid_wiz); }
+ data = vmg_data_get(SvRV(sv), SV2MGWIZ(SvRV(wiz))->sig);
+ if (!data) { XSRETURN_UNDEF; }
+ ST(0) = newSVsv(data);
+ XSRETURN(1);
+
+SV *dispell(SV *sv, SV *wiz)
+PROTOTYPE: \[$@%&*]$
+PREINIT:
+ U16 sig;
+CODE:
+ if (SvROK(wiz)) {
+ sig = SV2MGWIZ(SvRV(wiz))->sig;
+ } else if (SvIOK(wiz)) {
+ sig = SvUVX(wiz);
+ } else {
+ croak(vmg_invalid_wiz);
+ }
+ RETVAL = newSVuv(vmg_dispell(SvRV(sv), sig));
+OUTPUT:
+ RETVAL
--- /dev/null
+use strict;
+use warnings;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+ NAME => 'Variable::Magic',
+ AUTHOR => 'Vincent Pit <perl@profvince.com>',
+ LICENSE => 'perl',
+ VERSION_FROM => 'lib/Variable/Magic.pm',
+ ABSTRACT_FROM => 'lib/Variable/Magic.pm',
+ PL_FILES => {},
+ PREREQ_PM => {
+ 'Carp' => 0,
+ 'Test::More' => 0,
+ 'constant' => 0
+ },
+ dist => {
+ PREOP => 'pod2text lib/Variable/Magic.pm > $(DISTVNAME)/README',
+ COMPRESS => 'gzip -9f', SUFFIX => 'gz'
+ },
+ clean => { FILES => 'Variable-Magic-*' },
+);
--- /dev/null
+NAME
+ Variable::Magic - Associate user-defined magic to variables from Perl.
+
+VERSION
+ Version 0.01
+
+SYNOPSIS
+ use Variable::Magic qw/wizard cast dispell/;
+
+ 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)
+
+DESCRIPTION
+ Magic is Perl way of enhancing objects. This mechanism let the user add
+ extra data to any variable and overload 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.
+
+ The operations that can be overloaded are :
+
+ "get"
+ This magic is invoked when the variable is evaluated (does not
+ include array/hash subscripts and slices).
+
+ "set"
+ This one is triggered each time the value of the variable changes
+ (includes array/hash subscripts and slices).
+
+ "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 ("for", "map" or "grep"). The
+ callback has then to return the length as an integer.
+
+ "clear"
+ This magic is invoked when the variable is reset, such as when an
+ array is emptied. Please note that this is different from undefining
+ the variable, even though the magic is called when the reset is a
+ result of the undefine (e.g. for an array).
+
+ "free"
+ This last one can be considered as an object destructor. It happens
+ when the variable goes out of scope (with the exception of global
+ scope), but not when it is undefined.
+
+ 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).
+
+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
+
+FUNCTIONS
+ "wizard"
+ wizard sig => .., data => ..., get => .., set => .., len => .., clear => .., free => ..
+
+ 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 :
+
+ 'sig'
+ The numerical signature. If not specified or undefined, a random
+ signature is generated.
+
+ 'data'
+ A code reference to a private data constructor. It will be called
+ each time this magic is cast on a variable, and the scalar returned
+ will be used as private data storage for it.
+
+ 'get', 'set', 'len', 'clear' and 'free'
+ 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. When the magic variable is an array or a
+ hash, $_[0] is a reference to it, but directly references it
+ otherwise. $_[1] is the private data (or "undef" when no private
+ data constructor was supplied). In the special case of "len" magic
+ and when the variable is an array, $_[2] contains its normal length.
+
+ # 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" }
+
+ "gensig"
+ With this tool, you can manually generate random magic signature between
+ SIG_MIN and SIG_MAX inclusive. That's the way "wizard" creates them when
+ no signature is supplied.
+
+ # Generate a signature
+ my $sig = gensig;
+
+ "getsig"
+ getsig $wiz
+
+ This accessor returns the magic signature of this wizard.
+
+ # Get $wiz signature
+ my $sig = getsig $wiz;
+
+ "cast"
+ cast [$@%&*]var, $wiz
+
+ This function associates $wiz magic to the variable supplied, without
+ overwriting any other kind of magic. It returns true on success or when
+ $wiz magic is already present, and false on error.
+
+ # Casts $wiz to $x
+ my $x;
+ die 'error' unless cast $x, $wiz;
+
+ "getdata"
+ getdata [$@%&*]var, $wiz
+
+ This accessor fetches the private data associated with the magic $wiz in
+ the variable. "undef" is returned when no such magic or data is found.
+
+ "dispell"
+ dispell [$@%&*]variable, $wiz
+ dispell [$@%&*]variable, $sig
+
+ The exact opposite of "cast" : it dissociates $wiz magic from the
+ variable. You can also pass the magic signature as the second argument.
+ True is returned on success, and false on error or when no magic
+ represented by $wiz could be found in the variable.
+
+ # Dispell now
+ die 'no such magic or error' unless dispell $x, $wiz;
+
+EXPORT
+ The functions "wizard", "gensig", "getsig", "cast", "getdata" and
+ "dispell" are only exported on request. All of them are exported by the
+ tags ':funcs' and ':all'.
+
+ The constants "SIG_MIN", "SIG_MAX" and "SIG_NBR" are also only exported
+ on request. They are all exported by the tags ':consts' and ':all'.
+
+DEPENDENCIES
+ Carp (standard since perl 5), XSLoader (standard since perl 5.006).
+
+ Tests use Symbol (standard since perl 5.002).
+
+SEE ALSO
+ perlguts and perlapi for internal information about magic.
+
+AUTHOR
+ Vincent Pit, "<perl at profvince.com>"
+
+BUGS
+ Please report any bugs or feature requests to "bug-variable-magic at
+ rt.cpan.org", or through the web interface at
+ <http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Variable-Magic>. I will
+ be notified, and then you'll automatically be notified of progress on
+ your bug as I make changes.
+
+SUPPORT
+ You can find documentation for this module with the perldoc command.
+
+ perldoc Variable::Magic
+
+COPYRIGHT & LICENSE
+ Copyright 2007 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.
+
--- /dev/null
+package Variable::Magic;
+
+use strict;
+use warnings;
+
+use Carp qw/croak/;
+
+=head1 NAME
+
+Variable::Magic - Associate user-defined magic to variables from Perl.
+
+=head1 VERSION
+
+Version 0.01
+
+=cut
+
+our $VERSION = '0.01';
+
+=head1 SYNOPSIS
+
+ use Variable::Magic qw/wizard cast dispell/;
+
+ 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)
+
+=head1 DESCRIPTION
+
+Magic is Perl way of enhancing objects. This mechanism let the user add extra data to any variable and overload 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.
+
+The operations that can be overloaded are :
+
+=over 4
+
+=item C<get>
+
+This magic is invoked when the variable is evaluated (does not include array/hash subscripts and slices).
+
+=item C<set>
+
+This one is triggered each time the value of the variable changes (includes array/hash subscripts and slices).
+
+=item 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>). The callback has then to return the length as an integer.
+
+=item C<clear>
+
+This magic is invoked when the variable is reset, such as when an array is emptied. Please note that this is different from undefining the variable, even though the magic is called when the reset is a result of the undefine (e.g. for an array).
+
+=item C<free>
+
+This last one can be considered as an object destructor. It happens when the variable goes out of scope (with the exception of global scope), but not when it is undefined.
+
+=back
+
+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 CONSTANTS
+
+=head2 C<SIG_MIN>
+
+The minimum integer used as a signature for user-defined magic.
+
+=cut
+
+use constant SIG_MIN => 2 ** 8;
+
+=head2 C<SIG_MAX>
+
+The maximum integer used as a signature for user-defined magic.
+
+=cut
+
+use constant SIG_MAX => 2 ** 16 - 1;
+
+=head2 C<SIG_NBR>
+
+ SIG_NBR = SIG_MAX - SIG_MIN + 1
+
+=cut
+
+use constant SIG_NBR => SIG_MAX - SIG_MIN + 1;
+
+=head1 FUNCTIONS
+
+=cut
+
+require XSLoader;
+
+XSLoader::load(__PACKAGE__, $VERSION);
+
+my %wizz;
+
+=head2 C<wizard>
+
+ wizard sig => .., data => ..., get => .., set => .., len => .., clear => .., free => ..
+
+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 C<'sig'>
+
+The numerical signature. If not specified or undefined, a random signature is generated.
+
+=item C<'data'>
+
+A code reference to a private data constructor. It will be called each time this magic is cast on a variable, and the scalar returned will be used as private data storage for it.
+
+=item C<'get'>, C<'set'>, C<'len'>, C<'clear'> and C<'free'>
+
+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. When the magic variable is an array or a hash, C<$_[0]> is a reference to it, but directly references it otherwise. C<$_[1]> is 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.
+
+=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 $sig;
+ if (defined $opts{sig}) {
+ $sig = int $opts{sig};
+ $sig += SIG_MIN if $sig < SIG_MIN;
+ $sig %= SIG_MAX + 1 if $sig > SIG_MAX;
+ } else {
+ $sig = gensig();
+ }
+ return _wizard($sig, map { $opts{$_} } qw/get set len clear free data/);
+}
+
+=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;
+
+=cut
+
+sub gensig {
+ my $sig;
+ my $used = ~~keys %wizz;
+ croak 'Too many magic signatures used' if $used == SIG_NBR;
+ do { $sig = SIG_MIN + int(rand(SIG_NBR)) } while $wizz{$sig};
+ return $sig;
+}
+
+=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
+
+This function associates C<$wiz> magic to the variable supplied, without overwriting any other kind of magic. It returns true on success or when C<$wiz> magic is already present, and false on error.
+
+ # Casts $wiz to $x
+ my $x;
+ die 'error' unless cast $x, $wiz;
+
+=head2 C<getdata>
+
+ getdata [$@%&*]var, $wiz
+
+This accessor fetches the private data associated with the magic C<$wiz> in the variable. C<undef> is returned when no such magic or data is found.
+
+=head2 C<dispell>
+
+ dispell [$@%&*]variable, $wiz
+ dispell [$@%&*]variable, $sig
+
+The exact opposite of L</cast> : it dissociates C<$wiz> magic from the variable. You can also pass the magic signature as the second argument. True is returned on success, and false on error or when no magic represented by C<$wiz> could be found in the variable.
+
+ # Dispell now
+ die 'no such magic or error' unless dispell $x, $wiz;
+
+=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> and L</SIG_NBR> are also only exported on request. They are all exported by the tags C<':consts'> and C<':all'>.
+
+=cut
+
+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/ ]
+);
+our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS;
+$EXPORT_TAGS{'all'} = \@EXPORT_OK;
+
+=head1 DEPENDENCIES
+
+L<Carp> (standard since perl 5), L<XSLoader> (standard since perl 5.006).
+
+Tests use L<Symbol> (standard since perl 5.002).
+
+=head1 SEE ALSO
+
+L<perlguts> and L<perlapi> for internal information about magic.
+
+=head1 AUTHOR
+
+Vincent Pit, C<< <perl at profvince.com> >>
+
+=head1 BUGS
+
+Please report any bugs or feature requests to
+C<bug-variable-magic at rt.cpan.org>, or through the web interface at
+L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Variable-Magic>.
+I will be notified, and then you'll automatically be notified of progress on
+your bug as I make changes.
+
+=head1 SUPPORT
+
+You can find documentation for this module with the perldoc command.
+
+ perldoc Variable::Magic
+
+=head1 COPYRIGHT & LICENSE
+
+Copyright 2007 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.
+
+=cut
+
+1; # End of Variable::Magic
--- /dev/null
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use lib qw{blib/arch blib/lib};
+use Variable::Magic qw/wizard getsig cast dispell/;
+
+sub foo { print STDERR "got $_[0]!\n" }
+my $bar = sub { ++$_[0]; print STDERR "now set to $_[0]!\n"; };
+
+my $a = 1;
+my $sig;
+{
+ my $wiz = wizard get => \&foo,
+ set => $bar,
+ free => sub { print STDERR "deleted!\n"; };
+ $sig = getsig $wiz;
+ print "my sig is $sig\n";
+ cast $a, $wiz;
+ ++$a; # "got 1!", "now set to 3!"
+ dispell $a, $wiz;
+ cast $a, $wiz;
+ my $b = 123;
+ cast $b, $wiz;
+} # "got 123!", "deleted!"
+my $b = $a; # "got 3!"
+$a = 3; # "now set to 4!"
+$b = 3; # (nothing)
+dispell $a, $sig;
+$a = 4; # (nothing)
--- /dev/null
+#!perl -T
+
+use Test::More tests => 1;
+
+BEGIN {
+ use_ok( 'Variable::Magic' );
+}
+
+diag( "Testing Variable::Magic $Variable::Magic::VERSION, Perl $], $^X" );
--- /dev/null
+#!perl -T
+
+use Test::More tests => 9;
+
+require Variable::Magic;
+
+for (qw/wizard gensig getsig cast getdata dispell SIG_MIN SIG_MAX SIG_NBR/) {
+ eval { Variable::Magic->import($_) };
+ ok(!$@, 'import ' . $_);
+}
--- /dev/null
+#!perl -T
+
+use Test::More tests => 12;
+
+use Variable::Magic qw/wizard gensig getsig cast dispell/;
+
+my $sig = gensig;
+
+my $wiz = eval { wizard sig => $sig };
+ok(!$@, "wizard creation error ($@)");
+ok(defined $wiz, 'wizard is defined');
+ok(ref $wiz eq 'SCALAR', 'wizard is a scalar ref');
+ok($sig == getsig $wiz, 'wizard signature is correct');
+
+my $a = 0;
+my $res = eval { cast $a, $wiz };
+ok(!$@, "cast error 1 ($@)");
+ok($res, 'cast error 2');
+
+$res = eval { dispell $a, $wiz };
+ok(!$@, "dispell from wizard error 1 ($@)");
+ok($res, 'dispell from wizard error 2');
+
+$res = eval { cast $a, $wiz };
+ok(!$@, "re-cast error 1 ($@)");
+ok($res, 're-cast error 2');
+
+$res = eval { dispell $a, $sig };
+ok(!$@, "dispell from signature error 1 ($@)");
+ok($res, 'dispell from signature error 2');
+
--- /dev/null
+#!perl -T
+
+use Test::More tests => 33;
+
+use Variable::Magic qw/wizard cast dispell/;
+
+my $n = 3;
+my @w;
+my @c = (0) x $n;
+
+sub multi {
+ my ($cb, $tests) = @_;
+ for (local $i = 0; $i < $n; ++$i) {
+ my $res = eval { $cb->() };
+ $tests->($res, $@);
+ }
+}
+
+eval { $w[0] = wizard get => sub { ++$c[0] }, set => sub { --$c[0] } };
+ok(!$@, "wizard 0 creation error ($@)");
+eval { $w[1] = wizard get => sub { ++$c[1] }, set => sub { --$c[1] } };
+ok(!$@, "wizard 1 creation error ($@)");
+eval { $w[2] = wizard get => sub { ++$c[2] }, set => sub { --$c[2] } };
+ok(!$@, "wizard 2 creation error ($@)");
+
+multi sub {
+ $w[$i]
+}, sub {
+ my ($res, $err) = @_;
+ ok(defined $res, "wizard $i is defined");
+ ok(ref($w[$i]) eq 'SCALAR', "wizard $i is a scalar ref");
+};
+
+my $a = 0;
+
+multi sub {
+ cast $a, $w[$i];
+}, sub {
+ my ($res, $err) = @_;
+ ok(!$err, "cast magic $i error 1 ($err)");
+ ok($res, "cast magic $i error 2");
+};
+
+my $b = $a;
+for (0 .. $n - 1) { ok($c[$_] == 1, "get magic $_"); }
+
+$a = 1;
+for (0 .. $n - 1) { ok($c[$_] == 0, "set magic $_"); }
+
+my $res = eval { dispell $a, $w[1] };
+ok(!$@, "dispell magic 1 error 1 ($@)");
+ok($res, 'dispell magic 1 error 2');
+
+$b = $a;
+for (0, 2) { ok($c[$_] == 1, "get magic $_ after dispelled 1"); }
+
+$a = 2;
+for (0, 2) { ok($c[$_] == 0, "set magic $_ after dispelled 1"); }
+
+$res = eval { dispell $a, $w[0] };
+ok(!$@, "dispell magic 0 error 1 ($@)");
+ok($res, 'dispell magic 0 error 2');
+
+$b = $a;
+ok($c[2] == 1, 'get magic 2 after dispelled 1 & 0');
+
+$a = 3;
+ok($c[2] == 0, 'set magic 2 after dispelled 1 & 0');
+
+$res = eval { dispell $a, $w[2] };
+ok(!$@, "dispell magic 2 error 1 ($@)");
+ok($res, 'dispell magic 2 error 2');
--- /dev/null
+#!perl -T
+
+use Test::More tests => 14;
+
+use Variable::Magic qw/wizard getdata cast dispell/;
+
+my $c = 1;
+
+my $wiz = eval {
+ wizard data => sub { return { foo => 12, bar => 27 } },
+ get => sub { $c += $_[1]->{foo}; $_[1]->{foo} = $c },
+ set => sub { $c += $_[1]->{bar}; $_[1]->{bar} = $c }
+};
+ok(!$@, "wizard creation error ($@)");
+ok(defined $wiz, 'wizard is defined');
+ok(ref $wiz eq 'SCALAR', 'wizard is a scalar ref');
+
+my $a = 75;
+my $res = eval { cast $a, $wiz };
+ok(!$@, "cast error 1 ($@)");
+ok($res, 'cast error 2');
+
+my $data = eval { getdata $a, $wiz };
+ok(!$@, "getdata error 1 ($@)");
+ok($res, 'getdata error 2');
+ok($data && ref($data) eq 'HASH'
+ && exists $data->{foo} && $data->{foo} eq 12
+ && exists $data->{bar} && $data->{bar} eq 27,
+ 'private data creation ok');
+
+my $b = $a;
+ok($c == 13, 'get magic : pass data');
+ok($data->{foo} == 13, 'get magic : data updated');
+
+$a = 57;
+ok($c == 40, 'set magic : pass data');
+ok($data->{bar} == 40, 'set magic : pass data');
+
+$res = eval { dispell $a, $wiz };
+ok(!$@, "dispell error 1 ($@)");
+ok($res, 'dispell error 2');
--- /dev/null
+#!perl -T
+
+use Test::More tests => 6;
+
+use Variable::Magic qw/wizard cast/;
+
+my $c = 0;
+my $wiz = wizard get => sub { ++$c };
+ok($c == 0, 'get : create wizard');
+
+my $n = int rand 1000;
+my $a = $n;
+
+cast $a, $wiz;
+ok($c == 0, 'get : cast');
+
+my $b = $a;
+ok($c == 1, 'get : assign to');
+ok($b == $n, 'get : assign to correctly');
+
+$b = "X${a}Y";
+ok($c == 2, 'get : interpolate');
+ok($b eq "X${n}Y", 'get : interpolate correctly');
--- /dev/null
+#!perl -T
+
+use Test::More tests => 8;
+
+use Variable::Magic qw/wizard cast/;
+
+my $c = 0;
+my $wiz = wizard set => sub { ++$c };
+ok($c == 0, 'get : create wizard');
+
+my $a = 0;
+cast $a, $wiz;
+ok($c == 0, 'get : cast');
+
+my $n = int rand 1000;
+$a = $n;
+ok($c == 1, 'set : assign');
+ok($a == $n, 'set : assign correctly');
+
+++$a;
+ok($c == 2, 'set : increment');
+ok($a == $n + 1, 'set : increment correctly');
+
+--$a;
+ok($c == 3, 'set : decrement');
+ok($a == $n, 'set : decrement correctly');
--- /dev/null
+#!perl -T
+
+use Test::More tests => 6;
+
+use Variable::Magic qw/wizard cast/;
+
+my $c = 0;
+my $n = int rand 1000;
+my $wiz = wizard len => sub { ++$c; return $n };
+ok($c == 0, 'len : create wizard');
+
+my @a = qw/a b c/;
+
+cast @a, $wiz;
+ok($c == 0, 'len : cast');
+
+my $b = scalar @a;
+ok($c == 1, 'len : get length');
+ok($b == $n, 'len : get length correctly');
+
+$n = 0;
+$b = scalar @a;
+ok($c == 2, 'len : get length 0');
+ok($b == 0, 'len : get length 0 correctly');
--- /dev/null
+#!perl -T
+
+use Test::More tests => 7;
+
+use Variable::Magic qw/wizard cast/;
+
+my $c = 0;
+my $wiz = wizard clear => sub { ++$c };
+ok($c == 0, 'clear : create wizard');
+
+my @a = qw/a b c/;
+
+cast @a, $wiz;
+ok($c == 0, 'clear : cast array');
+
+@a = ();
+ok($c == 1, 'clear : clear array');
+ok(!defined $a[0], 'clear : clear array correctly');
+
+my %h = (foo => 1, bar => 2);
+
+cast %h, $wiz;
+ok($c == 1, 'clear : cast hash');
+
+%h = ();
+ok($c == 2, 'clear : clear hash');
+ok(!(keys %h), 'clear : clear hash correctly');
--- /dev/null
+#!perl -T
+
+use Test::More tests => 4;
+
+use Variable::Magic qw/wizard cast/;
+
+my $c = 0;
+my $wiz = wizard free => sub { ++$c };
+ok($c == 0, 'free : create wizard');
+
+my $n = int rand 1000;
+
+{
+ my $a = $n;
+
+ cast $a, $wiz;
+ ok($c == 0, 'free : cast');
+}
+ok($c == 1, 'free : deletion at the end of the scope');
+
+my $a = $n;
+undef $n;
+ok($c == 1, 'free : explicit deletion with undef()');
--- /dev/null
+#!perl -T
+
+use Test::More tests => 13;
+
+use Variable::Magic qw/wizard cast dispell/;
+
+my @c = (0) x 5;
+my @x = (0) x 5;
+
+sub check {
+ for (0 .. 4) { return 0 unless $c[$_] == $x[$_]; }
+ return 1;
+}
+
+my $i = -1;
+my $wiz = wizard get => sub { ++$c[0] },
+ set => sub { ++$c[1] },
+ len => sub { ++$c[2] },
+ clear => sub { ++$c[3] },
+ free => sub { ++$c[4] };
+ok(check(), 'scalar : create wizard');
+
+my $n = int rand 1000;
+my $a = $n;
+
+cast $a, $wiz;
+ok(check(), 'scalar : cast');
+
+my $b = $a;
+++$x[0];
+ok(check(), 'scalar : assign to');
+
+$b = "X${a}Y";
+++$x[0];
+ok(check(), 'scalar : interpolate');
+
+$b = \$a;
+ok(check(), 'scalar : reference');
+
+$a = 123;
+++$x[1];
+ok(check(), 'scalar : assign');
+
+++$a;
+++$x[0]; ++$x[1];
+ok(check(), 'scalar : increment');
+
+--$a;
+++$x[0]; ++$x[1];
+ok(check(), 'scalar : decrement');
+
+$a *= 1.5;
+++$x[0]; ++$x[1];
+ok(check(), 'scalar : multiply');
+
+$a /= 1.5;
+++$x[0]; ++$x[1];
+ok(check(), 'scalar : divide');
+
+{
+ my $b = $n;
+ cast $b, $wiz;
+}
+++$x[4];
+ok(check(), 'scalar : scope end');
+
+undef $a;
+++$x[1];
+ok(check(), 'scalar : undef');
+
+dispell $a, $wiz;
+ok(check(), 'scalar : dispell');
--- /dev/null
+#!perl -T
+
+use Test::More tests => 21;
+
+use Variable::Magic qw/wizard cast dispell/;
+
+my @c = (0) x 5;
+my @x = (0) x 5;
+
+sub check {
+ for (0 .. 4) { return 0 unless $c[$_] == $x[$_]; }
+ return 1;
+}
+
+my $wiz = wizard get => sub { ++$c[0] },
+ set => sub { ++$c[1] },
+ len => sub { ++$c[2]; $_[2] },
+ clear => sub { ++$c[3] },
+ free => sub { ++$c[4] };
+ok(check(), 'array : create wizard');
+
+my @n = map { int rand 1000 } 1 .. 5;
+my @a = @n;
+
+cast @a, $wiz;
+ok(check(), 'array : cast');
+
+my $b = $a[2];
+ok(check(), 'array : assign element to');
+
+my @b = @a;
+++$x[2];
+ok(check(), 'array : assign to');
+
+$b = "X@{a}Y";
+++$x[2];
+ok(check(), 'array : interpolate');
+
+$b = \@a;
+ok(check(), 'array : reference');
+
+@b = @a[2 .. 4];
+ok(check(), 'array : slice');
+
+@a = qw/a b d/;
+$x[1] += 3; ++$x[3];
+ok(check(), 'array : assign');
+
+$a[2] = 'c';
+ok(check(), 'array : assign old element');
+
+$a[3] = 'd';
+++$x[1];
+ok(check(), 'array : assign new element');
+
+push @a, 'x';
+++$x[1]; ++$x[2];
+ok(check(), 'array : push');
+
+pop @a;
+++$x[1]; ++$x[2];
+ok(check(), 'array : pop');
+
+unshift @a, 'x';
+++$x[1]; ++$x[2];
+ok(check(), 'array : unshift');
+
+shift @a;
+++$x[1]; ++$x[2];
+ok(check(), 'array : shift');
+
+$b = @a;
+++$x[2];
+ok(check(), 'array : length');
+
+@a = map ord, @a;
+$x[1] += 4; ++$x[2]; ++$x[3];
+ok(check(), 'array : map');
+
+@b = grep { defined && $_ >= ord('b') } @a;
+++$x[2];
+ok(check(), 'array : grep');
+
+for (@a) { }
+$x[2] += 5;
+ok(check(), 'array : for');
+
+{
+ my @b = @n;
+# cast @b, $wiz;
+}
+#++$x[4];
+ok(check(), 'array : scope end');
+
+undef @a;
+ok(check(), 'array : undef');
+
+dispell @a, $wiz;
+ok(check(), 'array : dispel');
--- /dev/null
+#!perl -T
+
+use Test::More tests => 17;
+
+use Variable::Magic qw/wizard cast dispell/;
+
+my @c = (0) x 5;
+my @x = (0) x 5;
+
+sub check {
+ for (0 .. 4) { return 0 unless $c[$_] == $x[$_]; }
+ return 1;
+}
+
+my $wiz = wizard get => sub { ++$c[0] },
+ set => sub { ++$c[1] },
+ len => sub { ++$c[2]; $_[2] },
+ clear => sub { ++$c[3] },
+ free => sub { ++$c[4] };
+ok(check(), 'hash : create wizard');
+
+my %n = map { $_ => int rand 1000 } qw/foo bar baz qux/;
+my %a = %n;
+
+cast %a, $wiz;
+ok(check(), 'hash : cast');
+
+my $b = $a{foo};
+ok(check(), 'hash : assign element to');
+
+my %b = %a;
+ok(check(), 'hash : assign to');
+
+$b = "X%{a}Y";
+ok(check(), 'hash : interpolate');
+
+$b = \%a;
+ok(check(), 'hash : reference');
+
+my @b = @a{qw/bar qux/};
+ok(check(), 'hash : slice');
+
+%a = map { $_ => 1 } qw/a b d/;
+++$x[3];
+ok(check(), 'hash : assign');
+
+$a{d} = 2;
+ok(check(), 'hash : assign old element');
+
+$a{c} = 3;
+ok(check(), 'hash : assign new element');
+
+$b = %a;
+ok(check(), 'hash : buckets');
+
+@b = keys %a;
+ok(check(), 'hash : keys');
+
+@b = values %a;
+ok(check(), 'hash : values');
+
+while (my ($k, $v) = each %a) { }
+ok(check(), 'hash : each');
+
+{
+ my %b = %n;
+# cast %b, $wiz;
+}
+#++$x[4];
+ok(check(), 'hash : scope end');
+
+undef %a;
+++$x[3];
+ok(check(), 'hash : undef');
+
+dispell %a, $wiz;
+ok(check(), 'hash : dispel');
--- /dev/null
+#!perl -T
+
+use Test::More tests => 10;
+
+use Variable::Magic qw/wizard cast dispell/;
+
+my @c = (0) x 5;
+my @x = (0) x 5;
+
+sub check {
+ for (0 .. 4) { return 0 unless $c[$_] == $x[$_]; }
+ return 1;
+}
+
+my $i = -1;
+my $wiz = wizard get => sub { ++$c[0] },
+ set => sub { ++$c[1] },
+ len => sub { ++$c[2] },
+ clear => sub { ++$c[3] },
+ free => sub { ++$c[4] };
+ok(check(), 'code : create wizard');
+
+my $x = 0;
+my $n = sub { ++$x };
+my $a = $n;
+
+cast $a, $wiz;
+ok(check(), 'code : cast');
+
+my $b = $a;
+++$x[0];
+ok(check(), 'code : assign to');
+
+$b = "X${a}Y";
+++$x[0];
+ok(check(), 'code : interpolate');
+
+$b = \$a;
+ok(check(), 'code : reference');
+
+$a = $n;
+++$x[1];
+ok(check(), 'code : assign');
+
+$a->();
+ok(check(), 'code : call');
+
+{
+ my $b = $n;
+ cast $b, $wiz;
+}
+++$x[4];
+ok(check(), 'code : scope end');
+
+undef $a;
+++$x[1];
+ok(check(), 'code : undef');
+
+dispell $a, $wiz;
+ok(check(), 'code : dispell');
--- /dev/null
+#!perl -T
+
+use strict;
+use warnings;
+use Test::More tests => 3;
+
+sub not_in_file_ok {
+ my ($filename, %regex) = @_;
+ open my $fh, "<", $filename
+ or die "couldn't open $filename for reading: $!";
+
+ my %violated;
+
+ while (my $line = <$fh>) {
+ while (my ($desc, $regex) = each %regex) {
+ if ($line =~ $regex) {
+ push @{$violated{$desc}||=[]}, $.;
+ }
+ }
+ }
+
+ if (%violated) {
+ fail("$filename contains boilerplate text");
+ diag "$_ appears on lines @{$violated{$_}}" for keys %violated;
+ } else {
+ pass("$filename contains no boilerplate text");
+ }
+}
+
+not_in_file_ok(README =>
+ "The README is used..." => qr/The README is used/,
+ "'version information here'" => qr/to provide version information/,
+);
+
+not_in_file_ok(Changes =>
+ "placeholder date/time" => qr(Date/time)
+);
+
+sub module_boilerplate_ok {
+ my ($module) = @_;
+ not_in_file_ok($module =>
+ 'the great new $MODULENAME' => qr/ - The great new /,
+ 'boilerplate description' => qr/Quick summary of what the module/,
+ 'stub function definition' => qr/function[12]/,
+ );
+}
+
+module_boilerplate_ok('lib/Variable/Magic.pm');
--- /dev/null
+#!perl
+
+use Test::More;
+
+eval { require Test::Kwalitee; Test::Kwalitee->import() };
+plan( skip_all => 'Test::Kwalitee not installed; skipping' ) if $@;
--- /dev/null
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod::Coverage 1.04";
+plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
+all_pod_coverage_ok( { also_private => [ qr/^_/ ] } );
--- /dev/null
+#!perl -T
+
+use Test::More;
+eval "use Test::Pod 1.14";
+plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
+all_pod_files_ok();
projects / perl / modules / Variable-Magic.git / commitdiff