如何在 Perl XS 中封装库句柄
How to encapsulate library handle in Perl XS
我想 send/receive 来自 Perl 的 MQTT 消息。由于各种原因（MQTT 5 支持、TLS）我不想使用现有的 Perl 库。所以我尝试使用基本的 Perl XS 创建 XS 绑定到 Paho MQTT C Library. I somehow adapted provided example 到 link 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 在我的例子中），return 它到 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 以再次使用吗？
谢谢。
这是一个示例，说明如何 return 将客户端作为 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 值。请提供我们可以测试的数据。
除非您希望 class 可扩展，否则构建哈希没有意义。[1] 因此，Håkon Hægland 的解决方案可以通过返回一个简化基于标量的对象。这样做对于基于 XS 的 classes 来说是很常见的。
#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");
- 它仍然可以使用由内而外的对象技术进行扩展。当然，它仍然可以被包裹起来。
我想 send/receive 来自 Perl 的 MQTT 消息。由于各种原因（MQTT 5 支持、TLS）我不想使用现有的 Perl 库。所以我尝试使用基本的 Perl XS 创建 XS 绑定到 Paho MQTT C Library. I somehow adapted provided example 到 link 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 在我的例子中），return 它到 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 以再次使用吗？
谢谢。
这是一个示例，说明如何 return 将客户端作为 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 值。请提供我们可以测试的数据。
除非您希望 class 可扩展，否则构建哈希没有意义。[1] 因此，Håkon Hægland 的解决方案可以通过返回一个简化基于标量的对象。这样做对于基于 XS 的 classes 来说是很常见的。
#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");
- 它仍然可以使用由内而外的对象技术进行扩展。当然，它仍然可以被包裹起来。