Embed Perl script in C++ program

user_244005 0
Viewed 178

I have embedded a Perl interpreter into my C++ program, as I want to run a Perl script. Below is my code so far - it only runs a few dummy scripts; I would like to run the transferScript script, which involves passing two string parameters to the Perl script.

  1. Can I run an arbitrary string through the interpreter?
  2. How can I pass the two string arguments to my script?

Thanks!

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

Edit: Here is my final code.

To fix a compile error on Debian, I need to make a few changes, as suggested here:

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

}
embed perl c++
1 Answers

Here is an example using @ARGV and 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;
}

Output:

Got argument 1 = Hello
Got argument 2 = Bye

Note: I am using perl version 5.30.0 and I compiled this with:

g++ -std=c++17 -o my_test test.cpp `perl -MExtUtils::Embed -e ccopts -e ldopts`

Edit

If you want to call a subroutine multiple times with arguments, you can use call_argv(). For example:

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;
}

Output:

Got argument 1 = arg1
Got argument 2 = arg2
Got argument 1 = arg3
Got argument 2 = arg4
user_21737730
Related