我使用FFI::Platypus来调用C函数。该函数包含四个参数:两个字符串、一个指向缓冲区的指针和缓冲区大小:
int helper_getAddr(
const char *firstName,
const char *lastName,
char **address,
size_t *addressLen);我是这样定义它的FFI::鸭嘴兽:
$self->{ffi}->attach( [helper_getAddr => 'get_addr']
=> ['string', 'string', 'string', 'size_t'] => 'int' );然后这样打电话:
my $contents_ptr = malloc 100;
my $size;
my $success = get_addr( "Tom", "Baker", \$contents_ptr, \$size );所以我可以使用buffer_to_scalar来获取缓冲区内容。
调用似乎有效--定义了$success = 0和$contents_ptr --但是没有设置$size。
我很少使用C/C++,所以我不确定我的问题是在$size声明中,还是需要更改对get_addr()的调用。
或者,我是否可以在Perl中直接使用$contents_ptr来在调用buffer_to_scalar之前找到缓冲区的长度?
发布于 2020-08-05 20:33:23
以下是不正确的:
[ 'string', 'string', 'string', 'size_t' ]helper_getAddr的第三arg不是字符串,helper_getAddr的第四arg不是helper_getAddr在继续之前,我们必须确定函数所期望的内容。这是有问题的,因为函数的参数没有多大意义。
如果helper_getAddr填充了现有缓冲区,我希望
int helper_getAddr(
const char *firstName,
const char *lastName,
char **address,
size_t *addressLen
);如果helper_getAddr分配并返回一个字符串,我希望
char *helper_getAddr(
const char *firstName,
const char *lastName
);或
int helper_getAddr(
const char *firstName,
const char *lastName,
char **address
);除了具有额外的无用参数外,helper_getAddr最类似于分配和返回字符串的函数。因此,我将在假设helper_getAddr分配并返回一个字符串的前提下继续工作。
考虑到我们拥有的函数,我们会倾向于使用以下方法:
$ffi->attach(
[ 'helper_getAddr' => '_get_addr' ],
[ 'string', 'string', 'string*', 'size_t*' ], # XXX
'int',
);问题是,它不能让我们访问我们需要释放的指针。因此,我们将使用
$ffi->attach(
[ 'helper_getAddr' => '_get_addr' ],
[ 'string', 'string', 'opaque*', 'size_t*' ],
'int',
);一个简单的包装器将使函数具有Perl-ish的外观,并处理释放缓冲区的问题。
sub get_addr {
_get_addr($_[0], $_[1], \my $buf, \my $buf_size)
or return undef;
my $addr = $ffi->cast('opaque' => 'string', $buf);
free($buf);
return $addr;
}malloc,因为函数将简单地覆盖指针,从而导致内存泄漏。通过将缓冲区转换为string类型的buffer_to_scalar .。
示例用法:
say get_addr("Tom", "Baker") // "[undef]";完整的解决方案如下。
lookup
#!/home/ikegami/usr/perlbrew/perls/5.32.0t/bin/perl
use strict;
use warnings;
use feature qw( say state );
use FindBin qw( $RealBin );
use FFI::Platypus qw( );
use FFI::Platypus::Memory qw( free );
my $ffi = FFI::Platypus->new( api => 1 );
$ffi->find_lib(
lib => 'lookup',
libpath => $RealBin,
);
$ffi->attach(
[ 'get_addr' => '_get_addr' ],
[ 'string', 'string', 'opaque*', 'size_t*' ],
'int',
);
sub get_addr {
_get_addr($_[0], $_[1], \my $buf, \my $buf_size)
or return undef;
my $addr = $ffi->cast('opaque' => 'string', $buf);
free($buf);
return $addr;
}
say get_addr("Tom", "Baker") // "[undef]";liblookup.c
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
int get_addr(
const char *first_name,
const char *last_name,
char **address_ptr,
size_t *address_size_ptr
) {
const char *prefix = "Address of ";
const size_t len_prefix = strlen(prefix);
const size_t len_f_n = strlen(first_name);
const size_t len_l_n = strlen(last_name);
*address_size_ptr = len_prefix + len_f_n + 1 + len_l_n + 1;
*address_ptr = malloc(*address_size_ptr);
if (!*address_ptr)
return 0;
char *p = *address_ptr;
memmove(p, prefix, len_prefix); p += len_prefix;
memmove(p, first_name, len_f_n); p += len_f_n;
*p = ' '; ++p;
memmove(p, last_name, len_l_n); p += len_l_n;
*p = 0; ++p;
return 1;
}run
#!/bin/bash
trap 'printf '\''error!\n'\''; exit 1' ERR
script="$( readlink -e -- "$0" )"
script_dir="$( dirname -- "$script" )"
home_dir="$script_dir"
cd "$home_dir"
prog=./lookup
# Use the PATH to locate the program.
prog="$( which -- "$prog" )"
# Use the program's shebang to locate the appropriate perl.
perl="$( perl -ne'chomp; print s/^#!//r; exit;' "$prog" )"
# Extract compiler and linker information from the correct perl.
get_config() { "$perl" -MConfig -e'print $Config{$ARGV[0]}' "$1"; }
cc="$( get_config cc )"
ccflags="$( get_config ccflags )"
optimize="$( get_config optimize )"
cccdlflags="$( get_config cccdlflags )"
ld="$( get_config ld )"
lddlflags="$( get_config lddlflags )"
# Build the shared library.
"$cc" -c $ccflags $optimize $cccdlflags liblookup.c -o liblookup.o
"$ld" $lddlflags liblookup.o -o liblookup.so
# Run our test.
"$prog"https://stackoverflow.com/questions/63271072
复制相似问题