7

以下のサンプルプログラムは、引数を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(); 
    }
4

2 に答える 2

3

私はちょうどここで推測しています...

いくつかの値を Perl スタックに置くことによって Perl コードに渡そうとすると、shift呼び出しがスタックから値を取得することが期待されます。

shiftスコープの用途に応じて、@_または@ARGVどちらも「スタック」と交換可能です。perl サブルーチン呼び出しを行うことによってのみ@_、スタックからの要素が取り込まれます。これは、 perlcallcall_svのマニュアルページで説明されている関数で行われます。

あなたの場合shift、サブルーチン内から呼び出されないため、からシフトしようとし@ARGVます。undefただし、この配列は空であるため、取得している出力と一致する変数が設定されます。

引数を渡す必要がある場合は、Perl コードを匿名サブルーティングとして記述することをお勧めします。これは、サブルーチン定義を評価し、スタックを設定した後eval_pv()に呼び出すことです。call_sv()コードのコメントアウトされたセクションは、このアプローチを検討したことを示しているようです (ただし、名前付きサブルーチンを使用)。

または、引数を@ARGVで取得してプッシュしget_av、適切な操作を実行する必要があります。@ARGV何らかの形で魔法であるかどうかはわかりませんが。

于 2012-09-13T11:15:12.643 に答える
1

質問に投稿された上記のプログラムを修正して、@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();

}
于 2012-09-26T05:35:43.950 に答える