Как инкапсулировать дескриптор библиотеки в Perl XS

Я хотел отправлять/получать сообщения MQTT из Perl. По разным причинам (поддержка MQTT 5, TLS) я не хочу использовать существующие библиотеки Perl. Поэтому я попытался создать привязки XS к Paho MQTT C Library. Я каким-то образом адаптировал приведенный пример, чтобы связать модуль Perl с Библиотека Paho, использующая базовый Perl XS:

#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. И у меня вопрос - как это сделать? Как создать дескриптор (в моем случае client) в XS в одной функции, вернуть его в 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 для повторного использования?

Спасибо.


person ico    schedule 29.07.2020    source источник
comment
client имеет автоматическое хранилище (в основном, в стеке), что означает, что доступ к нему возможен только во время выполнения функции. Вам нужно будет динамически выделить его.   -  person ikegami    schedule 29.07.2020
comment
Затем вам нужно создать класс с деструктором, который может освободить динамически выделяемый клиент и вернуть экземпляр этого класса вместо самого указателя.   -  person ikegami    schedule 29.07.2020
comment
Совет: Имена модулей в нижнем регистре обычно зарезервированы для прагм.   -  person ikegami    schedule 29.07.2020
comment
Вы имеете в виду client = (MQTTClient *) malloc(sizeof(MQTTClient)); ...использование... free(client);? Деструктор: Часть Perl я понимаю. Я просто не знаю, как перевести этот client из XS в Perl. Возврат через RETVAL? Прагмы нижнего регистра: Первоначально в моем доказательстве концепции я использовал однобуквенную букву «p» в качестве имени :) Изменится в пригодной для использования версии.   -  person ico    schedule 29.07.2020
comment
@ico Как вы установили библиотеку C?   -  person Håkon Hægland    schedule 29.07.2020
comment
Какое значение вы используете для server_address ? Укажите некоторые значения, которые мы можем протестировать.   -  person Håkon Hægland    schedule 29.07.2020
comment
Установка библиотеки: Согласно их документам - я клонировал из git и maked. Затем я создал пакет для своего Slackware Linux и установил библиотеки в /usr/lib64, а заголовки в /usr/include. Простой тестовый исходный код компилируется и работает нормально.   -  person ico    schedule 30.07.2020
comment
Примеры значений: В моем Perl-скрипте: my $rv = paho::mqtt_connect_and_send("tcp://127.0.0.1:1883","username","topic",scalar(localtime)); E.g. У меня есть локальный сервер MQTT (mosquitto), работающий по петле. Я начал с простого TCP, без паролей. Когда мои привязки Perl станут пригодными для использования, я, конечно же, перейду на TLS, ACL и установку mosquitto нашей компании.   -  person ico    schedule 30.07.2020
comment
@Håkon Hægland Когда я тестировал компиляцию библиотеки Paho без установки, я сделал это: cd paho.mqtt.c; make; cd build/output, а затем сохранил пример синхронного клиента в client.c. Скомпилировал: gcc -I../../src -L. -lpaho-mqtt3c -o client client.c и запустил: LD_LIBRARY_PATH=. ./client. Может быть, это можно было бы сделать и для тестирования XS...   -  person ico    schedule 30.07.2020
comment
Обратите внимание, что использование библиотек, скомпилированных с параметрами, отличными от perl, может не сработать. Если вы собираетесь выпустить это на CPAN, вы можете подумать о создании копии специально для Perl. IIRC, XML::LibXML делает это (но я думаю, что это библиотека C++). Некоторые примеры, вероятно, можно найти в Alien::*   -  person ikegami    schedule 31.07.2020


Ответы (2)


Вот пример того, как вы можете вернуть клиента как объект 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. Пожалуйста, предоставьте данные, которые мы можем проверить.

person Håkon Hægland    schedule 29.07.2020
comment
После того, как я добавил одну строку functions">как описано здесь #define get_hash_uv(a,b) get_hash_uv(aTHX_ a,b) это сработало. Большой! - person ico; 30.07.2020
comment
Спасибо, что сэкономили мне время на написание этого :) - person ikegami; 31.07.2020
comment
к вашему сведению, вы могли бы избежать всех хеш-вещей, используя SV *self = newRV_noinc(sv); и UV addr = SvUV(SvRV(self)); - person ikegami; 31.07.2020
comment
Хорошая работа с использованием INT2PTR, но вы бросили вызов смыслу использования его так, как вы его использовали. (MQTTClient ) INT2PTR(SV*, addr) должно быть INT2PTR(MQTTClient, addr) - person ikegami; 31.07.2020

Нет смысла создавать хеш, если вы не хотите, чтобы класс был расширяемым.[1] Таким образом, решение Хокона Хэгланда можно упростить, возвращая скалярный объект. Это довольно распространено для классов на основе XS.

#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

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);
    }

    SV *sv = newSVuv(PTR2IV(client));
    SV *self = newRV_noinc(sv);
    RETVAL = sv_bless(self, gv_stashpv("Paho::Client", GV_ADD));

  OUTPUT:
    RETVAL

void
DESTROY(self)
       SV *self
   CODE:
       MQTTClient client;  // void *
       client = INT2PTR(MQTTClient, SvUV(SvRV(self)));

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

  1. Его все еще можно расширить, используя технику объекта наизнанку. И, конечно же, его еще можно завернуть.
person ikegami    schedule 30.07.2020