在 C++ 程序中嵌入 Perl 脚本
Embed Perl script in C++ program
我已经在我的 C++ 程序中嵌入了一个 Perl 解释器,因为我想 运行 一个 Perl 脚本。
到目前为止,下面是我的代码——它只有 运行 一些虚拟脚本;我想要 运行 transferScript
脚本,它涉及将两个字符串参数传递给 Perl 脚本。
- 我可以通过解释器 运行 任意字符串吗?
- 如何将两个字符串参数传递给我的脚本?
谢谢!
#include <EXTERN.h> /* from the Perl distribution */
#include <perl.h> /* from the Perl distribution */
static PerlInterpreter *my_perl; /*** The Perl interpreter ***/
const char* transferScript =
"use Image::ExifTool qw(ImageInfo); \
$srcFile = $ARGV[0]; \
$outFile = $ARGV[1]; \
my $exifTool = new Image::ExifTool; \
my $info = $exifTool->SetNewValuesFromFile($srcFile, 'all:all'); \
my $result = $exifTool->WriteInfo($outFile);";
void transferTags(std::string src, std::string dest){
STRLEN n_a;
const char* embedding[] = { "", "-e", "0" };
my_perl = perl_alloc();
perl_construct( my_perl );
perl_parse(my_perl, NULL, 3, (char**)embedding, NULL);
perl_run(my_perl);
/** Treat $a as an integer **/
eval_pv("$a = 3; $a **= 2", TRUE);
printf("a = %d\n", SvIV(get_sv("a", FALSE)));
/** Treat $a as a float **/
eval_pv("$a = 3.14; $a **= 2", TRUE);
printf("a = %f\n", SvNV(get_sv("a", FALSE)));
/** Treat $a as a string **/
eval_pv("$a = 'relreP kcaH rehtonA tsuJ';
$a = reverse($a);", TRUE);
printf("a = %s\n", SvPV(get_sv("a", FALSE), n_a));
perl_destruct(my_perl);
perl_free(my_perl);
}
编辑:这是我的最终代码。
要修复 Debian 上的编译错误,我需要按照此处的建议进行一些更改:
https://perldoc.perl.org/perlguts#How-multiple-interpreters-and-concurrency-are-supported
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
class PerlInterp {
public:
PerlInterp() : perlInterp(nullptr) {
dTHX;
std::string script {R"x(
use Image::ExifTool qw(ImageInfo);
use strict;
use warnings;
sub transfer {
my $srcFile = $_[0];
my $outFile = $_[1];
my $exifTool = new Image::ExifTool;
my $info = $exifTool->SetNewValuesFromFile($srcFile, 'all:all');
my $result = $exifTool->WriteInfo($outFile);
}
)x"};
constexpr int NUM_ARGS = 3;
const char* embedding[NUM_ARGS] = { "", "-e", "0" };
PERL_SYS_INIT3(NULL,NULL,NULL);
perlInterp = perl_alloc();
perl_construct( perlInterp );
int res = perl_parse(perlInterp, NULL, NUM_ARGS, (char**)embedding, NULL);
assert(!res);
(void)res;
perl_run(perlInterp);
eval_pv(script.c_str(), TRUE);
}
~PerlInterp(){
dTHX;
perl_destruct(perlInterp);
perl_free(perlInterp);
PERL_SYS_TERM();
}
PerlInterpreter *perlInterp;
};
class PerlScriptRunner{
public:
static PerlInterp *instance(void){
static PerlInterp interp;
return &interp;
}
};
void transferExifTags(std::string src, std::string dest){
dTHX;
PerlScriptRunner::instance();
char *args[] = {(char*)src.c_str(), (char*)dest.c_str(), NULL};
call_argv("transfer", G_DISCARD, args);
}
这是一个使用 @ARGV
和 eval_pv()
的例子:
#include <iostream>
#include <string>
#include <EXTERN.h>
#include <perl.h>
static PerlInterpreter *my_perl;
int main() {
std::string script {R"x(
use feature qw(say);
use strict;
use warnings;
say "Got argument 1 = $ARGV[0]";
say "Got argument 2 = $ARGV[1]";
)x"};
static constexpr int NUM_ARGS = 5;
const char* embedding[NUM_ARGS] = { "", "-e", "0", "Hello", "Bye" };
my_perl = perl_alloc();
perl_construct( my_perl );
perl_parse(my_perl, NULL, NUM_ARGS, (char**)embedding, NULL);
perl_run(my_perl);
eval_pv(script.c_str(), TRUE);
perl_destruct(my_perl);
perl_free(my_perl);
return 0;
}
输出:
Got argument 1 = Hello
Got argument 2 = Bye
注意:我使用的是 perl 版本 5.30.0,我用以下代码编译了它:
g++ -std=c++17 -o my_test test.cpp `perl -MExtUtils::Embed -e ccopts -e ldopts`
编辑
如果你想多次调用带参数的子程序,你可以使用call_argv()
。例如:
int main(int argc, char **argv, char **env) {
std::string script {R"x(
use feature qw(say);
use strict;
use warnings;
sub foo {
say "Got argument 1 = $_[0]";
say "Got argument 2 = $_[1]";
}
)x"};
static constexpr int NUM_ARGS = 3;
const char* embedding[NUM_ARGS] = { "", "-e", "0" };
PERL_SYS_INIT3(&argc,&argv,&env);
my_perl = perl_alloc();
perl_construct( my_perl );
int res1 = perl_parse(my_perl, NULL, NUM_ARGS, (char**)embedding, NULL);
perl_run(my_perl);
eval_pv(script.c_str(), TRUE);
char *args1[] = {"arg1", "arg2", NULL};
call_argv("foo", G_DISCARD, args1);
char *args2[] = {"arg3", "arg4", NULL};
call_argv("foo", G_DISCARD, args2);
perl_destruct(my_perl);
perl_free(my_perl);
PERL_SYS_TERM();
return 0;
}
输出:
Got argument 1 = arg1
Got argument 2 = arg2
Got argument 1 = arg3
Got argument 2 = arg4
我已经在我的 C++ 程序中嵌入了一个 Perl 解释器,因为我想 运行 一个 Perl 脚本。
到目前为止,下面是我的代码——它只有 运行 一些虚拟脚本;我想要 运行 transferScript
脚本,它涉及将两个字符串参数传递给 Perl 脚本。
- 我可以通过解释器 运行 任意字符串吗?
- 如何将两个字符串参数传递给我的脚本?
谢谢!
#include <EXTERN.h> /* from the Perl distribution */
#include <perl.h> /* from the Perl distribution */
static PerlInterpreter *my_perl; /*** The Perl interpreter ***/
const char* transferScript =
"use Image::ExifTool qw(ImageInfo); \
$srcFile = $ARGV[0]; \
$outFile = $ARGV[1]; \
my $exifTool = new Image::ExifTool; \
my $info = $exifTool->SetNewValuesFromFile($srcFile, 'all:all'); \
my $result = $exifTool->WriteInfo($outFile);";
void transferTags(std::string src, std::string dest){
STRLEN n_a;
const char* embedding[] = { "", "-e", "0" };
my_perl = perl_alloc();
perl_construct( my_perl );
perl_parse(my_perl, NULL, 3, (char**)embedding, NULL);
perl_run(my_perl);
/** Treat $a as an integer **/
eval_pv("$a = 3; $a **= 2", TRUE);
printf("a = %d\n", SvIV(get_sv("a", FALSE)));
/** Treat $a as a float **/
eval_pv("$a = 3.14; $a **= 2", TRUE);
printf("a = %f\n", SvNV(get_sv("a", FALSE)));
/** Treat $a as a string **/
eval_pv("$a = 'relreP kcaH rehtonA tsuJ';
$a = reverse($a);", TRUE);
printf("a = %s\n", SvPV(get_sv("a", FALSE), n_a));
perl_destruct(my_perl);
perl_free(my_perl);
}
编辑:这是我的最终代码。
要修复 Debian 上的编译错误,我需要按照此处的建议进行一些更改:
https://perldoc.perl.org/perlguts#How-multiple-interpreters-and-concurrency-are-supported
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
class PerlInterp {
public:
PerlInterp() : perlInterp(nullptr) {
dTHX;
std::string script {R"x(
use Image::ExifTool qw(ImageInfo);
use strict;
use warnings;
sub transfer {
my $srcFile = $_[0];
my $outFile = $_[1];
my $exifTool = new Image::ExifTool;
my $info = $exifTool->SetNewValuesFromFile($srcFile, 'all:all');
my $result = $exifTool->WriteInfo($outFile);
}
)x"};
constexpr int NUM_ARGS = 3;
const char* embedding[NUM_ARGS] = { "", "-e", "0" };
PERL_SYS_INIT3(NULL,NULL,NULL);
perlInterp = perl_alloc();
perl_construct( perlInterp );
int res = perl_parse(perlInterp, NULL, NUM_ARGS, (char**)embedding, NULL);
assert(!res);
(void)res;
perl_run(perlInterp);
eval_pv(script.c_str(), TRUE);
}
~PerlInterp(){
dTHX;
perl_destruct(perlInterp);
perl_free(perlInterp);
PERL_SYS_TERM();
}
PerlInterpreter *perlInterp;
};
class PerlScriptRunner{
public:
static PerlInterp *instance(void){
static PerlInterp interp;
return &interp;
}
};
void transferExifTags(std::string src, std::string dest){
dTHX;
PerlScriptRunner::instance();
char *args[] = {(char*)src.c_str(), (char*)dest.c_str(), NULL};
call_argv("transfer", G_DISCARD, args);
}
这是一个使用 @ARGV
和 eval_pv()
的例子:
#include <iostream>
#include <string>
#include <EXTERN.h>
#include <perl.h>
static PerlInterpreter *my_perl;
int main() {
std::string script {R"x(
use feature qw(say);
use strict;
use warnings;
say "Got argument 1 = $ARGV[0]";
say "Got argument 2 = $ARGV[1]";
)x"};
static constexpr int NUM_ARGS = 5;
const char* embedding[NUM_ARGS] = { "", "-e", "0", "Hello", "Bye" };
my_perl = perl_alloc();
perl_construct( my_perl );
perl_parse(my_perl, NULL, NUM_ARGS, (char**)embedding, NULL);
perl_run(my_perl);
eval_pv(script.c_str(), TRUE);
perl_destruct(my_perl);
perl_free(my_perl);
return 0;
}
输出:
Got argument 1 = Hello
Got argument 2 = Bye
注意:我使用的是 perl 版本 5.30.0,我用以下代码编译了它:
g++ -std=c++17 -o my_test test.cpp `perl -MExtUtils::Embed -e ccopts -e ldopts`
编辑
如果你想多次调用带参数的子程序,你可以使用call_argv()
。例如:
int main(int argc, char **argv, char **env) {
std::string script {R"x(
use feature qw(say);
use strict;
use warnings;
sub foo {
say "Got argument 1 = $_[0]";
say "Got argument 2 = $_[1]";
}
)x"};
static constexpr int NUM_ARGS = 3;
const char* embedding[NUM_ARGS] = { "", "-e", "0" };
PERL_SYS_INIT3(&argc,&argv,&env);
my_perl = perl_alloc();
perl_construct( my_perl );
int res1 = perl_parse(my_perl, NULL, NUM_ARGS, (char**)embedding, NULL);
perl_run(my_perl);
eval_pv(script.c_str(), TRUE);
char *args1[] = {"arg1", "arg2", NULL};
call_argv("foo", G_DISCARD, args1);
char *args2[] = {"arg3", "arg4", NULL};
call_argv("foo", G_DISCARD, args2);
perl_destruct(my_perl);
perl_free(my_perl);
PERL_SYS_TERM();
return 0;
}
输出:
Got argument 1 = arg1
Got argument 2 = arg2
Got argument 1 = arg3
Got argument 2 = arg4