Блог

Я встроил интерпретатор Perl в свою программу на C , так как хочу запустить 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 = %dn", SvIV(get_sv("a", FALSE)));
    /** Treat $a as a float **/
    eval_pv("$a = 3.14; $a **= 2", TRUE);
    printf("a = %fn", SvNV(get_sv("a", FALSE))); 
    /** Treat $a as a string **/
    eval_pv("$a = 'relreP kcaH rehtonA tsuJ'; 
    $a = reverse($a);", TRUE);
    printf("a = %sn", 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 amp;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(amp;argc,amp;argv,amp;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