Steve Hay wrote: >Revised version (attached) > Damn. Forgot to attach it. Here it is.
------------------------------------------------ Radan Computational Ltd. The information contained in this message and any files transmitted with it are confidential and intended for the addressee(s) only. If you have received this message in error or there are any problems, please notify the sender immediately. The unauthorized use, disclosure, copying or alteration of this message is strictly forbidden. Note that any views or opinions presented in this email are solely those of the author and do not necessarily represent those of Radan Computational Ltd. The recipient(s) of this message should check it and any attached files for viruses: Radan Computational will accept no liability for any damage caused by any virus transmitted by this email.
#include "EXTERN.h" #include "perl.h" #include "XSUB.h" #include "ppport.h" typedef struct { I32 signature; char *buf; } Foo; static Foo *FooAlloc(pTHX); static void FooFree(pTHX_ Foo *foo); static int MagicFooFree(pTHX_ SV *sv, MAGIC *mg); static MGVTBL Foo_vtbl = { NULL, NULL, NULL, NULL, MagicFooFree }; static Foo *FooAlloc(pTHX) { Foo *foo; Newz(0, foo, 1, Foo); Newz(0, foo->buf, 1024, char); foo->signature = 42; strcpy(foo->buf, "Hello, world."); return foo; } static void FooFree(pTHX_ Foo *foo) { Safefree(foo->buf); Safefree(foo); } static int MagicFooFree(pTHX_ SV *sv, MAGIC *mg) { FooFree(aTHX_ (Foo *)mg->mg_ptr); return 1; } MODULE = Foo PACKAGE = Foo void magicfoo() PPCODE: { SV *sv; Foo *foo; MAGIC *mg; // Initialise foo = FooAlloc(aTHX); sv = NEWSV(0, 0); sv_magic(sv, sv, PERL_MAGIC_ext, (char *)foo, 0); SvRMAGICAL_off(sv); if (!(mg = mg_find(sv, PERL_MAGIC_ext))) croak("Can't find new magic"); if (mg->mg_obj != sv) croak("Found wrong magic!"); mg->mg_virtual = &Foo_vtbl; mg_magical(sv); SvREADONLY_on(sv); // Use it if (!(mg = mg_find(sv, PERL_MAGIC_ext))) croak("Can't find magic"); if (!(foo = (Foo *)(mg->mg_ptr))) croak("Can't find magic pointer"); if (foo->signature != 42) croak("Found wrong magic pointer"); printf("%s\n", foo->buf); // Clean up SvREFCNT_dec(sv); } void magicextfoo() PPCODE: { SV *sv; Foo *foo; MAGIC *mg; // Initialise foo = FooAlloc(aTHX); sv = NEWSV(0, 0); if (!sv_magicext(sv, NULL, PERL_MAGIC_ext, &Foo_vtbl, (char *)foo, 0)) croak("Can't add magic"); SvREADONLY_on(sv); // Use it if (!(mg = mg_find(sv, PERL_MAGIC_ext))) croak("Can't find magic"); if (!(foo = (Foo *)(mg->mg_ptr))) croak("Can't find magic pointer"); if (foo->signature != 42) croak("Found wrong magic pointer"); printf("%s\n", foo->buf); // Clean up SvREFCNT_dec(sv); }