Why not adopt me?

This distribution is up for adoption! If you're interested then please contact the PAUSE module admins via email.

NAME

Panda::XS - useful features and typemaps for XS modules.

DESCRIPTION

Panda::XS provides some useful features for XS modules. Also adds default configurable typemaps with most commonly used types. Panda::XS makes it possible for other modules (Perl or XS) to inherit from your XS module. To use it you must have a C++ compiler. Of course most (or all) CPAN modules have private implementation visible only via perl interface (function or method calls). But it is a much better approach to implement functionality in C/C++ classes with public API, make an XS interface, to make it usable from perl and also make you C code visible to other XS modules. This makes it possible for other users to use your C code directly from other XS modules, without perl method/function interface and therefore they can achieve much greater speeds. To make your C code visible to other XS modules when your module is installed, see Panda::Install.

SYNOPSIS

Makefile.PL:

use strict;
use Panda::Install 'write_makefile';

write_makefile(
    NAME    => 'MyXS',
    CPLUS   => 1,
    DEPENDS => 'Panda::XS',
);

mytypemap.map:

MyClass*  T_OPTR
MyClass3* T_OEXT

MyXS.xs:

#include <xs/xs.h> /* replaces #include perl.h, ppport.h, XSUB.h, etc... */

...

# C++ class based object
MyClass*
MyClass::new ()
CODE:
    RETVAL = new MyClass();
    ... // scalar-reference based object. IV value is C pointer address.

void
MyClass::somefunc ()
PPCODE:
    THIS->somefunc();
    ...

void
MyClass::DESTROY ()

# hash and C++ class based object at one time
using xs::sv_payload_attach;
using xs::rv_payload;
MODULE=... PACKAGE=MyClass2

SV*
new (const char* CLASS)
CODE:
    RETVAL = sv_bless( newRV_noinc((SV*)newHV()), gv_stashpv(CLASS, GV_ADD) );
    rv_payload_attach(RETVAL, new MyClass2());
OUTPUT:
    RETVAL
    
void
somefunc (SV* OBJ)
PPCODE:
    if (!SvROK(OBJ)) croak("....");
    MyClass2* THIS = (MyClass2*) rv_payload(OBJ);
    assert(THIS);
    ...
    
void
DESTROY (SV* OBJ)
PPCODE:
    if (!SvROK(OBJ)) croak("....");
    MyClass2* THIS = (MyClass2*) rv_payload(OBJ);
    delete THIS;
    
    
# ANY-SV and C++ class based object at one time
MyClass3*
MyClass3::new ()
CODE:
    RETVAL = new MyClass2();

void
MyClass3::somefunc ()
PPCODE:
    THIS->somefunc();
    ...

void
MyClass3::DESTROY ()

MyXS.pm:

package MyXS;
use Panda::XS;

our $VERSION = '0.1.3';
require Panda::XSLoader;
Panda::XSLoader::bootstrap(); # replacement for XSLoader::load()

TYPEMAP

(u)int(8/16/32/64)_t

Mappings for integers

AV*, HV*, CV*, IO*

Array/Hash/Code/IO references.

AV*
get_list ()
CODE:
    RETVAL = newAV();
    // push values to RETVAL
    

void
merge (HV* h1, HV* h2)
PPCODE:
    ...

OSV*, OAV*, OHV*, OIO*

Scalar/Array/Hash/IO reference based objects.

OHV*
OHV::new ()
CODE:
    RETVAL = newHV();


int
OAV::get_count ()
CODE:
    RETVAL = *av_fetch(THIS, 1, 1);

T_OPTR

YOUR_TYPE : T_OPTR([basetype=classname], [nocast=1])

IV(SCALAR)-based object with C pointer attached.

TYPEMAP
MyClass* T_OPTR

# XS

MyClass*
MyClass::new ()
CODE:
    RETVAL = new MyClass();
    
void
MyClass::somefunc()
PPCODE:
    // use 'THIS' (MyClass*)
    
void
MyClass::DESTROY ()

