/ 
XS-Framework-1.5.6
River stage two • 24 direct dependents • 30 total dependents
/ XS::Framework::Manual::recipe06

NAME

XS::Framework::Manual::recipe06 - XS::Framework advanced topic

C3 mixin introduction

Let's assume there is a Server with core functions defined in basic class.

package MyBase {
    sub new {
        my $class = shift;
        return bless {} => $class;
    };
    sub on_client {
        my ($self, $client) = @_;
        print "MyBase::on_client\n";
        if ($client->{status} eq 'authorized'){ $client->{send} = '[welcome]' }
        elsif ($client->{status} eq 'not_authorized') { $client->{send} = '[disconnect]' };
    }
}

The package is responsible for constructing object and send to client either [welcome] string upon successful login and [disconnect] upon login falure. It is desirable to have dedicated logging and authorizing components.

package MyLogger {
    use base qw/MyBase/;    # (1)

    sub new {
        my $class = shift;
        my $obj = $class->next::method(@_) // {};   # (2)
        return bless $obj => $class;
    }
    sub on_client {
        my ($self, $client) = @_;
        print "MyLogger::on_client\n";  # (3)
        print "client ", $client->{id}, ", status = ", $client->{status}, "\n";
        $self->next::method($client);   # (4)
        print "client ", $client->{id}, ", status = ", $client->{status}, "\n";
    }
}

package MyAuth {
    use base qw/MyBase/;    # (5)

    sub new {
        my $class = shift;
        my $obj = $class->next::method(@_) // {};   # (6)
        return bless $obj => $class;
    }
    sub on_client {
        my ($self, $client) = @_;
        print "MyAuth::on_client\n";    # (7)
        if ($client->{id} < 0) { $client->{status} = 'not_authorized'; }
        else { $client->{status} = 'authorized'; }
        $self->next::method($client);   # (8)
    }
};

MyBase class is used as interface; I have to define it's interface method (on_client in our case), which might be empty. The MyLogger and MyAuth are designed as plugins, which might intercept/proxy method of base class. To be sure that some basic implementation is still exist beyond them, they do inrerit from MyBase (1), (5).

As with classical inheritance in Perl, the code should be aware of derived classes in (2) and (6), but as the subroutines do nothing here they can be omitted. The lines (3), (4), (7) are inserted for trace purposes.

There might be different policies how to forward to next method: in MyLogger it mimics around like in Class::Method::Modifiers, but it is possible to have before and after.

The real magic happens in next::method (4) and (8): the plugins forwards call either to base class MyBase or to next plugin. This is not known at the place of invocation and it is defined at place, where plug-ins are inherited, i.e. in the gather point:

package MyXServer {
    use base qw/MyLogger MyAuth MyBase/;    # (9)
    sub new {
        my $class = shift;
        my $obj = $class->next::method(@_) // {};
        return bless $obj => $class;
    }
};

In (9) it is said that MyLogger plugin's interceptors are executed first, then MyAuth interceptors are executed, and only then the generic (may be empty) methods of MyBase will be executed. C3/mro resolves multiple inheritance problem, i.e. linearizes inheritance tree from most specific (child) to the most generic (parent) classes.

The sample code

my $client = {status => 'connected', id => 10};
my $server = MyXServer->new;
$server->on_client($client);

will output

MyLogger::on_client
client 10, status = connected
MyAuth::on_client
MyBase::on_client
client 10, status = authorized

i.e. it works as expected.

C3 mixin using XS::Framework

Let's have this mixin logic in XS. The underlying idea is to have independent C++ classes, which have very fast implementation, which will be bound into XS-hierarchy. It is important to note, that C++ classes do not form hierarchy - it is created only on XS level.

Let's suppose that there are the following C++ classes:

enum class Status07 { CONNECTED = 1, AUTHORIZED = 2, NOT_AUTHORIZED = 3, DISCONNECTED = 4 };

struct Client07 {
    int id;
    Status07 status;

    Client07 (int id_): id{id_}, status{Status07::CONNECTED } {}
    void disconnect() {
        std::cout << "disconnecting " << id << "\n";
        status = Status07::DISCONNECTED;
    }
    void welcome() {
        std::cout << "[sending] welcome dear client " << id << "\n";
    }
};

struct ServerBase07 {
    void on_client(Client07* c) {
        if (c->status == Status07::AUTHORIZED) c->welcome();
        if (c->status == Status07::NOT_AUTHORIZED) c->disconnect();
    }
};

struct LoggerPlugin07 {
    void on_client(Client07* c) { std::cout << "client " << c->id << ", status: "  << (int) c->status << "\n"; }
};

struct AuthorizerPlugin07 {
    void on_client(Client07* c) {
        c->status = (c->id < 0) ? Status07::NOT_AUTHORIZED : Status07::AUTHORIZED;
    }
};

The typemaps for them will be rather trivial:

namespace xs {
    template <>
    struct Typemap<Client07*> : TypemapObject<Client07*, Client07*, ObjectTypePtr, ObjectStorageMG> {
        static std::string package () { return "MyTest::Cookbook::Client07"; }
    };

