C++ calling perl code - eval_sv not passing arguments to script

Question

I have the below sample program which pushes the arguments to Perl stack and then calls "eval_sv". The sample perl statements get executed but i'm not able to retrieve the variables passed from C++ as Perl arguments. Please let me know what i am missing in the below program

Output of the program

Hello World

Test

100Testing complete

This line doesn't print the value of $a and $b

string three = "print 'Test\n'; my $z = 100; print $a; print $b; print $z;";

Here is my code:

#include <EXTERN.h>
#include <perl.h>
#include <string>
using namespace std;
  
string perlScript;

static PerlInterpreter *my_perl;

SV* my_eval_sv(I32 croak_on_error)
{
    STRLEN n_a;
    char *p1 = new char [perlScript.size()+1];
    strcpy(p1, perlScript.c_str());
    const char *p = p1;
    int len = strlen(p);

    dSP;
    ENTER ;
    SAVETMPS ;
    PUSHMARK(SP) ;


    int a, b;
    a = 10;
    b = 20;

    PERL_SET_CONTEXT(my_perl);
    XPUSHs(sv_2mortal(newSViv(a)));
    PERL_SET_CONTEXT(my_perl);
    XPUSHs(sv_2mortal(newSViv(b)));


    /* Done with pushing pointers to Perl stack */

    PUTBACK;

    SV* sv1 = newSVpv(p, 0);    
    eval_sv(sv1, G_EVAL | G_KEEPERR);
    SvREFCNT_dec(sv1);

    SPAGAIN;
    sv1 = POPs;
    PUTBACK;

    FREETMPS;
    LEAVE;

    if (croak_on_error && SvTRUE(ERRSV))
        croak(SvPVx(ERRSV, n_a));   
}

main (int argc, char **argv, char **env)
{
    char *embedding[] = { "", "-e", "0" };
    PERL_SYS_INIT3(&argc,&argv,&env);
    my_perl = perl_alloc();
    perl_construct(my_perl);
    perl_parse(my_perl, NULL, 3, embedding, NULL);
    PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
   
    /*string perlBeginScript;
    static const char * perlEndScript = "\
                                 \n\
    }\n\
    ";

    if(perlBeginScript.length()==0)
    {
        perlBeginScript="EmbeddedPerl";
    }

    perlScript = "sub ";
    perlScript += perlBeginScript;
    perlScript += "{\n"; */

    string one = "print 'Hello World\n'; ";
    string two = "my $a = shift; my $b = shift; ";
    string three= "print 'Test\n'; my $z = 100; print $a; print $b; print $z;";
    string four = "print 'Testing complete\n';";

    perlScript += one ;
    perlScript += two;
    perlScript += three;
    perlScript += four;

    //perlScript += perlEndScript;

    /* Done with perl script to be executed */
    my_eval_sv(TRUE);
    PL_perl_destruct_level = 1;
    perl_destruct(my_perl);
    perl_free(my_perl);
    PERL_SYS_TERM(); 
    }

Answer 1

I am just guessing here...

You try to pass some values to your Perl code by putting them on the Perl stack and then you expect the shift calls to retrieve values from the stack.

Depending on scope shift uses @_ or @ARGV and neither are interchangeable with "the stack". Only by making a perl subroutine call @_ is populated with elements from the stack. This is done with the call_sv function described in the perlcall manualpage.

In your case shift is not called from inside a subroutine, so it tries to shift from @ARGV. But as this array is empty your variables will be set to undef which is consistent with the output you are getting.

If you need to pass arguments I would recommend to write your Perl code as a anonymous subrouting. That is eval you subroutine definition with eval_pv() and then call it with call_sv() after setting up the stack. The commented out sections of you code seems to indicate that you have looked at this approach (but with a named subroutine).

Alternatively you need to push your arguments to @ARGV by retireving it with get_avand then perform the appropriate operations on it. Though I am not sure if @ARGVis magic in any way.

Answer 2

I have modified the above program posted in the question to make it work with inputs from @pmakholm.

#include <EXTERN.h>
#include <perl.h>
#include <string>


#undef do_open
#undef do_close
#include <iostream>

using namespace std;


string perlScript;

static PerlInterpreter *my_perl;

SV* my_eval_sv(I32 croak_on_error)
{

    STRLEN n_a; 


char *p1 = new char [perlScript.size()+1];
strcpy(p1, perlScript.c_str());
const char *p = p1;
int len = strlen(p);

dSP;
ENTER ;
SAVETMPS ;
PUSHMARK(SP) ;


int a, b,c,d,e,f,g,h,i,j,k,l;
a = 900;
b = 1000;
    c = 2000;
    d = 3000;
    e = 4000;
    f = 5000;
    g = 6000;
    h =7000;
    i=8000;
    k=9000;
    l=10000;


PERL_SET_CONTEXT(my_perl);
XPUSHs(sv_2mortal(newSViv(a)));
PERL_SET_CONTEXT(my_perl);
XPUSHs(sv_2mortal(newSViv(b))); 
PERL_SET_CONTEXT(my_perl);
XPUSHs(sv_2mortal(newSViv(c)));
PERL_SET_CONTEXT(my_perl);
XPUSHs(sv_2mortal(newSViv(d))); 
PERL_SET_CONTEXT(my_perl);
XPUSHs(sv_2mortal(newSViv(e)));
PERL_SET_CONTEXT(my_perl);
XPUSHs(sv_2mortal(newSViv(f)));
PERL_SET_CONTEXT(my_perl);
XPUSHs(sv_2mortal(newSViv(g))); 
PERL_SET_CONTEXT(my_perl);
XPUSHs(sv_2mortal(newSViv(h))); 
PERL_SET_CONTEXT(my_perl);
XPUSHs(sv_2mortal(newSViv(i))); 
PERL_SET_CONTEXT(my_perl);
XPUSHs(sv_2mortal(newSViv(j))); 
PERL_SET_CONTEXT(my_perl);
XPUSHs(sv_2mortal(newSViv(k))); 
PERL_SET_CONTEXT(my_perl);
XPUSHs(sv_2mortal(newSViv(l))); 


    /* Done with pushing pointers to Perl stack */

PUTBACK;

SV* sv1 = newSVpv(p, 0);

croak_on_error = eval_sv(sv1, G_EVAL | G_KEEPERR);  
    cout << "croak on error is" << croak_on_error << endl; 

    call_pv("Test", G_KEEPERR | G_EVAL);

SPAGAIN; 
FREETMPS;
LEAVE;

if (croak_on_error && SvTRUE(ERRSV))
    croak(SvPVx(ERRSV, n_a));

}

main (int argc, char **argv, char **env)
{

char *embedding[] = { "", "-e", "0" };
PERL_SYS_INIT3(&argc,&argv,&env);
my_perl = perl_alloc();
perl_construct(my_perl);
perl_parse(my_perl, NULL, 3, embedding, NULL);
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;


string one = "sub Test{print 'Hello World\n'; my $a = shift; my $b = shift; my $c =shift; my $d = shift; my $e = shift; my $f = shift; my $g = shift; my $h = shift; my $i = shift; my $j = shift; my $k=shift; my $l=shift;print $a; print $b; print $c; print $d; print $e; print $f; print $f; print $g; print $h; print $i; print $j; print $k; print $l;} ";

    perlScript += one ; 


    /* Done with perl script to be executed */
    my_eval_sv(TRUE); 

    PL_perl_destruct_level = 1;
    perl_destruct(my_perl);
    perl_free(my_perl);
    PERL_SYS_TERM();

}