The main problem of this method is that one cannot fully inherit from your module (no place to store another class' data). However you can still use inheritance XS->XS->... if your child's XS uses C++ class which inherits from parent's C++ class. In another words, of you still need to hold only single pointer. In this case, set 'basetype' to the name of the most parent C++ class. See HOW TO for details.

T_OPTR_REFCNT

YOUR_TYPE : T_OPTR_REFCNT([basetype=classname], [nocast=1])

A typemap class for C++ objects which inherit from panda::RefCounted class. Enables automatic reference counting (retain() on OUTPUT and release() on DESTROY). Remember that you HAVE to define DESTROY function even if you don't have anything to do there. Otherwise, release() won't be called!

void MyClass::DESTROY ()

T_OPTR_SHARED

YOUR_TYPE : T_OPTR_SHARED([basetype=classname], [nocast=1])

A typemap class for case when you want to store an object in a shared pointer. Shared pointer can be C++11's std::shared_ptr or panda::shared_ptr (STL compatible shared pointer which works even without C++11).

Note that if you want to use this typemap, your typemap type must be a shared pointer, not an object's type. Also you must set a shared pointer to OUTPUT variable (RETVAL), and you will receive a shared pointer in INPUT args. For example:

typedef shared_ptr<MyClass> MyClassSP;

#typemap
MyClassSP T_OPTR_SHARED

#XS
MyClassSP new (SV* CLASS, int val) {
    RETVAL = MyClassSP(new MyClass(val));
}

int get_val (MyClassSP THIS) {
    RETVAL = THIS->val;
}

void DESTROY (MyClassSP THIS)

Also note that shared pointers are passed by value, not by pointer. See how we receive an INPUT arg 'THIS':

int get_val (MyClassSP THIS)  // CORRECT
int get_val (MyClassSP* THIS) // WRONG!!!

Unfortunately, when using shared pointers, class-methods-like XS syntax is unavailable:

int MyClassSP::get_val () // WRONG!!!

Because MakeMaker's ParseXS automatically rewrite it as

int get_val (MyClassSP* THIS) // WRONG!!!

Remember that you HAVE to define DESTROY function even if you don't have anything to do there. Otherwise, shared pointer won't be released!

T_OEXT

YOUR_TYPE : T_OEXT([basetype=classname], [nocast=1], [on_svdup=funcname])

Extendable object with C pointer attached.

TYPEMAP
MyClass* T_OEXT

# XS

MyClass*
MyClass::new ()
CODE:
    RETVAL = new MyClass();
    

void
MyClass::somefunc()
PPCODE:
    // use 'THIS' (MyClass*)

void
MyClass::DESTROY ()

This method is much more flexible as it allows for inheritance and even XS -> XS inheritance where each one holds its own C++ object. I.e. it can hold an arbitrary number of pointers.

<T_OEXT C type>::new will create scalar-based object (reference to undef)

my $obj = MyClass->new; # $obj is RV to undef with C++ MyClass attached

Use obj2hv / obj2av to change the object's base to desired type.

Panda::XS::obj2hv($obj); # $obj is RV to HV with C++ MyClass attached

Panda::XS::obj2av($obj); # $obj is RV to AV with C++ MyClass attached

After that you can store data in $obj->{..} or $obj->[..] as if it was a regular perl object

basetype [default is $type]

The most parent C++ class in XS hierarchy. Used as a marker(key) for storing C++ pointer in perl object's magic. Also used for auto typecasting from parent class to child class like this 'THIS = dynamic_cast<$type>(($basetype)stored_ptr)' for input typemaps and from child class to parent class in output typemaps 'stored_ptr = static_cast<$basetype>(RETVAL)'. By default $basetype = $type. If $basetype == $type, then casting is not performed. See HOW TO for details.

nocast [default is 0]

If set, disables typecasting described in 'basetype' section even if $basetype != $type. Useful for storing objects in wrappers. See HOW TO for details.

on_svdup

Callback (function) name to call on threaded perls when a new thread is created and your object is about to be copied. Function signature is:

<basetype> <callbackname> (<basetype> arg);

See "THREADED PERLS SUPPORT" for details.

CLASS (required)

Define this variable as either 'const char*' or 'SV*' or 'HV*' and set it to a class name or a class stash (HV*) you want your object to be blessed to. It is done automatically for methods 'new', so that you must not define this variable in 'new' methods. However you can change it's value if you want to.

If you already have class stash, set HV* CLASS.

For example, in an object method, which returns another object, like 'clone':

HV* CLASS = SvSTASH(SvRV(ST(0)))

It's the most effective way for Panda::XS to bless your newly created object. However doing this:

HV* CLASS = gv_stashpv(classname_str, GV_ADD);

won't lead to any perfomance gain over setting const char* CLASS.

If not, but you have a class name in SV*, set SV* CLASS:

For example, in a class method, which creates object.

SV* CLASS = ST(0);

In some cases it runs much faster than setting const char* CLASS (when ST(0) is a shared COW string, since perl 5.21.4).

Don't do it for method 'new' because ExtUtils::ParseXS automatically sets "const char* CLASS = SvPV_nolen(ST(0));" which unfortunately is not the most effective way. Of course it happens only if you "typemap"ed your function (MyClass* MyClass::new ())

If you don't have anything of above, set const char* CLASS

For example, in constructors that are called as functions, not as class methods, like 'uri("http://ya.ru")'

const char* CLASS = "MyFramework::URI";

self

This variable is automatically defined for all T_OEXT outputs and is set to NULL. If you don't change its value, then a new object (reference to undef) will be created and your RETVAL will be attached to it. If you want to attach your RETVAL to an already existing object, set 'self' variable to some SV* value. Value must be a valid RV to a blessed SV, or an SV itself (in this case an RV to specified SV is created and blessed). Useful for calling super and next methods. See HOW TO for details.

T_OEXT_AV, T_OEXT_HV

HV or AV based object with C pointer attached.

TYPEMAP
MyClass* T_OEXT_HV

# XS

MyClass*
MyClass::new ()
CODE:
    RETVAL = new MyClass();

void
MyClass::somefunc()
PPCODE:
    // use THIS (MyClass*)

void
MyClass::DESTROY ()

# in perl code
my $obj = MyClass->new; # $obj is a blessed HASHREF
$obj->somefunc;

the above works like

TYPEMAP
MyClass* T_OEXT

# XS

MyClass*
MyClass::new ()
CODE:
    RETVAL = new MyClass();
    
void
MyClass::DESTROY ()

# in perl code
my $obj = MyClass->new; # $obj is a blessed SCALARREF (ref to undef)
Panda::XS::obj2hv($obj); # $obj is a blessed HASHREF

and exactly like

TYPEMAP
MyClass* MY_TYPE

OUTPUT
MY_TYPE : T_OEXT
     if (!self && $var) self = (SV*)newHV();
     
INPUT
MY_TYPE : T_OEXT

# XS

MyClass*
MyClass::new ()
CODE:
    RETVAL = new MyClass();

# in perl code
my $obj = MyClass->new; # $obj is a blessed HASHREF

T_OEXT_REFCNT
YOUR_TYPE : T_OEXT_REFCNT([basetype=classname], [nocast=1]): See T_OPTR_REFCNT
T_OEXT_SHARED
YOUR_TYPE : T_OEXT_SHARED([basetype=classname], [nocast=1]): See T_OPTR_SHARED

HOW TO

CREATE AN XS CLASS HOLDING C++ CLASS OR C STRUCTURE

Here and below by 'XS CLASS' i mean not just XS code with functions, i mean class, objects of which hold a C struct or class.

Create your TYPE in typemap using one of existing typemap classes.

Either classic pointer-based object

MyClass* T_OPTR

or more flexible "attached pointer" object

MyClass* T_OEXT

Use your type in XS code

MyClass*
MyClass::new ()
CODE:
    RETVAL = new MyClass();
OUTPUT:
    RETVAL

void
MyClass::somefunc ()
PPCODE:
    THIS->somefunc(); // THIS is a variable of type MyClass*
    ...

void
MyClass::DESTROY ()

Use your XS class from perl

my $obj = new MyClass();
$obj->somefunc();

Note how your object looks like inside with T_OPTR

DB<2> x $obj
  0  MyClass=SCALAR(0x8179dc4e0)
     -> 34732484608

or with T_OEXT

DB<5> x $obj
  0  MyClass=SCALAR(0x8179e16a8)
     -> undef

CREATE AN EXTENDABLE XS CLASS HOLDING C++ CLASS OR C STRUCTURE

'Extendable' means that we can create child class in perl and hold additional data in $self as it was a regular perl object. It's impossible to implement that using T_OPTR as it makes perl object not applicable for holding anything but C pointer. To do this, we must use T_OEXT typemap class. By default, T_OEXT creates reference to undef as an object base. Most of the time we want it to be a hash reference. There are 2 ways we can achieve that - either use T_OEXT_HV as typemap class (it creates RV to HV as an object base instead of RV to undef) or upgrade already created object to RV/HV from perl.

Solution with T_OEXT_HV

In typemap change T_OEXT to T_OEXT_HV:

MyClass* T_OEXT_HV

That's all! Lets see the results

DB<6> x new MyClass()
  0  MyClass=HASH(0x81794bf48)
       empty hash

Solution with object upgrading

Lets do the upgrade in child class.

package MyClassChild;
use parent 'MyClass';

sub new {
    my $self = shift->SUPER::new(@_);
    Panda::XS::obj2hv($self);
    return $self;
}

Lets see the results

DB<5> x new MyClass()
  0  MyClass=SCALAR(0x81794bd80)
     -> undef
DB<6> x new MyClassChild()
  0  MyClassChild=HASH(0x81794a318)
       empty hash

CREATE XS CLASS HIERARCHY THAT CORRESPONDS TO C++ CLASS HIERARCHY

Image that you need to port a C framework to perl and you want to leave it's classes structure transparent. For example, there is a C framework Foo that we need to port to perl. It has 2 classes ClassA and ClassB.

class ClassA {
private:
    int _propA;
public:
    ClassA (int propA = 0) : _propA(propA) {}
    
    int  propA ()        { return _propA; }
    void propA (int val) { _propA = val; }
    
    virtual ClassA* clone () { return new ClassA(_propA); }
}

class ClassB : public ClassA {
private:
    int _propB;
public:
    ClassB (int propA = 0, int propB = 0) : ClassA(propA), _propB(propB) {}

    int  propB ()        { return _propB; }
    void propB (int val) { _propB = val; }

    ClassB* clone () { return new ClassB(_propA, _propB); }
}

We want to create 2 perl classes - Foo::A which holds C ClassA class and Foo::B which holds C ClassB class. Of course Foo::B should inherit from Foo::A. What do we have to do? Almost nothing!

At first, create a custom typemap class for ClassA/ClassB hierarchy, inherit it from T_OEXT and set parameter basetype to the most parent class which will be visible in perl. In our case it is ClassA (visible via Foo::A).

ClassA* T_FOO
ClassB* T_FOO

OUTPUT
T_FOO : T_OEXT(basetype=ClassA*)
INPUT
T_FOO : T_OEXT(basetype=ClassA*)

Remember that basetype is required in case of C++ inheritance, otherwise you won't be able to call Foo::A methods on a Foo::B object.

Then lets create an XS code.

Foo.xs (Here and after we use extended Panda::Install XS syntax to make XS functions look like C functions)

MODULE = Foo                PACKAGE = Foo::A
PROTOTYPES: DISABLE

ClassA* ClassA::new (int propA) {
    RETVAL = new ClassA(propA);
}

int ClassA::propA (SV* newval = NULL) { // 'THIS' is a ClassA* pointer, even if real perl object is of Foo::B class.
    if (newval) THIS->propA(SvIV(newval));
    RETVAL = THIS->propA();
}

ClassA* ClassA::clone () {
    HV* CLASS = SvSTASH(SvRV(ST(0)));
    RETVAL = THIS->clone();
}

void ClassA::DESTROY ()

MODULE = Foo                PACKAGE = Foo::B
PROTOTYPES: DISABLE

ClassB* ClassB::new (int propA, int propB) {
    RETVAL = new ClassB(propA, propB);
}

int ClassB::propB (SV* newval = NULL) { // 'THIS' is a ClassB* pointer
    if (newval) THIS->propB(SvIV(newval));
    RETVAL = THIS->propB();
}

Somewhere in Perl

my $a = new Foo::A(123);
say $a->propA;
$a->propA(321);
say ref $a->clone; # Foo::A

my $b = new Foo::B(1,2);
say $b->propA;
say $b->propB;
say ref $b->clone; # Foo::B

Using these technics you can port any C++ framework saving its original OOP structure, keeping your XS wrapper as thin as possible and therefore get maximum perfomance.

PASSING C CLASSES/STRUCTURES AS A PARAMETERS TO FUNCTIONS OF OTHER CLASSES.

It works out of the box. Lets add a third class to previous example, ClassC:

class ClassC {
public:
    ClassC () {}
    
    int calculate (ClassA* arg) { return arg->propA * arg->propA; }
}

Add it to a typemap

ClassC* T_OEXT

Add XS for ClassC

MODULE = Foo                PACKAGE = Foo::C
PROTOTYPES: DISABLE

ClassC* ClassC::new ()

int ClassC::calculate (ClassA* arg)

void ClassC::DESTROY ()

Just do it in perl as you would in C++, typemaps will do all the work for you

my $a = new Foo::A(10);
my $b = new Foo::B(20, 30);
my $c = new Foo::C;
say $c->calculate($a); # 100;
say $c->calculate($b); # 400;

Remember, everywhere you pass/receive Foo::A, Foo::B etc, in XS you receive/return ClassA*, ClassB*, etc

INHERITING XS CLASS FROM ANOTHER WITH DIFFERENT UNDERLYING DATA.

Sometimes source code of parent class is unavailable, and therefore you can't make a C++ child class as described above. However you can still provide such inheritance on perl level. All you need to do is to call SUPER in constructor.

Suppose we have two C++ classes Bow and Milk. And we already have an XS class for Bow. We want to implement XS for Milk and inherit it from Bow. As want 2 different C data pointers in one perl object, we should either not provide a basetype parameter in typemap, or set it to something different from Bow*. By default (if not provided), basetype is set to the value of final type name. However we need to call SUPER::new, and attach our data to existing SV, rather than creating new one (otherwise Bow's data would be lost). To do this, set 'self' variable to SV object to attach to. Unfortunately, as of current perl (5.21.5), it's impossible to call SUPER/next from XS. To call SUPER/next, use the API provided by Panda::XS C++ interface - call_super.

Typemap:

Bow*  T_OEXT
Milk* T_OEXT

Milk.pm:

package Foo::Milk;
use parent 'Some::Bow';

XS:

MODULE = Foo                PACKAGE = Foo::Milk
PROTOTYPES: DISABLE

Milk* Milk::new (...) {
    self = xs::call_super(cv, &ST(0), items);
    RETVAL = new Milk();
}

void Milk::something () {
    // 'THIS' is a Milk* pointer
}

Milk* Milk::clone () { // cloning just Milk* without Bow* does NOT make sense. So we must call SUPER::clone
    HV* CLASS = SvSTASH(SvRV(ST(0)));
    self = xs::call_super(cv, &ST(0), items);
    RETVAL = THIS->clone();
} // new Foo::Milk object returned containing cloned Milk* and Bow* classes.

void Milk::DESTROY () {
    xs::call_super(cv, &ST(0), items, G_DISCARD);
    delete THIS;
}

CREATE AN XS CLASS WHICH IS SUITABLE FOR MULTIPLE IHERITANCE / C3 CLASS MIXIN

All you need to do is to call next::method or maybe::next::method from your construtor. To do this, use call_next_method() or call_next_maybe() from xs:: namespace.

Typemap:

MyPlugin*  T_OEXT

Perl:

package Foo::MyPlugin;
use mro 'c3';

XS:

MODULE = Foo                PACKAGE = Foo::MyPlugin
PROTOTYPES: DISABLE

MyPlugin* MyPlugin::new (...) {
    self = xs::call_next_maybe(cv, &ST(0), items);
    RETVAL = new MyPlugin();
}

uint32_t MyPlugin::something () {
    // 'THIS' is a MyPlugin* pointer
    RETVAL = THIS->something;
}

MyPlugin* MyPlugin::clone () {
    HV* CLASS = SvSTASH(SvRV(ST(0)));
    self = xs::call_next_maybe(cv, &ST(0), items);
    RETVAL = THIS->clone();
} // new Foo::MyPlugin object returned containing cloned MyPlugin* and all data of other classes

void MyPlugin::DESTROY () {
    xs::call_next_maybe(cv, &ST(0), items, G_DISCARD);
    delete THIS;
}

Perl:

package MyServer;
use parent qw/Foo::MyPlugin Foo::Milk/;

my $obj = new MyServer();

CREATE AN XS CLASS HOLDING C++ CLASS AND ADDITIONAL C INFO

Sometimes you need to hold additional info in XS class, but you can't or don't want to create additional fields in your C++ class. Let's see an example. Assume we have a 'Driver' C++ class that we want to port. We'll make Foo::Driver perl class.

#TYPEMAP
Driver* T_OEXT

#XS

Driver* Driver::new (int arg1, char* arg2) {
    RETVAL = new Driver(arg1, arg2);
}

int Driver::category () {
    RETVAL = THIS->category;
}

char* Driver::name () {
    RETVAL = THIS->name;
}

void Driver::ban (int why) {
    THIS->ban(why);
}

HV* Driver::get_history () {
    DriverHistory* history = THIS->get_history();
    RETVAL = newHV();
    // fill RETVAL with data from DriverHistory*
}

void
Driver::DESTROY ()

Now imagine that we want to count, how many times a driver has been banned for particular object. But Driver class doesn't have any field to hold this value. Adding it to Driver, even if you can, would be a bad decision as it shouldn't know anything about your XS class behaviour. Also filling up HV every time 'get_history' is called, could be quite expensive, so that we also would like to cache once built result somewhere. How to do that?

Solution 1: create Driver's child class.

class DriverXS : public Driver {
    public:
    
    int counter;
    HV* cached_history;
    
    DriverXS (int arg1, char* arg2) : counter(0), cached_history(NULL), Driver(arg1, arg2) {}
    
    ~DriverXS () {
        SvREFCNT_dec(cached_history);
    }
}

Now use your child class instead of Driver

#TYPEMAP
DriverXS* T_OEXT

#XS

DriverXS* DriverXS::new (int arg1, char* arg2) {
    RETVAL = new DriverXS(arg1, arg2);
}

int DriverXS::category () {
    RETVAL = THIS->category;
}

char* DriverXS::name () {
    RETVAL = THIS->name;
}

void DriverXS::ban (int why) {
    THIS->counter++;
    THIS->ban(why);
}

HV* DriverXS::get_history () {
    if (!THIS->cached_history) {
        DriverHistory* history = THIS->get_history();
        THIS->cached_history = newHV();
        // fill cached_history with data from DriverHistory*
    }
    RETVAL = THIS->cached_history;
}

void
DriverXS::DESTROY ()

Although this will work out for our case, this approach may be unacceptable. For example imagine we have DriverStorage in C++ lib and class method get_driver_by_id. How can we port it? Lets create XS class Foo::DriverStorage. And method get_driver_by_id:

DriverXS* DriverStorage::get_driver_by_id (int id) {
    RETVAL = THIS->get_driver_by_id(id);
}

But wait a minute, our c++ lib's get_driver_by_id returns Driver* of course, as it doesn't know anything about DriverXS. And even if we stored only DriverXS* objects in DriverStorage, some C++ code might have created a simple Driver* object and store it in DriverStorage. So the example above won't even compile. The only way is to create a copy DriverXS* from Driver*.

DriverXS* DriverStorage::get_driver_by_id (int id) {
    Driver* driver = THIS->get_driver_by_id(id);
    if (!driver) XSRETURN_UNDEF;
    RETVAL = new DriverXS(driver->category, driver->name); // or new DriverXS(driver) if have such constructor
}

But it might be expensive and not every object can be copied (for example, socket handle classes).

Solution 2: create a wrapper, and wrap Driver objects into it.

class DriverXS {
    public:
    
    Driver* obj;
    int counter;
    HV* cached_history;
    
    DriverXS (Driver* driver) : counter(0), cached_history(NULL), obj(driver) {}
    
    ~DriverXS () {
        SvREFCNT_dec(cached_history);
        delete obj;
    }
}

#TYPEMAP
DriverXS* T_OEXT

#XS
DriverXS* DriverXS::new (int arg1, char* arg2) {
    RETVAL = new DriverXS(new Driver(arg1, arg2));
}

int DriverXS::category () {
    RETVAL = THIS->obj->category;
}

char* DriverXS::name () {
    RETVAL = THIS->obj->name;
}

void DriverXS::ban (int why) {
    THIS->counter++;
    THIS->obj->ban(why);
}

HV* DriverXS::get_history () {
    if (!THIS->cached_history) {
        DriverHistory* history = THIS->obj->get_history();
        THIS->cached_history = newHV();
        // fill cached_history with data from DriverHistory*
    }
    RETVAL = THIS->cached_history;
}

void
DriverXS::DESTROY ()

...
DriverXS* DriverStorage::get_driver_by_id (int id) {
    Driver* driver = THIS->get_driver_by_id(id);
    if (!driver) XSRETURN_UNDEF;
    RETVAL = new DriverXS(driver);
}

This approach is much more flexible as it allows you to return perl objects even for c++ objects who wasn't created in XS class. But our code is not good enough for now, because it's very annoying to write THIS->obj. Moreover, if you share your module with someone, they will have to know about your wrapper to work with your XS objects. For example, image you've uploaded Foo to CPAN. Someone is using it:

write_makefile(
    ...
    DEPENDS => ['Foo'], # make C headers, and typemaps of Foo visible to my XS/C code
);

# some user's XS

void
change_drivers_name (DriverXS* driverxs, const char* newname)
PPCODE:
    Driver* driver = driverxs->obj;
    driver->set_name(newname);
    
    
# perl code
my $driver = Foo::Driver->new(1, "vasya");
Bar::change_drivers_name($driver, "petya");
say $driver->name;

No one should know the details of your XS module (about the fact that you wrap real Driver into DriverXS). To do that, we need to implement all the details in typemap, not in XS functions itself. We will need to create our own typemap class.

#TYPEMAP
DriverXS* XT_FOO_DRIVERXS
Driver*   XT_FOO_DRIVER

OUTPUT
XT_FOO_DRIVERXS : T_OEXT(basetype=DriverXS*)

XT_FOO_DRIVER : XT_FOO_DRIVERXS(nocast=1)
    $var = ($type)new DriverXS($var);
    
INPUT
XT_FOO_DRIVERXS : T_OEXT(basetype=DriverXS*)

XT_FOO_DRIVER : XT_FOO_DRIVERXS(nocast=1)
    $var = dynamic_cast<$type>(((DriverXS*)$var)->obj);

Note that dynamic_cast is not needed in this case, but it would be needed in more complex cases, for example if you had several Driver::A, Driver::B, Driver::C classes extending basic Driver, and you made corresponding XS classes Foo::Driver::A, etc, you would need this typecast to properly handle pointers.

Ok now our code looks much better:

Driver* Driver::new (int arg1, char* arg2) {
    RETVAL = new Driver(arg1, arg2);
}

int Driver::category () {
    RETVAL = THIS->category;
}

char* Driver::name () {
    RETVAL = THIS->name;
}

void DriverXS::ban (int why) {
    THIS->counter++;
    THIS->obj->ban(why);
}

HV* DriverXS::get_history () {
    if (!THIS->cached_history) {
        DriverHistory* history = THIS->obj->get_history();
        THIS->cached_history = newHV();
        // fill cached_history with data from DriverHistory*
    }
    RETVAL = THIS->cached_history;
}

void
DriverXS::DESTROY ()

...
Driver* DriverStorage::get_driver_by_id (int id) {
    RETVAL = THIS->get_driver_by_id(id);
}

Note how we use Driver:: and DriverXS:: typemaps. DriverXS is a private typemap and only needed in Driver XS class module itself, and only in functions which need those additional fields (counter and cached_history). Most of the time, Driver:: is in use. Now the implementation details are hidden from users of your module. And the third-party example above will now look much clearer:

void
change_drivers_name (Driver* driver, const char* newname)
PPCODE:
    driver->set_name(newname);

Users of your module no longer see DriverXS wrapper.

Important! In such cases destructor (DESTROY) MUST always be defined for DriverXS:: typemap. If you define it for Driver:: typemap

void
Driver::DESTROY ()

only Driver* object will be destroyed, leaving DriverXS* object inaccessible.

REFERENCE COUNTING PROBLEM

While you only have single XS classes without any relationships with each other, everything's ok. Problems begin in the following example (we use simple (without wrapper) Driver* class and XS from previous examples):

class Insurance {
    private:
    Driver* _first_driver;
    Driver* _second_driver;
    
    public:
    Insurance () {
        _first_driver = new Driver(1, "john");
        _second_driver = new Driver(2, "mike");
    }
    
    Driver* first_driver  ()            { return _first_driver; }
    Driver* second_driver ()            { return _second_driver; }
    void    first_driver  (Driver* val) { _first_driver = val; }
    void    second_driver (Driver* val) { _second_driver = val; }
    
    ~Insurance () {
        delete _first_driver;
        delete _second_driver;
    }
}

#XS

Insurance* Insurance::new () {
    RETVAL = new Insurance();
}

Driver* Insurance::first_driver (Driver* newval = NULL) : ALIAS(second_driver=1) {
    if (newval) {
        if (ix == 0) THIS->first_driver(newval);
        else         THIS->second_driver(newval);
        XSRETURN_UNDEF;
    }
    if (ix == 0) RETVAL = THIS->first_driver();
    else         RETVAL = THIS->second_driver();
}

void Insurance::DESTROY ()

So where is the problem? Right here:

#perl code
my $insurance = new Foo::Insurance;
say $insurance->first_driver->name; # prints "john"
say $insurance->first_driver->name; # OOPS. core dump or undefined behaviour

When first_driver() is called for the first time, it creates perl object and attaches Driver* object to it. After first say(), the temporary perl variable holding Driver perl object no longer needed and destroyed. Destructor (DESTROY) of Driver's XS class destroys Driver* object as well. Pointer to that freed object still remains in Insurance* object and bad things happen. Ok, lets stop deleting Driver* object from Driver::DESTROY(), i.e. remove this function:

void
Driver::DESTROY ()

In this case we get a memory leak for this type of code:

for (1..1000) {
    my $driver = new Foo::Driver(1, "myname");
}

How can we avoid deletion in first case and memory leak in second?

We need to add a reference counter to our objects!

class Driver {
    private:
    mutable int _refcnt;
    ....
    Driver (...) : _refcnt(0) ... { ... }
    void retain () const { _refcnt++; }
    void release  () const { if (--_refcnt <= 0) delete this; }
    virtual ~Driver () {...}
}

class Insurance {
    ...
    void first_driver  (Driver* val) {
        if (_first_driver) _first_driver->release();
        _first_driver = val;
        if (_first_driver) _first_driver->retain();
    }
}

#XS

Driver* Driver::new (...) {
    RETVAL = new Driver(...);
    RETVAL->retain();
    ...
}

void Driver::DESTROY () {
    THIS->release();
}

Driver* Insurance::first_driver (Driver* newval = NULL) : ALIAS(second_driver=1) {
    ...
    if (ix == 0) RETVAL = THIS->first_driver();
    else         RETVAL = THIS->second_driver();
    if (RETVAL) RETVAL->retain();
}

We can implement it in typemap to hide these details from XS code.

#TYPEMAP
Driver* XT_FOO_DRIVER

OUTPUT

XT_FOO_DRIVER : T_OEXT
    $var->retain();
    
INPUT

XT_FOO_DRIVER : T_OEXT

#XS

Driver* Driver::new (...) {
    RETVAL = new Driver(...);
    ...
}

void Driver::DESTROY () {
    THIS->release();
}

Driver* Insurance::first_driver (Driver* newval = NULL) : ALIAS(second_driver=1) {
    ...
    if (ix == 0) RETVAL = THIS->first_driver();
    else         RETVAL = THIS->second_driver();
}

Note, however, that you need to retain() and release() objects in C++ classes code itself properly as in any other refcounted system.

See T_OEXT_REFCNT/T_OPTR_REFCNT typemap class which does retain() / release() automatically and a base C++ class 'panda::RefCounted'.

USING SHARED POINTERS

The second solution of the problem above is shared pointers. It allows you to solve this problem even if you can't change sources of C++ classes.

You can use either STL's std::shared_ptr or compiler-independent panda::shared_ptr which has the same API.

To use shared pointers, just map your shared pointer class to T_OEXT_SHARED or T_OPTR_SHARED.

typedef shared_ptr<Driver> DriverSP;

#typemap
DriverSP T_OEXT_SHARED

#code

class Driver { // we don't need to add anything
    private:
    Driver (...) : ... { ... }
    virtual ~Driver () {...}
}

class Insurance {
    private:
    DriverSP _first_driver;
    public:
    DriverSP first_driver () {
        return _first_driver;
    }
    void first_driver (DriverSP driver) {
        _first_driver = driver;
    }
}

#XS

DriverSP new (SV* CLASS, ...) {
    RETVAL = DriverSP(new Driver(...));
    ...
}

void DESTROY (DriverSP THIS)

...

DriverSP Insurance::first_driver (DriverSP newval = DriverSP()) : ALIAS(second_driver=1) {
    ...
    if (ix == 0) RETVAL = THIS->first_driver();
    else         RETVAL = THIS->second_driver();
}

Using shared pointers introduces slight overheat, as it have to alloc additional memory per object. However, see next paragraph to find out how you can remove this overheat while still using shared pointers.

USING panda::shared_ptr<> FOR CLASSES WHICH INHERIT FROM panda::RefCounted

If you decided to use panda::shared_ptr instead of std::shared_ptr, you can get some benefit if you inherit your class from panda::RefCounted. panda::shared_ptr automatically detects classes which inherit from RefCounted and works differently.

Firstly, it doesn't malloc anything, as your class already has a refcounter. It just calls ->retain and ->release.

Secondly, as you know, creating second std::shared_ptr for an object is a critical mistake. However, for panda::shared_ptr+RefCounted it isn't true. You can freely create second, third, etc shared_ptr for any object without losing reference counter.

Thirdly, sizeof(panda::shared_ptr<MyRefCountedChild>) is just one pointer.

That means you can freely interchange T_OEXT/T_OPTR with T_OEXT_SHARED/T_OPTR_SHARED as it will automatically convert from MyClass* to MyClassSP and vice verca.

For example:

typedef shared_ptr<Driver> DriverSP;

#typemap
Driver*  T_OEXT_REFCNT
DriverSP T_OEXT_SHARED

#code

class Driver : public panda::RefCounted {
    private:
    Driver (...) : ... { ... }
    virtual ~Driver () {...}
}

class Insurance {
    private:
    DriverSP _first_driver;
    public:
    DriverSP first_driver () {
        return _first_driver;
    }
    void first_driver (DriverSP driver) {
        _first_driver = driver;
    }
}

#XS

Driver* Driver::new (...) {
    RETVAL = new Driver(...);
    ...
}

void Driver::DESTROY ()

...

# See how we receive DriverSP, while Driver object is T_OEXT_REFCNT (i.e. Driver*)
# It would be a fatal logical error doing this for non-RefCounted classes.
DriverSP Insurance::first_driver (DriverSP newval = DriverSP()) : ALIAS(second_driver=1) {
    ...
    if (ix == 0) RETVAL = THIS->first_driver();
    else         RETVAL = THIS->second_driver();
}

Moreover you don't need to bind your class to T_OEXT_SHARED/T_OPTR_SHARED at all, just leave it as T_OEXT_REFCNT/T_OPTR_REFCNT as it would automatically convert it to and from shared pointer.

And manly remember, do all of the above in this paragraph ONLY if your class subclasses panda::RefCounted.

C++ CLASSES

panda::RefCounted

A base class for refcounting.

SYNOPSIS

#include <panda/refcnt.h>

class MyClass : public RefCounted { ... }

MyClass* obj = new MyClass(...);
obj->retain();
obj->release();
shared_ptr<MyClass> myobj(obj);

[protected] RefCounted ()

Initializes object with refcnt = 0. You will need to call retain() if you want to hold this object. Call release() if you don't need it anymore.

void retain () const

Increments refcounter.

void release () const

Decrements refcounter and deletes the object if refcounter <= 0.

int32_t refcnt () const

Returns refcount.

template <class T> panda::shared_ptr<T>

API is the same as for std::shared_ptr.

C FUNCTIONS

All functions and types are in 'xs' namespace so that you will actually need C++ to use them.

Functions marked with [pTHX] must receive aTHX as a first arg.

panda::dynamic_pointer_cast/const_pointer_cast/static_pointer_cast

The same as std::*_pointer_cast for panda::shared_ptr and std::shared_ptr.

PAYLOAD FUNCTIONS

void sv_payload_attach (SV* sv, void* ptr, const payload_marker_t* marker = NULL) [pTHX]

Attach payload ptr to sv. Markers allow you to store multiple payloads in a single SV. Marker doesn't need to be initialized somehow, its just a valid memory pointer. Usually its a static global variable. If no marker provided, default one is used (global to the whole program).

bool sv_payload_exists (const SV* sv, const payload_marker_t* marker = NULL) [pTHX]

Returns true if sv has any payload for marker.

void* sv_payload (const SV* sv, const payload_marker_t* marker = NULL) [pTHX]

Returns payload attached to sv.

int sv_payload_detach (SV* sv, const payload_marker_t* marker = NULL) [pTHX]

Removes payload from sv and returns number of payloads removed.

void rv_payload_attach (const SV* rv, void* ptr, const payload_marker_t* marker = NULL) [pTHX]

bool rv_payload_exists (const SV* rv, const payload_marker_t* marker = NULL) [pTHX]

void* rv_payload (const SV* rv, const payload_marker_t* marker = NULL) [pTHX]

int rv_payload_detach (const SV* rv, const payload_marker_t* marker = NULL) [pTHX]

Same as sv_* but operates on sv referenced by a given rv. Doesn't check if a given RV is valid.

payload_marker_t* sv_payload_marker (const char* key, on_svdup_t svdup_callback = NULL)

Returns a marker for specified key. If no marker exists for that key, creates and returns it. In most cases you should put the result into a static variable to prevent calling this function many times.

svdup_callback is a callback to run on threaded perls when a thread is created. Called for each object and receives magic struct attach to an object with current marker. Return value is ignored. Used to clone or do something other with payload attached to this magic. Note that you don't need to clone SV* payload, as threaded perl duplicates it by itself.

typedef int (*on_svdup_t) (pTHX_ MAGIC* mg, CLONE_PARAMS* param);

template <class T> payload_marker_t SVPayloadMarker::marker

Marker for particular class. In contrast to sv_payload_marker function, no code is executed, so you dont have to save it to a static variable. Used internally by T_OEXT typemap class.

Note that marker SVPayloadMarker<MyClass*::marker> is NOT the same marker as sv_payload_marker("MyClass*").

template <class T> payload_marker_t* SVPayloadMarker::get(on_svdup_t svdup_callback)

Returns the same marker as &SVPayloadMarker<T::marker>, but before returning, sets svdup_callback as "duplication" callback for threaded perls.

SUPER/NEXT METHOD FUNCTIONS

SV* call_super (CV* cv, SV** args, I32 items, I32 flags = 0) [pTHX]

Calls super method from inside XS method. 'cv' is a pointer to currently running XS function (every XS function has this variable). 'args' and 'items' describes perl variables to pass to super method. If you want to passthrough all the arguments your XS function received, pass '&ST(0)' and 'items'. 'flags' is passed to Perl's API call_method / call_sv as is. SUPER is always called in SCALAR context. Returned SV* has its refcounter increased. If you don't need it, decrement it. If you don't need return value at all, pass G_DISCARD in flags.

SV* call_next_method (CV* cv, SV** args, I32 items, I32 flags = 0) [pTHX]

Calls next method (C3 MRO). See "call_super" for argument details.

SV* call_next_maybe (CV* cv, SV** args, I32 items, I32 flags = 0) [pTHX]

Calls next method (C3 MRO). Return undef if no next method. See "call_super" for argument details.

SV* call_next (CV* cv, SV** args, I32 items, next_t type, I32 flags = 0) [pTHX]

Generic form of call_super/call_next_method/call_next_maybe. 'type' is either xs::NEXT_SUPER or xs::NEXT_METHOD or xs::NEXT_MAYBE.

C MACROS

XS_HV_ITER(hv,code)

Iterates through perl hash very fast. On each iteration executes code, current hash entry is accessible via HE* he variable. Use perl API's HeVAL, HeKEY, HeKLEN to extract value and key from hash entry.

hv must be a non-null HV* variable. Doesn't handle tied hashes.

XS_HV_ITER_NU(hv,code)

Same as XS_HV_ITER but skips entries whose values are undefs. _NU stands for 'not undef'.

XS_AV_ITER(av,code)

Iterates through perl array very fast. On each iteration executes code, current array element is accessible via SV* elem variable. Keep in mind that it might be a NULL pointer in case if current slot in array is empty.

For example, in this case

my @arr;
$arr[1] = undef;
$arr[3] = 10;

slots 0 and 2 are empty. Slot 1 is not empty but it's value is undefined. Don't confuse empty slot with undefined values, empty slot is an absence of SV* variable, while undefined value is a legal SV* variable for which SvOK(elem) returns false.

av must be a non-null AV* variable. Doesn't handle tied arrays.

XS_AV_ITER_NE(av,code)

Same as XS_AV_ITER but skips empty slots. _NE stands for 'not empty'.

XS_AV_ITER_NU(av,code)

Same as XS_AV_ITER but skips empty slots and undefined emelents. _NU stands for 'not undef'.

PERL FUNCTIONS

obj2hv ($obj)

obj2av ($obj)

Upgrades $obj to HASHREF or ARRAYREF.

$obj must be a valid reference to something lower than array or hash (undef, number, string, etc). Otherwise will croak. If $obj is already of desired type, nothing is done.

sv_payload_attach ($target, $payload)

Attach $payload to $target. $target can be any l-value scalar. If $target has any $payload, it gets removed.

sv_payload ($target)

Returns payload attached to $target if any, otherwise undef.

sv_payload_exists ($target)

Returns true if $target has any payload.

sv_payload_detach ($target)

Removes payload from $target. Returns true if any payload has been removed.

rv_payload_attach ($target, $payload)

rv_payload ($target)

rv_payload_exists ($target)

rv_payload_detach ($target)

Same as sv_* but $target must be reference to perl object.

any_payload_attach ($target, $payload)

any_payload ($target)

any_payload_exists ($target)

any_payload_detach ($target)

Same as sv_* or rv_*, but if $target is ref then payload will be attached/detached from referenced object, otherwise from $target itself.

THREADED PERLS SUPPORT

HOOKING THREAD CREATION FOR XS OBJECTS

If you don't do anything special, on threaded perls after thread creation you will most likely core dump. The reason is that when perl creates a thread it duplicates all perl variables available in current interpreter. So that you will likely get 2 perl variables holding a pointer to the case C/C++ object (refcnt won't help - nobody calls retain()). When these objects are destroyed, double delete might occur on the same C object. That's bad.

You have 4 options to handle that:

Don't support thread creation (however don't core dump).

