在 C++ 程序中嵌入 Perl 脚本

Question

我在我的 C++ 程序中嵌入了一个 Perl 解释器，因为我想运行一个 Perl 脚本。 以下是我目前的代码——它只运行一些虚拟脚本；我想运行transferScript 脚本，这涉及将两个字符串参数传递给Perl 脚本。

1. 我可以通过解释器运行任意字符串吗？
2. 如何将两个字符串参数传递给我的脚本？

谢谢！

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

}

Answer 1

这是一个使用@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