perlembed - 如何將 perl 嵌入到 C 程式中
您想要
在 perlfunc 中閱讀關於反引號以及 system
和 exec
的說明。
閱讀 "perlfunc 中的 do"、"perlfunc 中的 eval"、"perlfunc 中的 require" 和 "perlfunc 中的 use"。
重新思考您的設計。
繼續閱讀...
編譯 C 程式
將 Perl 詮釋器加入 C 程式
從 C 程式呼叫 Perl 子程式
從 C 程式評估 Perl 陳述式
從 C 程式執行 Perl 模式比對和取代
從 C 程式調整 Perl 堆疊
維護持續的詮釋器
維護多個詮釋器執行個體
從 C 程式使用 Perl 模組(其本身使用 C 函式庫)
在 Win32 中嵌入 Perl
如果您在編譯此文件中的指令碼時遇到問題,您並不孤單。基本規則:使用與編譯 PERL 完全相同的方式編譯程式。(抱歉大吼大叫。)
此外,每個使用 Perl 的 C 程式都必須連結到perl 函式庫。您問那是什麼?Perl 本身是用 C 編寫的;perl 函式庫是編譯 C 程式的集合,用於建立您的 perl 可執行檔(/usr/bin/perl 或等效檔)。(推論:除非 Perl 已在您的機器上編譯或正確安裝,否則您無法從 C 程式使用 Perl,這就是為什麼您不應輕率地將 Perl 可執行檔從一台機器複製到另一台機器,而不複製lib 目錄。)
當您從 C 使用 Perl 時,您的 C 程式通常會配置、「執行」和取消配置PerlInterpreter 物件,該物件是由 perl 函式庫定義的。
如果您的 Perl 副本夠新,包含此文件(版本 5.002 或更新版本),則 perl 函式庫(以及您也需要的EXTERN.h 和perl.h)將駐留在類似這樣的目錄中
/usr/local/lib/perl5/your_architecture_here/CORE
或可能只是
/usr/local/lib/perl5/CORE
或可能是像
/usr/opt/perl5/CORE
執行此陳述以取得關於在哪裡找到 CORE 的提示
perl -MConfig -e 'print $Config{archlib}'
以下是您如何在下一節中編譯範例,"將 Perl 詮釋器新增到您的 C 程式",在 Linux 盒子上
% gcc -O2 -Dbool=char -DHAS_BOOL -I/usr/local/include
-I/usr/local/lib/perl5/i586-linux/5.003/CORE
-L/usr/local/lib/perl5/i586-linux/5.003/CORE
-o interp interp.c -lperl -lm
(這是一行。)在我的 DEC Alpha 上執行舊的 5.003_05,咒語有點不同
% cc -O2 -Olimit 2900 -I/usr/local/include
-I/usr/local/lib/perl5/alpha-dec_osf/5.00305/CORE
-L/usr/local/lib/perl5/alpha-dec_osf/5.00305/CORE -L/usr/local/lib
-D__LANGUAGE_C__ -D_NO_PROTO -o interp interp.c -lperl -lm
您如何找出要新增什麼?假設您的 Perl 是 5.001 之後,執行 perl -V
命令,並特別注意「cc」和「ccflags」資訊。
您必須為您的機器選擇適當的編譯器(cc、gcc 等):perl -MConfig -e 'print $Config{cc}'
會告訴您要使用什麼。
您還必須為您的機器選擇適當的函式庫目錄(/usr/local/lib/...)。如果您的編譯器抱怨某些函式未定義,或找不到-lperl,則您需要變更 -L
之後的路徑。如果它抱怨找不到EXTERN.h 和perl.h,則您需要變更 -I
之後的路徑。
您可能還必須新增額外的函式庫。哪些函式庫?也許是
perl -MConfig -e 'print $Config{libs}'
假設您的 perl 二進位檔已正確設定並安裝,ExtUtils::Embed 模組將為您找出所有這些資訊
% cc -o interp interp.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
如果 ExtUtils::Embed 模組不是 Perl 發行版的一部分,您可以從 https://metacpan.org/pod/ExtUtils::Embed 擷取(如果此文件來自您的 Perl 發行版,表示您執行的是 5.004 或更新版本,且您已擁有該模組)。
CPAN 上的 ExtUtils::Embed 套件也包含此文件範例的所有原始碼、測試、其他範例和其他您可能覺得有用的資訊。
從某種意義上來說,perl(C 程式)是嵌入 Perl(語言)的一個好範例,因此我將使用原始碼發行版中包含的 miniperlmain.c 來示範嵌入。以下是 miniperlmain.c 的非移植版本,其中包含嵌入的基本要素
#include <EXTERN.h> /* from the Perl distribution */
#include <perl.h> /* from the Perl distribution */
static PerlInterpreter *my_perl; /*** The Perl interpreter ***/
int main(int argc, char **argv, char **env)
{
PERL_SYS_INIT3(&argc,&argv,&env);
my_perl = perl_alloc();
perl_construct(my_perl);
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
perl_parse(my_perl, NULL, argc, argv, (char **)NULL);
perl_run(my_perl);
perl_destruct(my_perl);
perl_free(my_perl);
PERL_SYS_TERM();
exit(EXIT_SUCCESS);
}
請注意,我們不使用 env
指標。env
通常作為其最後一個引數傳遞給 perl_parse
,這裡的 env
已被 NULL
取代,這表示將使用目前的環境。
巨集 PERL_SYS_INIT3() 和 PERL_SYS_TERM() 提供 C 執行時期環境的系統特定調整,以執行 Perl 直譯器;不論您建立或銷毀多少直譯器,都應該只呼叫一次。在建立第一個直譯器之前呼叫 PERL_SYS_INIT3(),在釋放最後一個直譯器之後呼叫 PERL_SYS_TERM()。
由於 PERL_SYS_INIT3() 可能會變更 env
,因此將 env
提供為 perl_parse() 的引數會更合適。
另外請注意,不論您傳遞哪些引數給 perl_parse(),都必須在 C main() argc、argv 和 env 上呼叫 PERL_SYS_INIT3(),且只能呼叫一次。
請注意,argv[argc] 必須為 NULL,與傳遞給 C 中 main 函式的內容相同。
現在將此程式(我將稱之為 interp.c)編譯成可執行檔
% cc -o interp interp.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
編譯成功後,您將能夠像使用 perl 本身一樣使用 interp
% interp
print "Pretty Good Perl \n";
print "10890 - 9801 is ", 10890 - 9801;
<CTRL-D>
Pretty Good Perl
10890 - 9801 is 1089
或
% interp -e 'printf("%x", 3735928559)'
deadbeef
您也可以在 C 程式執行期間從檔案讀取和執行 Perl 陳述式,方法是在呼叫 perl_run 之前將檔案名稱放入 argv[1] 中。
若要呼叫個別 Perl 子常式,您可以使用 perlcall 中記載的任何 call_* 函式。在此範例中,我們將使用 call_argv
。
以下在一個我稱之為 showtime.c 的程式中顯示。
#include <EXTERN.h>
#include <perl.h>
static PerlInterpreter *my_perl;
int main(int argc, char **argv, char **env)
{
char *args[] = { NULL };
PERL_SYS_INIT3(&argc,&argv,&env);
my_perl = perl_alloc();
perl_construct(my_perl);
perl_parse(my_perl, NULL, argc, argv, NULL);
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
/*** skipping perl_run() ***/
call_argv("showtime", G_DISCARD | G_NOARGS, args);
perl_destruct(my_perl);
perl_free(my_perl);
PERL_SYS_TERM();
exit(EXIT_SUCCESS);
}
其中 showtime 是 Perl 子常式,不帶任何引數 (即為 G_NOARGS),而且我會忽略其傳回值 (即為 G_DISCARD)。這些旗標和其他旗標會在 perlcall 中討論。
我將在一個稱為 showtime.pl 的檔案中定義 showtime 子常式
print "I shan't be printed.";
sub showtime {
print time;
}
夠簡單了。現在編譯並執行
% cc -o showtime showtime.c \
`perl -MExtUtils::Embed -e ccopts -e ldopts`
% showtime showtime.pl
818284590
產生自 1970 年 1 月 1 日 (Unix 紀元的開始) 到我開始撰寫這句話之間經過的秒數。
在這個特定案例中,我們不必呼叫 perl_run,因為我們設定了 PL_exit_flag PERL_EXIT_DESTRUCT_END,它會在 perl_destruct 中執行 END 區塊。
如果你想要傳遞引數給 Perl 子常式,你可以將字串新增至傳遞給 call_argv 的 NULL
終止 args
清單。對於其他資料類型,或要檢查傳回值,你將需要操作 Perl 堆疊。這會在 "從 C 程式操作 Perl 堆疊" 中示範。
Perl 提供兩個 API 函式來評估 Perl 程式碼片段。這些函式是 "eval_sv" in perlapi 和 "eval_pv" in perlapi。
可以說,這些是你從 C 程式中執行 Perl 程式碼片段時唯一會用到的常式。你的程式碼可以長到你想要的長度;它可以包含多個陳述式;它可以使用 "use" in perlfunc、"require" in perlfunc 和 "do" in perlfunc 來包含外部 Perl 檔案。
eval_pv 讓我們評估個別 Perl 字串,然後擷取變數以強制轉換成 C 類型。以下程式 string.c 執行三個 Perl 字串,從第一個字串擷取 int
、從第二個字串擷取 float
,以及從第三個字串擷取 char *
。
#include <EXTERN.h>
#include <perl.h>
static PerlInterpreter *my_perl;
main (int argc, char **argv, char **env)
{
char *embedding[] = { "", "-e", "0", NULL };
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;
perl_run(my_perl);
/** Treat $a as an integer **/
eval_pv("$a = 3; $a **= 2", TRUE);
printf("a = %d\n", SvIV(get_sv("a", 0)));
/** Treat $a as a float **/
eval_pv("$a = 3.14; $a **= 2", TRUE);
printf("a = %f\n", SvNV(get_sv("a", 0)));
/** Treat $a as a string **/
eval_pv(
"$a = 'rekcaH lreP rehtonA tsuJ'; $a = reverse($a);", TRUE);
printf("a = %s\n", SvPV_nolen(get_sv("a", 0)));
perl_destruct(my_perl);
perl_free(my_perl);
PERL_SYS_TERM();
}
所有名稱中帶有 sv 的那些奇怪函式有助於將 Perl 純量轉換成 C 類型。它們在 perlguts 和 perlapi 中有說明。
如果您編譯並執行 string.c,您將看到使用 SvIV() 建立 int
、SvNV() 建立 float
和 SvPV() 建立字串的結果
a = 9
a = 9.859600
a = Just Another Perl Hacker
在上面的範例中,我們建立了一個暫時儲存已評估表達式計算值的全域變數。在多數情況下,取而代之從 eval_pv() 中擷取回傳值也是可行且更好的策略。範例
...
SV *val = eval_pv("reverse 'rekcaH lreP rehtonA tsuJ'", TRUE);
printf("%s\n", SvPV_nolen(val));
...
這樣,我們避免了透過不建立全域變數來造成名稱空間的污染,而且也簡化了我們的程式碼。
eval_sv() 函式讓我們評估 Perl 程式碼的字串,因此我們可以定義一些使用它來「專門」進行比對和取代的函式:match()、substitute() 和 matches()。
I32 match(SV *string, char *pattern);
給定一個字串和一個模式(例如 m/clasp/
或 /\b\w*\b/
,在您的 C 程式中可能顯示為 "/\\b\\w*\\b/"),如果字串符合模式,match() 會回傳 1,否則會回傳 0。
int substitute(SV **string, char *pattern);
給定一個指向 SV
的指標和一個 =~
運算(例如 s/bob/robert/g
或 tr[A-Z][a-z]
),substitute() 會根據運算修改 SV
內的字串,回傳所做的取代次數。
SSize_t matches(SV *string, char *pattern, AV **matches);
給定一個 SV
、一個模式和一個指向空的 AV
的指標,matches() 會在清單內容中評估 $string =~ $pattern
,並使用陣列元素填入 matches,回傳找到的比對次數。
以下是使用所有三個函式的範例程式 match.c(此處已將長行換行)
#include <EXTERN.h>
#include <perl.h>
static PerlInterpreter *my_perl;
/** my_eval_sv(code, error_check)
** kinda like eval_sv(),
** but we pop the return value off the stack
**/
SV* my_eval_sv(SV *sv, I32 croak_on_error)
{
dSP;
SV* retval;
PUSHMARK(SP);
eval_sv(sv, G_SCALAR);
SPAGAIN;
retval = POPs;
PUTBACK;
if (croak_on_error && SvTRUE(ERRSV))
croak_sv(ERRSV);
return retval;
}
/** match(string, pattern)
**
** Used for matches in a scalar context.
**
** Returns 1 if the match was successful; 0 otherwise.
**/
I32 match(SV *string, char *pattern)
{
SV *command = newSV(0), *retval;
sv_setpvf(command, "my $string = '%s'; $string =~ %s",
SvPV_nolen(string), pattern);
retval = my_eval_sv(command, TRUE);
SvREFCNT_dec(command);
return SvIV(retval);
}
/** substitute(string, pattern)
**
** Used for =~ operations that
** modify their left-hand side (s/// and tr///)
**
** Returns the number of successful matches, and
** modifies the input string if there were any.
**/
I32 substitute(SV **string, char *pattern)
{
SV *command = newSV(0), *retval;
sv_setpvf(command, "$string = '%s'; ($string =~ %s)",
SvPV_nolen(*string), pattern);
retval = my_eval_sv(command, TRUE);
SvREFCNT_dec(command);
*string = get_sv("string", 0);
return SvIV(retval);
}
/** matches(string, pattern, matches)
**
** Used for matches in a list context.
**
** Returns the number of matches,
** and fills in **matches with the matching substrings
**/
SSize_t matches(SV *string, char *pattern, AV **match_list)
{
SV *command = newSV(0);
SSize_t num_matches;
sv_setpvf(command, "my $string = '%s'; @array = ($string =~ %s)",
SvPV_nolen(string), pattern);
my_eval_sv(command, TRUE);
SvREFCNT_dec(command);
*match_list = get_av("array", 0);
num_matches = av_top_index(*match_list) + 1;
return num_matches;
}
main (int argc, char **argv, char **env)
{
char *embedding[] = { "", "-e", "0", NULL };
AV *match_list;
I32 num_matches, i;
SV *text;
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;
text = newSV(0);
sv_setpv(text, "When he is at a convenience store and the "
"bill comes to some amount like 76 cents, Maynard is "
"aware that there is something he *should* do, something "
"that will enable him to get back a quarter, but he has "
"no idea *what*. He fumbles through his red squeezey "
"changepurse and gives the boy three extra pennies with "
"his dollar, hoping that he might luck into the correct "
"amount. The boy gives him back two of his own pennies "
"and then the big shiny quarter that is his prize. "
"-RICHH");
if (match(text, "m/quarter/")) /** Does text contain 'quarter'? **/
printf("match: Text contains the word 'quarter'.\n\n");
else
printf("match: Text doesn't contain the word 'quarter'.\n\n");
if (match(text, "m/eighth/")) /** Does text contain 'eighth'? **/
printf("match: Text contains the word 'eighth'.\n\n");
else
printf("match: Text doesn't contain the word 'eighth'.\n\n");
/** Match all occurrences of /wi../ **/
num_matches = matches(text, "m/(wi..)/g", &match_list);
printf("matches: m/(wi..)/g found %d matches...\n", num_matches);
for (i = 0; i < num_matches; i++)
printf("match: %s\n",
SvPV_nolen(*av_fetch(match_list, i, FALSE)));
printf("\n");
/** Remove all vowels from text **/
num_matches = substitute(&text, "s/[aeiou]//gi");
if (num_matches) {
printf("substitute: s/[aeiou]//gi...%lu substitutions made.\n",
(unsigned long)num_matches);
printf("Now text is: %s\n\n", SvPV_nolen(text));
}
/** Attempt a substitution **/
if (!substitute(&text, "s/Perl/C/")) {
printf("substitute: s/Perl/C...No substitution made.\n\n");
}
SvREFCNT_dec(text);
PL_perl_destruct_level = 1;
perl_destruct(my_perl);
perl_free(my_perl);
PERL_SYS_TERM();
}
會產生輸出(再次說明,已將長行換行)
match: Text contains the word 'quarter'.
match: Text doesn't contain the word 'eighth'.
matches: m/(wi..)/g found 2 matches...
match: will
match: with
substitute: s/[aeiou]//gi...139 substitutions made.
Now text is: Whn h s t cnvnnc str nd th bll cms t sm mnt lk 76 cnts,
Mynrd s wr tht thr s smthng h *shld* d, smthng tht wll nbl hm t gt
bck qrtr, bt h hs n d *wht*. H fmbls thrgh hs rd sqzy chngprs nd
gvs th by thr xtr pnns wth hs dllr, hpng tht h mght lck nt th crrct
mnt. Th by gvs hm bck tw f hs wn pnns nd thn th bg shny qrtr tht s
hs prz. -RCHH
substitute: s/Perl/C...No substitution made.
在嘗試解釋堆疊時,大多數電腦科學教科書會含糊其辭地提到自助餐廳餐盤的彈簧柱:您推到堆疊上的最後一樣東西會是您彈出的第一樣東西。這對我們的目的來說就夠了:您的 C 程式會將一些引數推送到「Perl 堆疊」上,在一些神奇的事情發生時閉上眼睛,然後將結果(Perl 子常式的回傳值)從堆疊中彈出。
首先,您需要知道如何使用 newSViv() 和 sv_setnv() 以及 newAV() 和它們的所有朋友在 C 型別和 Perl 型別之間進行轉換。它們在 perlguts 和 perlapi 中有說明。
接著,您需要知道如何操作 Perl 堆疊。這在 perlcall 中有說明。
一旦您了解這些,將 Perl 嵌入 C 中就很容易了。
由於 C 沒有內建函數用於整數指數運算,讓我們讓 Perl 的 ** 運算子可用於 C(這比聽起來的還要沒用,因為 Perl 使用 C 的 pow() 函數來實作 **)。首先,我在 power.pl 中建立一個指數運算函數 stub
sub expo {
my ($a, $b) = @_;
return $a ** $b;
}
現在,我將建立一個 C 程式 power.c,其中包含 PerlPower() 函數,此函數包含將兩個引數推入 expo() 並彈出回傳值的必要 perlguts。深呼吸...
#include <EXTERN.h>
#include <perl.h>
static PerlInterpreter *my_perl;
static void
PerlPower(int a, int b)
{
dSP; /* initialize stack pointer */
ENTER; /* everything created after here */
SAVETMPS; /* ...is a temporary variable. */
PUSHMARK(SP); /* remember the stack pointer */
XPUSHs(sv_2mortal(newSViv(a))); /* push the base onto the stack */
XPUSHs(sv_2mortal(newSViv(b))); /* push the exponent onto stack */
PUTBACK; /* make local stack pointer global */
call_pv("expo", G_SCALAR); /* call the function */
SPAGAIN; /* refresh stack pointer */
/* pop the return value from stack */
printf ("%d to the %dth power is %d.\n", a, b, POPi);
PUTBACK;
FREETMPS; /* free that return value */
LEAVE; /* ...and the XPUSHed "mortal" args.*/
}
int main (int argc, char **argv, char **env)
{
char *my_argv[] = { "", "power.pl", NULL };
PERL_SYS_INIT3(&argc,&argv,&env);
my_perl = perl_alloc();
perl_construct( my_perl );
perl_parse(my_perl, NULL, 2, my_argv, (char **)NULL);
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
perl_run(my_perl);
PerlPower(3, 4); /*** Compute 3 ** 4 ***/
perl_destruct(my_perl);
perl_free(my_perl);
PERL_SYS_TERM();
exit(EXIT_SUCCESS);
}
編譯並執行
% cc -o power power.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
% power
3 to the 4th power is 81.
在開發互動式和/或潛在長時間執行的應用程式時,建議維護持續性直譯器,而不是多次配置和建構新的直譯器。主要原因是速度:因為 Perl 只會載入記憶體一次。
但是,在使用持續性直譯器時,您必須對名稱空間和變數範圍更加謹慎。在之前的範例中,我們一直在預設套件 main
中使用全域變數。我們確切地知道將執行哪些程式碼,並假設我們可以避免變數衝突和過度符號表成長。
假設您的應用程式是一個伺服器,偶爾會從某個任意檔案執行 Perl 程式碼。您的伺服器無法得知它將執行哪些程式碼。非常危險。
如果檔案是由 perl_parse()
擷取、編譯到新建構的直譯器中,並隨後使用 perl_destruct()
清除,您將受到保護,避免大多數名稱空間問題。
在這種情況下避免名稱空間衝突的一種方法是將檔案名稱轉換為保證唯一的套件名稱,然後使用 "eval" in perlfunc 將程式碼編譯到該套件中。在以下範例中,每個檔案只會編譯一次。或者,應用程式可能會選擇在不再需要檔案後清除與該檔案關聯的符號表。使用 "call_argv" in perlapi,我們將呼叫存在於檔案 persistent.pl
中的子常式 Embed::Persistent::eval_file
,並將檔案名稱和布林值清除/快取旗標作為引數傳遞。
請注意,這個程序將持續成長,以符合它使用的每個檔案。此外,可能會出現 AUTOLOAD
ed 子常式和其他導致 Perl 符號表成長的條件。您可能需要新增一些邏輯來追蹤程序大小,或在一定數量的要求後重新啟動程序,以確保將記憶體消耗降至最低。您還需要盡可能使用 "my" in perlfunc 來設定變數範圍。
package Embed::Persistent;
#persistent.pl
use strict;
our %Cache;
use Symbol qw(delete_package);
sub valid_package_name {
my($string) = @_;
$string =~ s/([^A-Za-z0-9\/])/sprintf("_%2x",unpack("C",$1))/eg;
# second pass only for words starting with a digit
$string =~ s|/(\d)|sprintf("/_%2x",unpack("C",$1))|eg;
# Dress it up as a real package name
$string =~ s|/|::|g;
return "Embed" . $string;
}
sub eval_file {
my($filename, $delete) = @_;
my $package = valid_package_name($filename);
my $mtime = -M $filename;
if(defined $Cache{$package}{mtime}
&&
$Cache{$package}{mtime} <= $mtime)
{
# we have compiled this subroutine already,
# it has not been updated on disk, nothing left to do
print STDERR "already compiled $package->handler\n";
}
else {
local *FH;
open FH, $filename or die "open '$filename' $!";
local($/) = undef;
my $sub = <FH>;
close FH;
#wrap the code into a subroutine inside our unique package
my $eval = qq{package $package; sub handler { $sub; }};
{
# hide our variables within this block
my($filename,$mtime,$package,$sub);
eval $eval;
}
die $@ if $@;
#cache it unless we're cleaning out each time
$Cache{$package}{mtime} = $mtime unless $delete;
}
eval {$package->handler;};
die $@ if $@;
delete_package($package) if $delete;
#take a look if you want
#print Devel::Symdump->rnew($package)->as_string, $/;
}
1;
__END__
/* persistent.c */
#include <EXTERN.h>
#include <perl.h>
/* 1 = clean out filename's symbol table after each request,
0 = don't
*/
#ifndef DO_CLEAN
#define DO_CLEAN 0
#endif
#define BUFFER_SIZE 1024
static PerlInterpreter *my_perl = NULL;
int
main(int argc, char **argv, char **env)
{
char *embedding[] = { "", "persistent.pl", NULL };
char *args[] = { "", DO_CLEAN, NULL };
char filename[BUFFER_SIZE];
int failing, exitstatus;
PERL_SYS_INIT3(&argc,&argv,&env);
if((my_perl = perl_alloc()) == NULL) {
fprintf(stderr, "no memory!");
exit(EXIT_FAILURE);
}
perl_construct(my_perl);
PL_origalen = 1; /* don't let $0 assignment update the
proctitle or embedding[0] */
failing = perl_parse(my_perl, NULL, 2, embedding, NULL);
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
if(!failing)
failing = perl_run(my_perl);
if(!failing) {
while(printf("Enter file name: ") &&
fgets(filename, BUFFER_SIZE, stdin)) {
filename[strlen(filename)-1] = '\0'; /* strip \n */
/* call the subroutine,
passing it the filename as an argument */
args[0] = filename;
call_argv("Embed::Persistent::eval_file",
G_DISCARD | G_EVAL, args);
/* check $@ */
if(SvTRUE(ERRSV))
fprintf(stderr, "eval error: %s\n", SvPV_nolen(ERRSV));
}
}
PL_perl_destruct_level = 0;
exitstatus = perl_destruct(my_perl);
perl_free(my_perl);
PERL_SYS_TERM();
exit(exitstatus);
}
現在編譯
% cc -o persistent persistent.c \
`perl -MExtUtils::Embed -e ccopts -e ldopts`
以下是範例指令碼檔案
#test.pl
my $string = "hello";
foo($string);
sub foo {
print "foo says: @_\n";
}
現在執行
% persistent
Enter file name: test.pl
foo says: hello
Enter file name: test.pl
already compiled Embed::test_2epl->handler
foo says: hello
Enter file name: ^C
傳統上,END 區塊會在 perl_run 結束時執行。這會對從不呼叫 perl_run 的應用程式造成問題。自 perl 5.7.2 起,你可以指定 PL_exit_flags |= PERL_EXIT_DESTRUCT_END
以取得新的行為。這也會在 perl_parse 失敗時執行 END 區塊,而 perl_destruct
會傳回結束值。
當 perl 腳本指定一個值給 $0 時,perl 執行時間會嘗試讓這個值顯示為「ps」報告的程式名稱,方法是更新傳遞給 perl_parse() 的 argv 所指的記憶體,並呼叫 API 函式,例如 setproctitle()(如果可用)。當嵌入 perl 時,這種行為可能不適當,而可以在呼叫 perl_parse() 之前將值 1
指定給變數 PL_origalen
來停用它。
例如,如果移除 PL_origalen = 1;
指定,則上面 persistent.c 範例在指定 $0 時可能會發生區段錯誤。這是因為 perl 會嘗試寫入 embedding[]
字串的唯讀記憶體。
一些罕見的應用程式需要在一個工作階段中建立多個直譯器。此類應用程式可能會偶爾決定釋放與直譯器相關的任何資源。
程式必須注意,在建立下一個直譯器 之前 執行此動作。預設情況下,當 perl 未使用任何特殊選項建置時,全域變數 PL_perl_destruct_level
會設定為 0
,因為當程式在其整個生命週期中只建立一個直譯器時,通常不需要額外的清理。
將 PL_perl_destruct_level
設定為 1
會讓所有東西乾乾淨淨
while(1) {
...
/* reset global variables here with PL_perl_destruct_level = 1 */
PL_perl_destruct_level = 1;
perl_construct(my_perl);
...
/* clean and reset _everything_ during perl_destruct */
PL_perl_destruct_level = 1;
perl_destruct(my_perl);
perl_free(my_perl);
...
/* let's go do it again! */
}
當呼叫 perl_destruct() 時,直譯器的語法剖析樹和符號表會被清理,而全域變數會被重設。需要第二次指定 PL_perl_destruct_level
,因為 perl_construct 會將它重設為 0
。
現在假設我們有多個解釋器執行個體同時執行。這可行,但前提是您在建置 Perl 時使用了設定選項 -Dusemultiplicity
或選項 -Dusethreads -Duseithreads
。預設情況下,啟用其中一個設定選項會將每個解釋器的全域變數 PL_perl_destruct_level
設為 1
,以便徹底清除並正確初始化解釋器變數。即使您不打算同時執行兩個或多個解釋器,而是像上述範例一樣依序執行,建議您使用 -Dusemultiplicity
選項建置 Perl,否則某些解釋器變數可能不會在連續執行之間正確初始化,而您的應用程式可能會當機。
另請參閱 "perlxs 中的「執行緒感知系統介面」"。
如果您打算在不同的執行緒中同時執行多個解釋器,使用 -Dusethreads -Duseithreads
會比 -Dusemultiplicity
更合適,因為它支援連結至系統的執行緒函式庫與解釋器。
讓我們試試看
#include <EXTERN.h>
#include <perl.h>
/* we're going to embed two interpreters */
#define SAY_HELLO "-e", "print qq(Hi, I'm $^X\n)"
int main(int argc, char **argv, char **env)
{
PerlInterpreter *one_perl, *two_perl;
char *one_args[] = { "one_perl", SAY_HELLO, NULL };
char *two_args[] = { "two_perl", SAY_HELLO, NULL };
PERL_SYS_INIT3(&argc,&argv,&env);
one_perl = perl_alloc();
two_perl = perl_alloc();
PERL_SET_CONTEXT(one_perl);
perl_construct(one_perl);
PERL_SET_CONTEXT(two_perl);
perl_construct(two_perl);
PERL_SET_CONTEXT(one_perl);
perl_parse(one_perl, NULL, 3, one_args, (char **)NULL);
PERL_SET_CONTEXT(two_perl);
perl_parse(two_perl, NULL, 3, two_args, (char **)NULL);
PERL_SET_CONTEXT(one_perl);
perl_run(one_perl);
PERL_SET_CONTEXT(two_perl);
perl_run(two_perl);
PERL_SET_CONTEXT(one_perl);
perl_destruct(one_perl);
PERL_SET_CONTEXT(two_perl);
perl_destruct(two_perl);
PERL_SET_CONTEXT(one_perl);
perl_free(one_perl);
PERL_SET_CONTEXT(two_perl);
perl_free(two_perl);
PERL_SYS_TERM();
exit(EXIT_SUCCESS);
}
請注意對 PERL_SET_CONTEXT() 的呼叫。這些呼叫是必要的,用於初始化全域狀態,追蹤哪個解釋器是特定程序或執行它的執行緒上的「目前」解釋器。如果您有多個解釋器,並以交錯的方式對兩個解釋器進行 perl API 呼叫,則應始終使用它。
每當執行緒使用未建立它的 interp
(使用 perl_alloc() 或更深奧的 perl_clone())時,也應呼叫 PERL_SET_CONTEXT(interp)。
照常編譯
% cc -o multiplicity multiplicity.c \
`perl -MExtUtils::Embed -e ccopts -e ldopts`
執行它,執行它
% multiplicity
Hi, I'm one_perl
Hi, I'm two_perl
如果您已試用上述範例,並嘗試嵌入一個腳本,而該腳本會 use() 一個 Perl 模組(例如 Socket),而該模組本身使用 C 或 C++ 函式庫,則可能會發生這種情況
Can't load module Socket, dynamic loading not available in this perl.
(You may need to build a new perl executable which either supports
dynamic loading or has the Socket module statically linked into it.)
哪裡出錯了?
您的解釋器本身不知道如何與這些延伸模組進行通訊。一點點的黏著劑將會有幫助。到目前為止,您一直在呼叫 perl_parse(),將 NULL 傳遞給第二個參數
perl_parse(my_perl, NULL, argc, my_argv, NULL);
這時可以插入黏著劑程式碼,以建立 Perl 與連結的 C/C++ 常式的初始接觸。讓我們來看一下 perlmain.c 的一些部分,以了解 Perl 如何執行此操作
static void xs_init (pTHX);
EXTERN_C void boot_DynaLoader (pTHX_ CV* cv);
EXTERN_C void boot_Socket (pTHX_ CV* cv);
EXTERN_C void
xs_init(pTHX)
{
char *file = __FILE__;
/* DynaLoader is a special case */
newXS("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
newXS("Socket::bootstrap", boot_Socket, file);
}
簡單來說:對於與 Perl 可執行檔連結的每個延伸模組(在您的電腦上進行初始設定時或新增新的延伸模組時確定),會建立一個 Perl 子常式,以納入延伸模組的常式。通常,該子常式會命名為 Module::bootstrap(),並在您說 use Module 時呼叫。反過來,這會連結到一個 XSUB,boot_Module,它會為延伸模組的每個 XSUB 建立一個 Perl 對應。不用擔心這個部分;把它留給 xsubpp 和延伸模組作者。如果您的延伸模組是動態載入的,DynaLoader 會為您即時建立 Module::bootstrap()。事實上,如果您有一個可用的 DynaLoader,則很少需要靜態連結任何其他延伸模組。
取得此程式碼後,將它貼到 perl_parse() 的第二個參數中
perl_parse(my_perl, xs_init, argc, my_argv, NULL);
然後編譯
% cc -o interp interp.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
% interp
use Socket;
use SomeDynamicallyLoadedModule;
print "Now I can use extensions!\n"'
ExtUtils::Embed 也可以自動撰寫 xs_init 黏著劑程式碼。
% perl -MExtUtils::Embed -e xsinit -- -o perlxsi.c
% cc -c perlxsi.c `perl -MExtUtils::Embed -e ccopts`
% cc -c interp.c `perl -MExtUtils::Embed -e ccopts`
% cc -o interp perlxsi.o interp.o `perl -MExtUtils::Embed -e ldopts`
請參閱 perlxs、perlguts 和 perlapi 以取得更多詳細資訊。
(請參閱 perllocale 以取得有關這些資訊。)當 Perl 解釋器正常啟動時,它會告訴系統它想要使用系統的預設地區設定。這通常是「C」或「POSIX」地區設定,但並非一定如此。在 perl 程式碼中沒有 "use locale"
的情況下,這通常沒有影響(但請參閱 "Not within the scope of "use locale"" in perllocale)。此外,如果您要在嵌入式 perl 中使用的地區設定與系統預設值相同,則不會有問題。但是,如果您已設定並想要使用與系統預設值不同的地區設定,則此方法無法使用。從 Perl v5.20 開始,您可以告訴嵌入式 Perl 解釋器地區設定已正確設定,並略過執行自己的正常初始化。如果環境變數 PERL_SKIP_LOCALE_INIT
已設定(即使設定為 0 或 ""
),它就會略過。具有此功能的 perl 會定義 C 預處理器符號 HAS_SKIP_LOCALE_INIT
。這允許必須使用多個 Perl 版本的程式碼在遇到較早版本的 Perl 時執行某種解決方法。
如果您的程式正在使用 POSIX 2008 多執行緒地區設定功能,您應該切換到全域地區設定,並在啟動 Perl 解釋器之前正確設定它。然後,它會適當地切換回使用執行緒安全函式。
如果您完全隱藏 Perl 公共 API 的簡短形式,請將 -DPERL_NO_SHORT_NAMES 新增到編譯旗標。這表示例如,您不能撰寫
warn("%d bottles of beer on the wall", bottlecount);
您必須寫出明確的完整形式
Perl_warn(aTHX_ "%d bottles of beer on the wall", bottlecount);
(請參閱 perlguts 中的「背景和 MULTIPLICITY」 以了解 aTHX_
的說明。) 隱藏簡短形式對於避免與其他軟體套件發生各種令人討厭的(C 預處理器或其他)衝突非常有用(Perl 使用這些簡短名稱定義了大約 2400 個 API,多或少幾百個,因此肯定有衝突的空間。)
您有時可以在 C 中撰寫更快的程式碼,但您始終可以在 Perl 中更快速地撰寫程式碼。因為您可以從另一個使用它們,請根據需要將它們組合起來。
Jon Orwant <orwant@media.mit.edu> 和 Doug MacEachern <dougm@covalent.net>,Tim Bunce、Tom Christiansen、Guy Decoux、Hallvard Furuseth、Dov Grobgeld 和 Ilya Zakharevich 做出了少量貢獻。
Doug MacEachern 在 The Perl Journal 第 1 卷第 4 期中有一篇關於嵌入的文章(http://www.tpj.com/)。Doug 也是最廣泛使用的 Perl 嵌入的開發者:mod_perl 系統(perl.apache.org),它將 Perl 嵌入到 Apache 網路伺服器中。Oracle、Binary Evolution、ActiveState 和 Ben Sugars 的 nsapi_perl 已將此模型用於 Oracle、Netscape 和 Internet Information Server Perl 外掛程式。
版權所有 (C) 1995、1996、1997、1998 Doug MacEachern 和 Jon Orwant。保留所有權利。
本文件可以在與 Perl 相同的條款下分發。