perl - 如何在 Perl XS 中封装库句柄

Question

我想从 Perl 发送/接收 MQTT 消息。由于各种原因(MQTT 5 支持、TLS)，我不想使用现有的 Perl 库。所以我尝试创建 XS 绑定(bind)到 Paho MQTT C Library 。我以某种方式适应了provided example使用 relly basic Perl XS 将 Perl 模块链接到 Paho 库:

#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "ppport.h"

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <MQTTClient.h>
#define CLIENTID    "ExampleClientPub"
#define QOS         1
#define TIMEOUT     10000L

MODULE = paho              PACKAGE = paho         

int
mqtt_connect_and_send (server_address, username, topic, payload)
    char * server_address
    char * username
    char * topic
    char * payload
CODE:
    MQTTClient client;
    MQTTClient_connectOptions conn_opts = MQTTClient_connectOptions_initializer;
    MQTTClient_message msg = MQTTClient_message_initializer;
    MQTTClient_deliveryToken token;
    int rc;

    /* connect to server */
    MQTTClient_create(&client, server_address, CLIENTID,
        MQTTCLIENT_PERSISTENCE_NONE, NULL);
    conn_opts.keepAliveInterval = 20;
    conn_opts.cleansession = 1;
    conn_opts.username = username;

    if ((rc = MQTTClient_connect(client, &conn_opts)) != MQTTCLIENT_SUCCESS)
    {
        /* didn't connect */
        die("Failed to connect, return code %d", rc);
    }

    /* fill in message data and send it */
    msg.payload = payload;
    msg.payloadlen = strlen(payload);
    msg.qos = QOS;
    msg.retained = 0;
    MQTTClient_publishMessage(client, topic, &msg, &token);
    rc = MQTTClient_waitForCompletion(client, token, TIMEOUT);

    /* shutdown connection */
    MQTTClient_disconnect(client, 10000);
    MQTTClient_destroy(&client);

    if (rc != MQTTCLIENT_SUCCESS) {
        /* didn't send the message */
        die("Failed to send message, return code %d", rc);
    }

    RETVAL = 1;
OUTPUT:
    RETVAL

这工作正常。但现在我想将函数 mqtt_connect_and_send 拆分为 3 个函数:mqtt_connect、mqtt_send_message、mqtt_disconnect。我的问题是 - 如何做到这一点？如何在一个函数中的 XS 中创建一个句柄(在我的例子中为 client)，将其返回到 Perl 以某种方式将其存储在标量中，并在另一个 XS 函数中使用该句柄来发送更多消息？我希望能够在 Perl 中做到这一点:

my $client = paho::mqtt_connect($server_spec, $username, $password, $more_opts);
$success = paho::mqtt_send($client, $data, $message_opts);
# ... more of mqtt_send's
paho::mqtt_disconnect($server)

我尝试设置 RETVAL RETVAL = &client 或 mXPUSHu(&client) 但我没有得到任何结果。你能给我举一些如何让 client 访问 Perl 然后返回 XS 再次使用的示例吗？

谢谢。

Answer 1

下面是如何将客户端作为 Perl 对象返回的示例:

#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"       // allow the module to be built using older versions of Perl

#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <MQTTClient.h>
#define CLIENTID    "ExampleClientPub"
#define QOS         1
#define TIMEOUT     10000L

UV get_hash_uv(HV *hash, const char *key) {
#define get_hash_uv(a,b) get_hash_uv(aTHX_ a,b)
    SV * key_sv = newSVpv (key, strlen (key));
    UV value;
    if (hv_exists_ent (hash, key_sv, 0)) {
        HE *he = hv_fetch_ent (hash, key_sv, 0, 0);
        SV *val = HeVAL (he);
        STRLEN val_length;
        char * val_pv = SvPV (val, val_length);
        if (SvIOK (val)) {
            value = SvUV (val);
        }
        else {
            croak("Value of hash key '%s' is not a number", key);
        }
    }
    else {
        croak("The hash key for '%s' doesn't exist", key);
    }
    return value;
}


MODULE = Paho   PACKAGE = Paho
PROTOTYPES: DISABLE

SV *
mqtt_connect(server_address, username)
    char *server_address
    char *username
  CODE:
    int rc;
    MQTTClient client;  // void *
    MQTTClient_connectOptions conn_opts = MQTTClient_connectOptions_initializer;

    MQTTClient_create(&client, server_address, CLIENTID,
        MQTTCLIENT_PERSISTENCE_NONE, NULL);
    conn_opts.keepAliveInterval = 20;
    conn_opts.cleansession = 1;
    conn_opts.username = username;

    if ((rc = MQTTClient_connect(client, &conn_opts)) != MQTTCLIENT_SUCCESS)
    {
        MQTTClient_destroy(&client);
        croak("Failed to connect, return code %d", rc);
    }
    HV *hash = newHV();
    SV *self = newRV_noinc( (SV *)hash );
    SV *sv = newSVuv(PTR2IV(client));
    hv_store (hash, "client", strlen ("client"), sv, 0);
    RETVAL = sv_bless(self, gv_stashpv( "Paho::Client", GV_ADD ) );

  OUTPUT:
    RETVAL

MODULE = Paho  PACKAGE = Paho::Client

void
DESTROY(self)
       SV *self
   CODE:
       MQTTClient client;  // void *

       HV *hv = (HV *) SvRV(self);
       UV addr = get_hash_uv(hv, "client");
       client = (MQTTClient ) INT2PTR(SV*, addr);

       MQTTClient_destroy(&client);
       printf("Paho::Client destroy\n");

我还无法对此进行测试，因为我没有输入参数 server_address 和 username 的良好值。请提供我们可以测试的数据。