C ++ вызывает Perl-код — eval_sv не передает аргументы скрипту
У меня есть пример программы ниже, которая помещает аргументы в стек Perl и затем вызывает «eval_sv». Примеры операторов Perl выполняются, но я не могу получить переменные, переданные из C ++ в качестве аргументов Perl. Пожалуйста, дайте мне знать, что мне не хватает в приведенной ниже программе
Выход программы
Привет, мир
Тестовое задание
100Тестирование завершено
Эта строка не печатает значения $ a и $ b
string three = "print 'Test\n'; my $z = 100; print $a; print $b; print $z;";
Вот мой код:
#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();
}
Решение
Я просто догадываюсь здесь …
Вы пытаетесь передать некоторые значения в свой код Perl, поместив их в стек Perl, а затем ожидаете shift вызовы для извлечения значений из стека.
В зависимости от объема shift использования @_ или же @ARGV и ни один из них не взаимозаменяем с «стеком». Только делая вызов подпрограммы perl @_ заполняется элементами из стека. Это сделано с call_sv функция описана в perlcall manualpage.
В твоем случае shift не вызывается из подпрограммы, поэтому она пытается перейти от @ARGV, Но так как этот массив пуст, ваши переменные будут установлены в undef что согласуется с выходом, который вы получаете.
Если вам нужно передать аргументы, я бы порекомендовал написать ваш Perl-код как анонимную подпрограмму. Это правильное определение подпрограммы eval_pv() а затем позвонить с call_sv() после настройки стека. Закомментированные разделы вашего кода, кажется, указывают на то, что вы рассматривали этот подход (но с именованной подпрограммой).
В качестве альтернативы вам нужно выдвинуть свои аргументы @ARGV выбрав его с get_avи затем выполните соответствующие операции над ним. Хотя я не уверен, если @ARGVэто магия в любом случае.
Другие решения
Я изменил вышеупомянутую программу, размещенную в вопросе, чтобы она работала с входными данными @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();
}