To do this, just add CLONE_SKIP method to your class and return a true value from it. In this case perl won't clone SV variable holding your object - it will place an unblessed reference to undef instead. Of course users must know about this behaviour, because they won't be able to use objects of your class created before new thread. However they can still create new objects from new thread and everything will be ok.

This is the only way for you if you use T_OPTR. T_OEXT doesn't have this limitation.

Support thread creation by cloning your C++ object (for example, if it's thread-unsafe or doesn't have a refcounter)

To do this, don't define CLONE_SKIP method, instead set on_svdup parameter of T_OEXT class to '@clone'. In this case when a thread creates, method clone() will be called on your C++ object and this new object is stored in duplicated variable. Of course you must have a clone() method with no args in your class. It must be virtual if you support inheritance. For example:

T_MYCLASS : T_OEXT(basetype=MyClass*, on_svdup=@clone)

Support thread creation by incrementing refcnt on your C++ object (for thread-safe objects with refcounters).

To do this, don't define CLONE_SKIP method, instead set on_svdup parameter of T_OEXT class to '@retain'. In this case when a thread creates, method retain() will be called on your C++ object and the same object is stored in duplicated variable. Of course you must have a retain() method with no args in your class (if you subclass panda::RefCounted, you do).

For example:

T_MYCLASS : T_OEXT(basetype=MyClass*, on_svdup=@retain)

