Re: xs module example

[Sisyphus]

----- Original Message ----- 
From: "Konstantin Sorokin" <[EMAIL PROTECTED]>
To: <perl-xs@perl.org>
Sent: Saturday, March 25, 2006 8:42 PM
Subject: xs module example


> Hello!
>
> Would you like to recommend me good-style and not too complex XS module
> example from CPAN with OO interface which I can use as good reference
> while studing XS ?
>

Hi,

Not on CPAN - it's based on one of the examples in perldoc
'Inline::C-Cookbook' (if you have Inline::C installed):

-- MANIFEST --
MANIFEST
Makefile.PL
Soldier.pm
Soldier.xs
t/basic.t
--------------

-- Makefile.PL --
use ExtUtils::MakeMaker;

WriteMakefile(
  'NAME' => 'Soldier',
  'VERSION_FROM' => 'Soldier.pm');
-----------------

-- Soldier.pm --
package Soldier;

require DynaLoader;
@ISA = qw(DynaLoader);

$VERSION = 0.01;

bootstrap Soldier $VERSION;

1;
-----------------

-- Soldier.xs --
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

typedef struct {
  char* name;
  char* rank;
  long  serial;
} Soldier;


SV* new(char* class, char* name, char* rank, long serial) {
    Soldier* soldier = malloc(sizeof(Soldier));
    SV*      obj_ref = newSViv(0);
    SV*      obj = newSVrv(obj_ref, class);

    soldier->name = savepv(name);
    soldier->rank = savepv(rank);
    soldier->serial = serial;

    sv_setiv(obj, (IV)soldier);
    SvREADONLY_on(obj);
    return obj_ref;
}

char* get_name(SV* obj) {
      return (INT2PTR(Soldier*,SvIV(SvRV(obj))))->name;
}

char* get_rank(SV* obj) {
      return (INT2PTR(Soldier*,SvIV(SvRV(obj))))->rank;
}

long get_serial(SV* obj) {
     return (INT2PTR(Soldier*,SvIV(SvRV(obj))))->serial;
     }

void DESTROY(SV* obj) {
     Soldier* soldier = (Soldier*)SvIV(SvRV(obj));
     free(soldier->name);
     free(soldier->rank);
     free(soldier);
}

MODULE = Soldier PACKAGE = Soldier

PROTOTYPES: DISABLE

SV*
new (class, name, rank, serial)
 char* class
 char* name
 char* rank
 long serial

char*
get_name (obj)
 SV* obj

char*
get_rank (obj)
 SV* obj

long
get_serial (obj)
 SV* obj

void
DESTROY (obj)
 SV* obj
 PREINIT:
 I32* temp;
 PPCODE:
 temp = PL_markstack_ptr++;
 DESTROY (obj);
 if (PL_markstack_ptr != temp) {
          /* truly void, because dXSARGS not invoked */
   PL_markstack_ptr = temp;
   XSRETURN_EMPTY; /* return empty stack */
        }
        /* must have used dXSARGS; list context implied */
 return; /* assume stack size is correct */
-------------------

-- t/basic.t --
use warnings;
use strict;
use Soldier;

print "1..1\n";

my $obj = Soldier->new('Benjamin', 'Private', 11111);

if($obj->get_serial == 11111
   &&
   $obj->get_rank eq 'Private'
   &&
   $obj->get_name eq 'Benjamin') {print "ok 1\n"}
else {print "not ok 1\n"}
-----------------

Hope that helps. (Personally, I'd be using New/Safefree instead of
malloc/free, but I've left it as per the Cookbook example.)

Cheers,
Rob