The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
 / 
XS-Framework-1.4.0
River stage two • 24 direct dependents • 29 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