    template <>
    struct Typemap<ServerBase07*> : TypemapObject<ServerBase07*, ServerBase07*, ObjectTypePtr, ObjectStorageMG> {
        static std::string package () { return "MyTest::Cookbook::ServerBase07"; }
    };

    template <>
    struct Typemap<LoggerPlugin07*> : TypemapObject<LoggerPlugin07*, LoggerPlugin07*, ObjectTypePtr, ObjectStorageMG> {
        static std::string package () { return "MyTest::Cookbook::LoggerPlugin07"; }
    };

    template <>
    struct Typemap<AuthorizerPlugin07*> : TypemapObject<AuthorizerPlugin07*, AuthorizerPlugin07*, ObjectTypePtr, ObjectStorageMG> {
        static std::string package () { return "MyTest::Cookbook::AuthorizerPlugin07"; }
    };
}

The only moment worth noting is that storage policy should be ObjectStorageMG. This is needed for the XS-adapters, described below, to allow more than one pointer for C++ class be stored (associated) with the same Perl SV*.

MODULE = MyTest                PACKAGE = MyTest::Cookbook::Client07
PROTOTYPES: DISABLE

void Client07::disconnect()

void Client07::welcome()

Client07* Client07::new(int id)


MODULE = MyTest                PACKAGE = MyTest::Cookbook::ServerBase07
PROTOTYPES: DISABLE

void ServerBase07::on_client(Client07* c)

ServerBase07* ServerBase07::new()

The xs-adapter for Client07 is shown here only for completeness; the ServerBase07 xs-adapter just proxies on_client call to C++ class, so no any special handling is needed here.

With the mixins/plugins the xs-adapter code is slightly different:

MODULE = MyTest                PACKAGE = MyTest::Cookbook::LoggerPlugin07
PROTOTYPES: DISABLE

void LoggerPlugin07::on_client(Client07* c) {
    THIS->on_client(c);         // (10)
    Object(ST(0)).call_next(cv, &ST(1), items-1);   // (11)
    THIS->on_client(c);     // (12)
}

LoggerPlugin07* LoggerPlugin07::new (...) {
    PROTO = Stash::from_name(CLASS).call_next(cv, &ST(1), items-1); // (13)
    if (!PROTO.defined()) XSRETURN_UNDEF;   // (14)
    RETVAL = new LoggerPlugin07();  // (15)
}

MODULE = MyTest                PACKAGE = MyTest::Cookbook::AuthorizerPlugin07
PROTOTYPES: DISABLE

void AuthorizerPlugin07::on_client(Client07* c) {
    THIS->on_client(c); // (16)
    Object(ST(0)).call_next(cv, &ST(1), items-1);   // (17)
}

AuthorizerPlugin07* AuthorizerPlugin07::new (...) {
    PROTO = Stash::from_name(CLASS).call_next(cv, &ST(1), items-1); // (18)
    if (!PROTO.defined()) XSRETURN_UNDEF;   // (19)
    RETVAL = new AuthorizerPlugin07();      // (20)
}

As with ServerBase07 the LoggerPlugin07 and AuthorizerPlugin07 should forward call (10), (16) to underlying C++ class to actual job. Then on_client call should be forwarded to the next implementation (11), (17); this is similar to the next::method calls in (4) and (8) in pure Perl implementation above. It actually forwards all arguments with which the xs-adapter was invoked. The line (12) is needed as we know, that client object might be changed after processing in further pipeline.

Let's explain constructor: the lines (13)..(15) and (18)..(19) are similar to the pure Perl plugins constructor (2) and (6). Do not be confused with variable name PROTO. Actually it is equal not to class name; instead it already contains blessed Perl SV* with pointer to ServerBase07 C++ class. According to TypemapObject::out mechanics, if the hint ( = PROTO in the context) parameter is blessed Perl SV*, it will return the same SV* with the additional pointer (LoggerPlugin07 or AuthorizerPlugin07 in the context) attached to it.

MODULE = MyTest                PACKAGE = MyTest::Cookbook::Server07
PROTOTYPES: DISABLE

BOOT {
    auto stash = Stash(__PACKAGE__, GV_ADD);    // (21)
    stash.inherit("MyTest::Cookbook::LoggerPlugin07");
    stash.inherit("MyTest::Cookbook::AuthorizerPlugin07");
    stash.inherit("MyTest::Cookbook::ServerBase07");
}

As in corresponding pure Perl code (9) the resulting final class just enumerates the ancestor classes in the correct order. The GV_ADD (21) is needed to register the xs-adapter class in perl interpreter to let it be known.

For the sample test code

my $client2 = MyTest::Cookbook::Client07->new(10);
my $server2 = MyTest::Cookbook::Server07->new;
$server2->on_client($client2);

the output is

client 10, status: 1
[sending] welcome dear client 10
client 10, status: 2

i.e. it works as expected.

The short summary: Perl offers powerful C3 inheritance mechanism, which is not available in C++. It is still possible to use the best from the two worlds: the flexibilty of Perl's mro-dispatching and fast C++ implementation.

SEE ALSO

Class::C3

mro