----- 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