xs module example

[Konstantin Sorokin]

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 ?

[Sisyphus]

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

Post by Konstantin Sorokin
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