Perl 文檔中文計劃】《在 C 中嵌入 Perl》翻譯完成 zz
出處: www.chinaunix.net
本文由 redcandle 翻譯完成。
最新版本可以從這里獲?。≒OD 格式）：
http://svn.perlchina.org/trunk/POD2-CN/lib/POD2/CN/perlembed.pod
[code]
NAME
perlembed - 在 C 程序中嵌入 perl
DESCRIPTION
導言
你是想要：
在 Perl 中使用 C？
閱讀 perlxstut、perlxs、h2xs、perlguts 和 perlapi。
在 Perl 中使用 Unix 程序？
閱讀反引用符（back-quote）和 L
"exec"。
在 Perl 中使用 Perl？
閱讀 "do" in perlfunc、"eval" in perlfunc、"require" in perlfunc
以及 "use" in perlfunc。
在 C 中使用 C？
重新考慮一下你的設計。
在 C 中使用 Perl？
請繼續……
路標
* 編譯你的 C 程序
* 在你的 C 程序中加入一個(gè) Perl 解釋器
* 在 C 程序中調用一個(gè) Perl 函數
* 在 C 程序中對一個(gè) Perl 語(yǔ)句求值
* 在 C 程序中進(jìn)行 Perl 模式匹配和替換
* 在 C 程序中修改 Perl 參數棧
* 保持一個(gè)持久的解釋器
* 保持多個(gè)解釋器實(shí)例
* 在 C 程序中使用 Perl 模塊，模塊本身使用 C 庫
* 在 Win32 下內嵌 Perl
編譯你的 C 程序
你不是唯一一個(gè)在編譯本文檔的例子時(shí)遇到困難的。一個(gè)重要規則是：用編譯你的
Perl 相同規則來(lái)編譯程序（對不起，對你大聲喊了）。
每個(gè)使用 Perl 的 C 程序都必須鏈接到 *perl 庫*。*perl 庫* 是 什么？Perl
本身是用 C 來(lái)寫(xiě)的，perl library 是一系列編譯過(guò)的 C 程序，這
些將用于創(chuàng )建你的可執行 perl 程序（*/usr/bin/perl* 或者等價(jià)的東西）。
（推論：除非 Perl 是在你的機器上編譯的，或者合適安裝的，否則你將不能在 C
程序中使用 Perl——這也是為什么你不應該從另一臺機器中復制 Perl 的可執
行程序而不復制 *lib* 目錄。）
當你在 C 中使用 Perl 時(shí)，你的 C 程序將（通常是這樣）分配、運行然后釋放
一個(gè) *PerlInterpreter* 對象，這個(gè)對象是在 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
執行這樣的語(yǔ)句可以找到 CORE：
perl -MConfig -e ‘print $Config{archlib}‘
這是在我的 Linux 機器上編譯下一節中例子 "Adding a Perl interpreter to
your C program" 的方法：
% 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，這個(gè)“咒語(yǔ)”有一點(diǎn)不同：
% cc -O2 -Olimit 2900 -DSTANDARD_C -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/...*）。如果你的編
譯器抱怨某個(gè)函數沒(méi)有定義，或者它找不到 *-lperl*，這時(shí)你需要更改在 "-L"
之后的路徑。如果它抱怨找不到 *EXTERN.h* 和 *perl.h*，你需要更 改在 "-I"
之后的路徑。
你可能還要加上一些額外的庫。加什么呢？可能是用下面語(yǔ)句輸出的那些：
perl -MConfig -e ‘print $Config{libs}‘
如果你的 perl 庫配置是適當的，已經(jīng)安裝了 ExtUtils::Embed 模塊，它會(huì )
為你決定所有的這些信息：
% cc -o interp interp.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
如果 ExtUtils::Embed 模塊不是你的 Perl 發(fā)行版的一部分，你可以從
http://www.perl.com/perl/CPAN/modules/by-module/ExtUtils/
獲得。（如果本文檔是來(lái)自你的 Perl 發(fā)行版，那你用的是 5.004 或者更好，
你就已經(jīng)有這個(gè)模塊了。）
CPAN 上 ExtUtils::Embed 套裝也包含本文檔例子的所有源代碼，測試，額
外的例子以及其它可能有用的信息。
在 C 程序中加入 Perl 解釋器
在某種意義上說(shuō)，perl（這里指 C 程序）是一個(gè)內嵌 Perl（這里指語(yǔ)言）的一
個(gè)很好的例子。所以我將用包含在發(fā)行版源文件中的 *miniperlmain.c* 來(lái)演
示。這是一個(gè)拙劣的、不可移植的 *miniperlmain.c* 版本，但是包含了內嵌
的本質(zhì)：
#include
#include
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();
}
注意，我們沒(méi)有用到 "env" 指針。通常只是作為 "perl_parse" 的最后一個(gè)
參數提供給它。這里 "env" 用 "NULL" 代替了，表示使用當前的環(huán)境。
PERL_SYS_INIT3() 和 PERL_SYS_TERM() 宏為 Perl 解釋器的運行提供了必要
的、系統特定的 C 運行環(huán)境。由于 PERL_SYS_INIT3() 可能修改 "env"，所
有最好提供 perl_parse() 一個(gè) "env" 參數。
現在編譯成可執行程序（我稱(chēng)之為 *interp.c*）：
% cc -o interp interp.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
在成功編譯后，你就可以用 *interp* 就像 perl 本身一樣：
% interp
print "Pretty Good Perl \n";
print "10890 - 9801 is ", 10890 - 9801;
Pretty Good Perl
10890 - 9801 is 1089
或者
% interp -e ‘printf("%x", 3735928559)‘
deadbeef
可以在你的 C 程序中讀入和執行 Perl 語(yǔ)句，只需要在調用 *perl_run* 前放
置文件名在 *argv[1]* 中。
在 C 程序中調用 Perl 函數
要調用單個(gè) Perl 函數，你可以使用任何一個(gè)在 perlcall 中介紹的 call_*
函數。 在這個(gè)例子中，我們使用 "all_argv"。
下面顯示一個(gè)我稱(chēng)為 *showtime.c* 的程序：
#include
#include
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();
}
這里 *showtime* 是一個(gè)沒(méi)有參數的 Perl 函數（就是 *G_NOARGS*），而且
忽略一返回值（就是 *G_DISCARD*）。在 perlcall 中有討論這些以及其它
標簽。
我在一個(gè)稱(chēng)為 *showtime.pl* 文件中定義這個(gè) *showtime* 函數：
print "I shan‘t be printed.";
sub showtime {
print time;
}
很簡(jiǎn)單?，F在編譯并運行：
% cc -o showtime showtime.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
% showtime showtime.pl
818284590
產(chǎn)生從 1970 年 1 月 1 日（Unix 紀元的開(kāi)始）到現在的秒數，這是我寫(xiě)這句
話(huà)的時(shí)間。
在這個(gè)特殊例子中，我們不必調用 *perl_run*，因為我們設置了 PL_exit_flag
PERL_EXIT_DESTRUCT_END，這將在 perl_destruct 中執行 END 塊。
如果你想要傳遞參數給 Perl 函數，你可以在以 "NULL" 結尾的 "args" 列表
中加入字符串傳遞給 *call_argv*。對于其它數據類(lèi)型，或者要檢查返回值類(lèi)
型，你需要操作 Perl 參數棧。在 "Fiddling with the Perl stack from your C
program" 中演示了這個(gè)過(guò)程。
在 C 程序中對 Perl 語(yǔ)句求值
Perl 提供兩個(gè) API 函數來(lái)對一小段 Perl 代碼進(jìn)行求值。這就是 "eval_sv" in
perlapi 和 "eval_pv" in perlapi。
在 C 程序中只有這兩個(gè)函數，你可以執行一段 Perl 代碼。你的代碼可以任意
長(cháng)，可以包含多個(gè)語(yǔ)句，你可以用 "use" in perlfunc、"require" in
perlfunc、 和 "do" in perlfunc 來(lái)引入一個(gè) Perl 文件。
*eval_pv* 可以對單個(gè)的 Perl 字符串求值，然后可以提取出變量轉換為 C 類(lèi)
型。下面這個(gè)程序 *string.c* 執行三個(gè) Perl 字符串，第一個(gè)提取出一個(gè) *int*
變量，第二個(gè)提取 "float" 變量，第三個(gè)提取 "char *" 變量。
#include
#include
static PerlInterpreter *my_perl;
main (int argc, char **argv, char **env)
{
STRLEN n_a;
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;
perl_run(my_perl);
/** Treat $a as an integer **/
eval_pv("$a = 3; $a **= 2", TRUE);
printf("a = %d\n", SvIV(get_sv("a", FALSE)));
/** Treat $a as a float **/
eval_pv("$a = 3.14; $a **= 2", TRUE);
printf("a = %f\n", SvNV(get_sv("a", FALSE)));
/** Treat $a as a string **/
eval_pv("$a = ‘rekcaH lreP rehtonA tsuJ‘; $a = reverse($a);", TRUE);
printf("a = %s\n", SvPV(get_sv("a", FALSE), n_a));
perl_destruct(my_perl);
perl_free(my_perl);
PERL_SYS_TERM();
}
所有在名字中含有 *sv* 的奇怪函數都是為了協(xié)助將 Perl 標量轉換為 C 類(lèi)型。
這在 perlguts 和 perlapi 中有描述。
如果你編譯并運行 *string.c*，你可以用 *SvIV()* 創(chuàng )建一個(gè) "int"，*SvNV()*
創(chuàng )建一個(gè) "float"，*SvPV()* 創(chuàng )建一個(gè)字符串，這樣可 以看到結果。
a = 9
a = 9.859600
a = Just Another Perl Hacker
在上面的例子中，我們創(chuàng )建了一個(gè)全局變量來(lái)臨時(shí)保存求值后計算的結果。也可
以，并在大多數情況下最好用 *eval_pv()* 的返回值。例如：
...
STRLEN n_a;
SV *val = eval_pv("reverse ‘rekcaH lreP rehtonA tsuJ‘", TRUE);
printf("%s\n", SvPV(val,n_a));
...
這樣不用創(chuàng )建一個(gè)全局變量，可以避免污染名字空間，也同樣使代碼簡(jiǎn)化。
在 C 程序中進(jìn)行 Perl 模式匹配和替換
*eval_sv()* 函數可以對 Perl 代碼字符串求值，所以我們可以定義一些函數
專(zhuān)門(mén)進(jìn)行匹配和替換：*match()*，*substitute()* 和 *matches()*。
I32 match(SV *string, char *pattern);
假定有一個(gè)字符串和一個(gè)模式（例如 "m/clasp/" 或者 "/\b\w*\b/"，在你的 C
程序中可能是這樣的 "/\\b\\w*\\b/"）。如果字符串匹配一個(gè)模式則返回
1，否則返回 0。
int substitute(SV **string, char *pattern);
假定有一個(gè)指向 "SV" 的指針和 "=~" 操作符（例如 "s/bob/robert/g" 或 者
"tr[A-Z][a-z]"），substitute() 根據這個(gè)操作符修改 "SV"，返回替換
操作的次數。
int matches(SV *string, char *pattern, AV **matches);
假定有一個(gè) "SV"，一個(gè)模式和一個(gè)指向一個(gè)空 "AV" 的指針，match() 在一
個(gè)列表上下文中對 "$string =~ $pattern" 求值，在 *matches* 中填充數
組，返回匹配的數目。
這是一個(gè)使用了三個(gè)函數的樣例，*match.c*（過(guò)長(cháng)的行折疊了）：
#include
#include
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;
STRLEN n_a;
PUSHMARK(SP);
eval_sv(sv, G_SCALAR);
SPAGAIN;
retval = POPs;
PUTBACK;
if (croak_on_error && SvTRUE(ERRSV))
croak(SvPVx(ERRSV, n_a));
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(1099, 0), *retval;
STRLEN n_a;
sv_setpvf(command, "my $string = ‘%s‘; $string =~ %s",
SvPV(string,n_a), 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(1099, 0), *retval;
STRLEN n_a;
sv_setpvf(command, "$string = ‘%s‘; ($string =~ %s)",
SvPV(*string,n_a), pattern);
retval = my_eval_sv(command, TRUE);
SvREFCNT_dec(command);
*string = get_sv("string", FALSE);
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
**/
I32 matches(SV *string, char *pattern, AV **match_list)
{
SV *command = NEWSV(1099, 0);
I32 num_matches;
STRLEN n_a;
sv_setpvf(command, "my $string = ‘%s‘; @array = ($string =~ %s)",
SvPV(string,n_a), pattern);
my_eval_sv(command, TRUE);
SvREFCNT_dec(command);
*match_list = get_av("array", FALSE);
num_matches = av_len(*match_list) + 1; /** assume $[ is 0 **/
return num_matches;
}
main (int argc, char **argv, char **env)
{
char *embedding[] = { "", "-e", "0" };
AV *match_list;
I32 num_matches, i;
SV *text;
STRLEN n_a;
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(1099,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(*av_fetch(match_list, i, FALSE),n_a));
printf("\n");
/** Remove all vowels from text **/
num_matches = substitute(&text, "s/[aeiou]//gi");
if (num_matches) {
printf("substitute: s/[aeiou]//gi...%d substitutions made.\n",
num_matches);
printf("Now text is: %s\n\n", SvPV(text,n_a));
}
/** 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();
}
它產(chǎn)生這樣的輸出（過(guò)長(cháng)的行再次折疊了）：
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 參數棧
大多數計算機教科書(shū)對于棧的解釋都是重復關(guān)于放置咖啡盤(pán)的比喻（most
computer science textbooks mumble something about spring-loaded columns
of cafeteria plates）：最后你放到棧中的東西就是你第一個(gè)取出的。
這是我們的要做的：C 程序放置一些參數到“Perl
棧”中，當魔術(shù)發(fā)生時(shí)閉上它的 眼睛，然后從棧上取出結果——Perl
函數的返回值（That‘ll do for our purposes: your C program will push some
arguments onto "the Perl stack", shut its eyes while some magic happens,
and then pop the results--the return value of your Perl subroutine--off
the stack.）
首先，你要知道怎樣在 C 類(lèi)型和 Perl 類(lèi)型之間轉換，使用 newSViv()、
sv_setnv、newAV() 以及其它它們的朋友。它們在 perlguts 和 perlapi
中有說(shuō)明。
然后你要知道如何操縱 Perl 參數棧。在 perlcall 中有說(shuō)明。
一旦你明白這些，在 C 中嵌入 Perl 是很簡(jiǎn)單的。
因為 C 沒(méi)有內建的函數進(jìn)行整數的指數運算，讓我們用 Perl 的 ** 運算符實(shí)
現它（這比它聽(tīng)上去沒(méi)用得多，因為 Perl 用 C *pow()* 函數實(shí)現 **）。首
先在 *power.pl* 中創(chuàng )建一個(gè)簡(jiǎn)短的指數函數：
sub expo {
my ($a, $b) = @_;
return $a ** $b;
}
現在我創(chuàng )建一個(gè) C 程序 *power.c*，通過(guò) *PerlPower()* （包含所有必須的
perlguts）將兩個(gè)參數放到*expo()* 并取出返回值。深吸一口氣：
#include
#include
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" };
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();
}
編譯并運行：
% cc -o power power.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
% power
3 to the 4th power is 81.
保持一個(gè)持久的解釋器
當開(kāi)發(fā)一個(gè)交互而且（或者）可能是持久運行的應用程序，不要多次分配構建新
的解釋器，保持一個(gè)持久的解釋器是一個(gè)好主意。最主要的原因是速度：因為
Perl 只要導入到內存中一次。
盡管這樣，當使用一個(gè)持久的解釋器時(shí)要特別小心名字空間和變量作用域。在前
面的例子中，我們在默認的包 "main" 中使用全局變量。我們很清楚地知道代
碼是怎樣運行的，并且假定我們能夠避免變量沖突和符號表的增長(cháng)。
假定你的應用程序是一個(gè)服務(wù)器，它偶爾運行一些文件中的 Perl 代碼。你的服
務(wù)器是不知道要運行什么代碼的。這很危險。
如果文件用 "perl_parse()" 引入的，編譯成一個(gè)新創(chuàng )建的解釋器，然后接著(zhù) 用
"perl_destruct()" 作一次清理，這樣就可以屏蔽了大多數的名字空間的問(wèn) 題。
一個(gè)避免名字空間沖突的方法是將文件名轉換成一個(gè)唯一的包名，然后用 "eval"
in perlfunc 將這段代碼編譯到這個(gè)包中。在下面的例子中，每個(gè)文件只
編譯一次?；蛘哌@個(gè)應用程序在一個(gè)文件中的符號表不再需要時(shí)可能會(huì )清除這個(gè)
符號表。使用 "call_argv" in perlapi，我們調用在 "persistent.pl" 文件中
的 "Embed::Persistent::eval_file"，傳遞一個(gè)文件名以及一個(gè)清除或者緩沖
的標簽作為參數。
注意到對于每個(gè)使用的文件，這個(gè)進(jìn)程都要不斷增長(cháng)。另外，可能有 "AUTOLOAD"
函數或者其它條件導致 Perl 符號表的增長(cháng)。你可能想加入一些邏
輯判斷來(lái)跟蹤進(jìn)程的大小，或者在一定次數的請求之后重新啟動(dòng)一次，這樣來(lái)保證
內 存的消耗是保證最小的。你可能還會(huì )在可能的時(shí)候用 "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 =
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
#include
/* 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" };
char *args[] = { "", DO_CLEAN, NULL };
char filename[BUFFER_SIZE];
int exitstatus = 0;
STRLEN n_a;
PERL_SYS_INIT3(&argc,&argv,&env);
if((my_perl = perl_alloc()) == NULL) {
fprintf(stderr, "no memory!");
exit(1);
}
perl_construct(my_perl);
exitstatus = perl_parse(my_perl, NULL, 2, embedding, NULL);
PL_exit_flags |= PERL_EXIT_DESTRUCT_END;
if(!exitstatus) {
exitstatus = perl_run(my_perl);
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(ERRSV,n_a));
}
}
PL_perl_destruct_level = 0;
perl_destruct(my_perl);
perl_free(my_perl);
PERL_SYS_TERM();
exit(exitstatus);
}
Now compile:
% cc -o persistent persistent.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
Here‘s an example script file:
#test.pl
my $string = "hello";
foo($string);
sub foo {
print "foo says: @_\n";
}
Now run:
% 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 塊
傳統的 END 塊在 perl_run 的結束時(shí)執行了。對于不調用 perl_run 的應用程
序這會(huì )有一些問(wèn)題。從 perl 5.7.2 開(kāi)始，你可以指定 "PL_exit_flags |=
PERL_EXIT_DESTRUCT_END" 來(lái)獲得新特性。這也可以在 perl_parse 失敗之后調
用 END 塊，"perl_destruct" 將返回退出值。
保持多個(gè)解釋器的實(shí)例
一些罕見(jiàn)的應用程序在一次對話(huà)中需要創(chuàng )建多個(gè)解釋器?？赡芤既会尫沤忉屍?br>對應的資源。
這個(gè)程序要確保要在下一個(gè)解釋器就做這些事。默認情況下，當 perl 不用任何
選項構建時(shí)，全局變量 "PL_perl_destruct_level" 設置為 0。因為在一個(gè)程
序生存期中只創(chuàng )建一個(gè)解釋器是不需要進(jìn)行額外的清理。
將 "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()* 調用時(shí)，這個(gè)解釋器的語(yǔ)法解析樹(shù)和符號表就被清除，
全局變量也被重新設置。因為 perl_construct 會(huì )將 "PL_perl_destruct_level"
重新設置為 0，所以要再一次設置 "PL_perl_destruct_level"。
現在假定我們同時(shí)有多個(gè)解釋器運行。這是可以做到的，但是只有在你創(chuàng )建 perl
時(shí)使用配置選項 "-Dusemultiplicity" 或者 "-Dusethreads
-Duseithreads"。缺省情況下，打開(kāi)這些配置選項中的一個(gè)就把這個(gè)
per-interpreter 全局變量 "PL_perl_destruct_level" 設置為 1。所以清理
是自動(dòng)的，并且解釋器變量變正確的初始化。即使你不用同時(shí)運行多個(gè)解釋器，
而是要像前面的例子那樣順序運行，但還是建議你用 "-Dusemultiplicity"
選項來(lái)編譯
perl。否則一些解釋器的變量在連續運行過(guò)程中不會(huì )正確的初始化，你
的運行程序可能會(huì )崩潰。
如果你打算在不同線(xiàn)程中并發(fā)運行多個(gè)解釋器時(shí)，使用 "-Dusethreads
-Duseithreads" 而不是"-Dusemultiplicity" 可能更合適。因為這可以對解釋
器支持鏈接到系統的線(xiàn)程庫。
讓我們來(lái)試一下：
#include
/* we‘re going to embed two interpreters */
/* 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 };
char *two_args[] = { "two_perl", SAY_HELLO };
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();
}
注意 PERL_SET_CONTEXT() 的調用。這對于全局狀態(tài)的初始化中必須的（ These
are necessary to initialize the global state that tracks which
interpreter is the "current" one on the particular process or thread
that may be running it.）如果你有多個(gè)解釋器并且同時(shí)對這些解釋器交叉調 用
perl API，就應該總是使用它。
當 "interp" 在一個(gè)不是創(chuàng )建它的線(xiàn)程（使用 perl_alloc() 或者更深奧 的
perl_clone()）使用時(shí)，也應該調用 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
在你的 C 程序中使用 Perl 模塊，這些模塊本身也使用 C 庫
如果你在使用上面的例子中試圖嵌入一個(gè)腳本，這個(gè)腳本調用一個(gè)使用 C 或者
C++ 庫的 Perl 模塊（例如 *Socket*），可能會(huì )發(fā)生：
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.)
出什么錯了？
你的解釋器不知道怎樣與這些擴展交流。一個(gè)小小的粘合代碼將會(huì )起到作用。直
到現在你還是用 NULL 作為第二個(gè)參數調用 *perl_parse()*。
perl_parse(my_perl, NULL, argc, my_argv, NULL);
這是使用粘合代碼的地方，它在 Perl 和鏈接的 C/C++ 函數創(chuàng )建起始的連接。
讓我們看看在 *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);
}
對于每個(gè)要鏈接到你的 Perl 可執行程序的擴展（由你電腦的初始化配置決定或
者當加入一個(gè)新的擴展），創(chuàng )建一個(gè) Perl 函數整合擴展中的函數。通常這個(gè)函
數叫 *Module::boostrap()*，當你使用 *use Module* 就調用了這個(gè)函數。 In
turn, this hooks into an XSUB, *boot_Module*, which creates a Perl
counterpart for each of the extension‘s XSUBs. Don‘t worry about this
part; leave that to the *xsubpp* and extension authors. If your
extension is dynamically loaded, DynaLoader creates
*Module::bootstrap()* for you on the fly. In fact, if you have a working
DynaLoader then there is rarely any need to link in any other extensions
statically.
一旦你有這段代碼，把它加到 *perl_parse()* 的第二個(gè)參數中：
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 也能自動(dòng)寫(xiě) *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。
在 Win32 嵌入 Perl
一般，這里顯示的所有代碼在 Windows 下不用任何修改就能工作。
盡管這樣，這里有一些命令行例子的警告。對于初學(xué)者，在 Win32 本身的命令
行中是不能使用反引號的。在 CPAN 的 ExtUtils::Embed 中有一個(gè)稱(chēng)為 genmake
腳本。這可以從單個(gè)的 C 源文件中創(chuàng )建一個(gè)簡(jiǎn)單的 makefile?？?以這樣使用：
C:\ExtUtils-Embed\eg> perl genmake interp.c
C:\ExtUtils-Embed\eg> nmake
C:\ExtUtils-Embed\eg> interp -e "print qq{I‘m embedded in Win32!\n}"
你可能想在 Microsoft Developer Studio 中使用更穩健的環(huán)境（ You may wish
to use a more robust environment such as the Microsoft Developer
Studio.）。在這種情況下中，用這個(gè)來(lái)產(chǎn)生 perlxsi.c：
perl -MExtUtils::Embed -e xsinit
創(chuàng )建一個(gè)新的工程，然后 Insert -> Files 到工程中：perlxsi.c，perl.lib，
和你自己的源文件，例如 interp.c。一般你可以在 C:\perl\lib\CORE 中找 到
perl.lib。如果沒(méi)有的話(huà)，你可以用 "perl -V:archlib" 中找到 CORE
目錄。studio 還要知道在哪里找到 Perl 的 include 文件。這個(gè)路徑可以通過(guò)
Tools -> Options -> Directories 菜單來(lái)加入。最后，選擇 Build -> Build
interp.exe，這樣就好了。
隱藏 Perl_
在編譯標簽中加入 -DPERL_NO_SHORT_NAMES，你就可以隱藏 Perl 公共接口的簡(jiǎn)短
形式。這意味著(zhù)你不能這樣寫(xiě)：
warn("%d bottles of beer on the wall", bottlecount);
你必須寫(xiě)明確完全的形式：
Perl_warn(aTHX_ "%d bottles of beer on the wall", bottlecount);
（參考 "Background and PERL_IMPLICIT_CONTEXT for the explanation of the
"aTHX_"." in perlguts）隱藏簡(jiǎn)短的形式對于避免和其它軟件包的沖突（C
預處理 或者其它）。（Perl 用簡(jiǎn)短名字定義了 2400
API，所以很有可能發(fā)生沖突。）
MORAL
有時(shí)可以在 C 中寫(xiě)出 *運行更快的代碼（write faster
code）*，但是你總是可以在 Perl 中*更快地寫(xiě)出代碼（write code
faster）*。因為你可以相互使用對方，只 要你需要可以結合起來(lái)。
AUTHOR
Jon Orwant
Christiansen, Guy Decoux, Hallvard Furuseth, Dov Grobgeld, and Ilya
Zakharevich.
Doug MacEachern has an article on embedding in Volume 1, Issue 4 of The
Perl Journal ( http://www.tpj.com/ ). Doug is also the developer of the
most widely-used Perl embedding: the mod_perl system (perl.apache.org),
which embeds Perl in the Apache web server. Oracle, Binary Evolution,
ActiveState, and Ben Sugars‘s nsapi_perl have used this model for
Oracle, Netscape and Internet Information Server Perl plugins.
July 22, 1998
COPYRIGHT
Copyright (C) 1995, 1996, 1997, 1998 Doug MacEachern and Jon Orwant. All
Rights Reserved.
Permission is granted to make and distribute verbatim copies of this
documentation provided the copyright notice and this permission notice
are preserved on all copies.
Permission is granted to copy and distribute modified versions of this
documentation under the conditions for verbatim copying, provided also
that they are marked clearly as modified versions, that the authors‘
names and title are unchanged (though subtitles and additional authors‘
names may be added), and that the entire resulting derived work is
distributed under the terms of a permission notice identical to this
one.
Permission is granted to copy and distribute translations of this
documentation into another language, under the above conditions for
modified versions.
TRANSLATORS
YE Wenbin
[/code]
