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

Intonate

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.

Doridoria

You are correct @pmakholm. Perl documentation on shift tells this exactly as you described: If ARRAY is omitted, shifts the @ array within the lexical scope of subroutines and formats, and the @ARGV array outside a subroutine and also within the lexical scopes established by the eval STRING..._ – Deckhouse

On second thought, the difference in which array shift tries to access isn't the main problem. The main issue is that neither of them is tied directly to the stack where @Intonate places the values. So I've added a section about the relation between the stack and @_ – Doridoria

@Doridoria I could resolve the problem with your inputs. I'm new to using Perl APIs. I used the combination "eval_sv" and "call_pv" and my program works. 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); – Intonate

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

}

Intonate