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);
}

Reply via email to