Implement custom logic

To do this, don't define CLONE_SKIP method, instead set on_svdup parameter of T_OEXT class to the name of your callback which will handle thread creation for objects of your class. Callback must have the following signature:

<basetype> <callbackname> (pTHX_ <basetype> arg);

Callback will be passed current C object. Callback shall return a C object to be set to the duplicated perl variable (it may be a new one or the same object). Keep in mind that if your module shares API for other modules, this callback MUST be externally visible, because when someone uses your class as a return type from XS functions, typemap will insert code, containing your callback name into those XS functions. Don't forget to specify it with full qualified name for the same reason. Example:

# in .h
namespace my {
    MyClass* myclass_onsvdup (pTHX_ MyClass* old);
}
# in .cc
MyClass* my::myclass_onsvdup (pTHX_ MyClass* old) {
    return new MyClass(old->data);
}

# in typemap
T_MYCLASS : T_OEXT(basetype=MyClass*, on_svdup=my::myclass_onsvdup)

aTHX/pTHX politics and helpers

Perls has 2 options for XS when working on threaded perls:

1) Not defining PERL_NO_GET_CONTEXT. Advantage is that you don't have to put pTHX to every function's signature and don't have to pass it to every function which works with perl variables. Disadvatage is - decreased performance on threaded perls.

2) Defining PERL_NO_GET_CONTEXT.

Unfortunatelly, as Panda::Install/Panda::XS concept is all about sharing C code, modules that use Panda::XS cannot have different PERL_NO_GET_CONTEXT state. Because in that case, binary incompability between function signatures would accure.

Panda::XS strictly sets PERL_NO_GET_CONTEXT options, so that you have generally to accept pTHX and pass aTHX to all functions that work with perl variables. In this case you'll achieve maximum performance on threaded perls.

However if you don't want to write pTHX/aTHX every time, you can write

dTHX;

at the top of those functions and actually saying revert to behaviour without PERL_NO_GET_CONTEXT (but you still need to pass aTHX to functions which are defined with pTHX, unless called via macros - like perl's API).

For example, you can't receive pTHX in C++ objects destructors, so the options for you are either write dTHX; on the top of destructor or save perl interpreter object in constructor of your object to property named 'my_perl', or use using xs::my_perl global interpreter.

One more problem is static initialization, for example:

# my.h
extern SV* myname;
# my.cc
#include <my.h>
SV* myname = newSVpv("john", 0);

This won't work on threaded perls with PERL_NO_GET_CONTEXT because no one defined my_perl. You shouldn't say dTHX; in the global-scoped code. This problem can be solved using using xs::my_perl.

HELPERS

xs::my_perl

This variable holds correct perl interpreter for each thread. Just say using xs::my_perl and you'll get my_perl interpreter for the rest of your code's scope.

Keep in mind that this my_perl variable is get from thread-local storage, like dTHX, so this is actually a convenince tool, reverting to performance as PERL_NO_GET_CONTEXT has not been defined. If you want maximum performance on threaded perls, use pTHX/aTHX everywhere. You could however use mixed style, saying using xs::my_perl and passing pTHX only for performance-critical functions.

This variable should not be used on non-threaded perls (this is not a problem as aTHX is empty in that case). However it still exists on non-threaded perls, so that you can say using xs::my_perl without wrapping it into #ifdef PERL_IMPLICIT_CONTEXT.

mTHX

Another way to achieve maximum perfomance on threaded-perls for C++ objects is to hold my_perl as class variable. In this case you don't have to receive pTHX in every method of your object and don't even have to say dTHX in desctructor.

This helper defines this class member (it defines nothing on non-threaded perls). Example

class MyXSClass {
    int val;
    mTHX;
    MyXSClass (int val) : val(val) {
        aTHXa(PERL_GET_THX);
    }
    // pTHX is not needed anymore in method's definitions.
}

mTHXa(interpreter)

Sometimes you have to pass aTHX to constructors of your class members and therefore setting aTHXa in constructor's code is too late.

mTHXa(interpreter) initializes class member my_perl with value interpreter in initializer list. On threaded perls it is my_perl(interpreter),, otherwise empty. Example:

class MyXSClass {
    int val;
    MySVContainer container;
    mTHX;
    MyXSClass (int val) : val(val), mTHXa(PERL_GET_THX) container(aTHX) {
        ...
    }
}

Note that you should not write , after mTHXa. Therefore it cannot be the last on the list.

TIP

If you don't care about performance on threaded perls then the most convenient solution is using xs::my_perl on the top of the file. In this case you don't have to put pTHX in every function's definition. However you still have to pass aTHX to functions which defined with pTHX.

CAVEATS

If module A binary depends on module B and module B updates and becomes binary incompatible, undefined behaviour may happen. To solve this problem, one need to reinstall (rebuild) all modules that depend on module B. To help solving this problem, Panda::Install automatically tracks these depedencies, warns and croaks if any binary depedencies became incompatible and prints the list of modules to reinstall (rebuild).

AUTHOR

Pronin Oleg <syber@crazypanda.ru>, Crazy Panda, CP Decision LTD

LICENSE

You may distribute this code under the same terms as Perl itself.

9 POD Errors

The following errors were encountered while parsing the POD:

Around line 122: