Perl 文檔中文計劃】《在 C 中嵌入 Perl》翻譯完成 zz
出處: www.chinaunix.net
本文由 redcandle 翻譯完成。
最新版本可以從這里獲取（POD 格式）：
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？
請繼續(xù)……
路標
* 編譯你的 C 程序
* 在你的 C 程序中加入一個 Perl 解釋器
* 在 C 程序中調(diào)用一個 Perl 函數(shù)
* 在 C 程序中對一個 Perl 語句求值
* 在 C 程序中進行 Perl 模式匹配和替換
* 在 C 程序中修改 Perl 參數(shù)棧
* 保持一個持久的解釋器
* 保持多個解釋器實例
* 在 C 程序中使用 Perl 模塊，模塊本身使用 C 庫
* 在 Win32 下內(nèi)嵌 Perl
編譯你的 C 程序
你不是唯一一個在編譯本文檔的例子時遇到困難的。一個重要規(guī)則是：用編譯你的
Perl 相同規(guī)則來編譯程序（對不起，對你大聲喊了）。
每個使用 Perl 的 C 程序都必須鏈接到 *perl 庫*。*perl 庫* 是 什么？Perl
本身是用 C 來寫的，perl library 是一系列編譯過的 C 程序，這
些將用于創(chuàng)建你的可執(zhí)行 perl 程序（*/usr/bin/perl* 或者等價的東西）。
（推論：除非 Perl 是在你的機器上編譯的，或者合適安裝的，否則你將不能在 C
程序中使用 Perl——這也是為什么你不應該從另一臺機器中復制 Perl 的可執(zhí)
行程序而不復制 *lib* 目錄。）
當你在 C 中使用 Perl 時，你的 C 程序?qū)ⅲㄍǔＪ沁@樣）分配、運行然后釋放
一個 *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
執(zhí)行這樣的語句可以找到 CORE：
perl -MConfig -e ‘print $Config{archlib}‘
這是在我的 Linux 機器上編譯下一節(jié)中例子 "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，這個“咒語”有一點不同：
% 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 之后，執(zhí)行 "perl -V"
命令，特別要注意“cc”和“ccflags”信息。
你必須選擇合適的編譯器（*cc*、*gcc* 等等）。在你的機器上："perl -MConfig
-e ‘print $Config{cc}‘" 將告訴你要使用什么。
你還要為你的機器選擇合適的庫目錄（*/usr/local/lib/...*）。如果你的編
譯器抱怨某個函數(shù)沒有定義，或者它找不到 *-lperl*，這時你需要更改在 "-L"
之后的路徑。如果它抱怨找不到 *EXTERN.h* 和 *perl.h*，你需要更 改在 "-I"
之后的路徑。
你可能還要加上一些額外的庫。加什么呢？可能是用下面語句輸出的那些：
perl -MConfig -e ‘print $Config{libs}‘
如果你的 perl 庫配置是適當?shù)?，已?jīng)安裝了 ExtUtils::Embed 模塊，它會
為你決定所有的這些信息：
% 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/
獲得。（如果本文檔是來自你的 Perl 發(fā)行版，那你用的是 5.004 或者更好，
你就已經(jīng)有這個模塊了。）
CPAN 上 ExtUtils::Embed 套裝也包含本文檔例子的所有源代碼，測試，額
外的例子以及其它可能有用的信息。
在 C 程序中加入 Perl 解釋器
在某種意義上說，perl（這里指 C 程序）是一個內(nèi)嵌 Perl（這里指語言）的一
個很好的例子。所以我將用包含在發(fā)行版源文件中的 *miniperlmain.c* 來演
示。這是一個拙劣的、不可移植的 *miniperlmain.c* 版本，但是包含了內(nèi)嵌
的本質(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();
}
注意，我們沒有用到 "env" 指針。通常只是作為 "perl_parse" 的最后一個
參數(shù)提供給它。這里 "env" 用 "NULL" 代替了，表示使用當前的環(huán)境。
PERL_SYS_INIT3() 和 PERL_SYS_TERM() 宏為 Perl 解釋器的運行提供了必要
的、系統(tǒng)特定的 C 運行環(huán)境。由于 PERL_SYS_INIT3() 可能修改 "env"，所
有最好提供 perl_parse() 一個 "env" 參數(shù)。
現(xiàn)在編譯成可執(zhí)行程序（我稱之為 *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 程序中讀入和執(zhí)行 Perl 語句，只需要在調(diào)用 *perl_run* 前放
置文件名在 *argv[1]* 中。
在 C 程序中調(diào)用 Perl 函數(shù)
要調(diào)用單個 Perl 函數(shù)，你可以使用任何一個在 perlcall 中介紹的 call_*
函數(shù)。 在這個例子中，我們使用 "all_argv"。
下面顯示一個我稱為 *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* 是一個沒有參數(shù)的 Perl 函數(shù)（就是 *G_NOARGS*），而且
忽略一返回值（就是 *G_DISCARD*）。在 perlcall 中有討論這些以及其它
標簽。
我在一個稱為 *showtime.pl* 文件中定義這個 *showtime* 函數(shù)：
print "I shan‘t be printed.";
sub showtime {
print time;
}
很簡單?，F(xiàn)在編譯并運行：
% cc -o showtime showtime.c `perl -MExtUtils::Embed -e ccopts -e ldopts`
% showtime showtime.pl
818284590
產(chǎn)生從 1970 年 1 月 1 日（Unix 紀元的開始）到現(xiàn)在的秒數(shù)，這是我寫這句
話的時間。
在這個特殊例子中，我們不必調(diào)用 *perl_run*，因為我們設置了 PL_exit_flag
PERL_EXIT_DESTRUCT_END，這將在 perl_destruct 中執(zhí)行 END 塊。
如果你想要傳遞參數(shù)給 Perl 函數(shù)，你可以在以 "NULL" 結(jié)尾的 "args" 列表
中加入字符串傳遞給 *call_argv*。對于其它數(shù)據(jù)類型，或者要檢查返回值類
型，你需要操作 Perl 參數(shù)棧。在 "Fiddling with the Perl stack from your C
program" 中演示了這個過程。
在 C 程序中對 Perl 語句求值
Perl 提供兩個 API 函數(shù)來對一小段 Perl 代碼進行求值。這就是 "eval_sv" in
perlapi 和 "eval_pv" in perlapi。
在 C 程序中只有這兩個函數(shù)，你可以執(zhí)行一段 Perl 代碼。你的代碼可以任意
長，可以包含多個語句，你可以用 "use" in perlfunc、"require" in
perlfunc、 和 "do" in perlfunc 來引入一個 Perl 文件。
*eval_pv* 可以對單個的 Perl 字符串求值，然后可以提取出變量轉(zhuǎn)換為 C 類
型。下面這個程序 *string.c* 執(zhí)行三個 Perl 字符串，第一個提取出一個 *int*
變量，第二個提取 "float" 變量，第三個提取 "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* 的奇怪函數(shù)都是為了協(xié)助將 Perl 標量轉(zhuǎn)換為 C 類型。
這在 perlguts 和 perlapi 中有描述。
如果你編譯并運行 *string.c*，你可以用 *SvIV()* 創(chuàng)建一個 "int"，*SvNV()*
創(chuàng)建一個 "float"，*SvPV()* 創(chuàng)建一個字符串，這樣可 以看到結(jié)果。
a = 9
a = 9.859600
a = Just Another Perl Hacker
在上面的例子中，我們創(chuàng)建了一個全局變量來臨時保存求值后計算的結(jié)果。也可
以，并在大多數(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)建一個全局變量，可以避免污染名字空間，也同樣使代碼簡化。
在 C 程序中進行 Perl 模式匹配和替換
*eval_sv()* 函數(shù)可以對 Perl 代碼字符串求值，所以我們可以定義一些函數(shù)
專門進行匹配和替換：*match()*，*substitute()* 和 *matches()*。
I32 match(SV *string, char *pattern);
假定有一個字符串和一個模式（例如 "m/clasp/" 或者 "/\b\w*\b/"，在你的 C
程序中可能是這樣的 "/\\b\\w*\\b/"）。如果字符串匹配一個模式則返回
1，否則返回 0。
int substitute(SV **string, char *pattern);
假定有一個指向 "SV" 的指針和 "=~" 操作符（例如 "s/bob/robert/g" 或 者
"tr[A-Z][a-z]"），substitute() 根據(jù)這個操作符修改 "SV"，返回替換
操作的次數(shù)。
int matches(SV *string, char *pattern, AV **matches);
假定有一個 "SV"，一個模式和一個指向一個空 "AV" 的指針，match() 在一
個列表上下文中對 "$string =~ $pattern" 求值，在 *matches* 中填充數(shù)
組，返回匹配的數(shù)目。
這是一個使用了三個函數(shù)的樣例，*match.c*（過長的行折疊了）：
#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)生這樣的輸出（過長的行再次折疊了）：
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ù)棧
大多數(shù)計算機教科書對于棧的解釋都是重復關于放置咖啡盤的比喻（most
computer science textbooks mumble something about spring-loaded columns
of cafeteria plates）：最后你放到棧中的東西就是你第一個取出的。
這是我們的要做的：C 程序放置一些參數(shù)到“Perl
棧”中，當魔術發(fā)生時閉上它的 眼睛，然后從棧上取出結(jié)果——Perl
函數(shù)的返回值（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 類型和 Perl 類型之間轉(zhuǎn)換，使用 newSViv()、
sv_setnv、newAV() 以及其它它們的朋友。它們在 perlguts 和 perlapi
中有說明。
然后你要知道如何操縱 Perl 參數(shù)棧。在 perlcall 中有說明。
一旦你明白這些，在 C 中嵌入 Perl 是很簡單的。
因為 C 沒有內(nèi)建的函數(shù)進行整數(shù)的指數(shù)運算，讓我們用 Perl 的 ** 運算符實
現(xiàn)它（這比它聽上去沒用得多，因為 Perl 用 C *pow()* 函數(shù)實現(xiàn) **）。首
先在 *power.pl* 中創(chuàng)建一個簡短的指數(shù)函數(shù)：
sub expo {
my ($a, $b) = @_;
return $a ** $b;
}
現(xiàn)在我創(chuàng)建一個 C 程序 *power.c*，通過 *PerlPower()* （包含所有必須的
perlguts）將兩個參數(shù)放到*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.
保持一個持久的解釋器
當開發(fā)一個交互而且（或者）可能是持久運行的應用程序，不要多次分配構(gòu)建新
的解釋器，保持一個持久的解釋器是一個好主意。最主要的原因是速度：因為
Perl 只要導入到內(nèi)存中一次。
盡管這樣，當使用一個持久的解釋器時要特別小心名字空間和變量作用域。在前
面的例子中，我們在默認的包 "main" 中使用全局變量。我們很清楚地知道代
碼是怎樣運行的，并且假定我們能夠避免變量沖突和符號表的增長。
假定你的應用程序是一個服務器，它偶爾運行一些文件中的 Perl 代碼。你的服
務器是不知道要運行什么代碼的。這很危險。
如果文件用 "perl_parse()" 引入的，編譯成一個新創(chuàng)建的解釋器，然后接著 用
"perl_destruct()" 作一次清理，這樣就可以屏蔽了大多數(shù)的名字空間的問 題。
一個避免名字空間沖突的方法是將文件名轉(zhuǎn)換成一個唯一的包名，然后用 "eval"
in perlfunc 將這段代碼編譯到這個包中。在下面的例子中，每個文件只
編譯一次。或者這個應用程序在一個文件中的符號表不再需要時可能會清除這個
符號表。使用 "call_argv" in perlapi，我們調(diào)用在 "persistent.pl" 文件中
的 "Embed::Persistent::eval_file"，傳遞一個文件名以及一個清除或者緩沖
的標簽作為參數(shù)。
注意到對于每個使用的文件，這個進程都要不斷增長。另外，可能有 "AUTOLOAD"
函數(shù)或者其它條件導致 Perl 符號表的增長。你可能想加入一些邏
輯判斷來跟蹤進程的大小，或者在一定次數(shù)的請求之后重新啟動一次，這樣來保證
內(nèi) 存的消耗是保證最小的。你可能還會在可能的時候用 "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
執(zhí)行 END 塊
傳統(tǒng)的 END 塊在 perl_run 的結(jié)束時執(zhí)行了。對于不調(diào)用 perl_run 的應用程
序這會有一些問題。從 perl 5.7.2 開始，你可以指定 "PL_exit_flags |=
PERL_EXIT_DESTRUCT_END" 來獲得新特性。這也可以在 perl_parse 失敗之后調(diào)
用 END 塊，"perl_destruct" 將返回退出值。
保持多個解釋器的實例
一些罕見的應用程序在一次對話中需要創(chuàng)建多個解釋器?？赡芤既会尫沤忉屍?br>對應的資源。
這個程序要確保要在下一個解釋器就做這些事。默認情況下，當 perl 不用任何
選項構(gòu)建時，全局變量 "PL_perl_destruct_level" 設置為 0。因為在一個程
序生存期中只創(chuàng)建一個解釋器是不需要進行額外的清理。
將 "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()* 調(diào)用時，這個解釋器的語法解析樹和符號表就被清除，
全局變量也被重新設置。因為 perl_construct 會將 "PL_perl_destruct_level"
重新設置為 0，所以要再一次設置 "PL_perl_destruct_level"。
現(xiàn)在假定我們同時有多個解釋器運行。這是可以做到的，但是只有在你創(chuàng)建 perl
時使用配置選項 "-Dusemultiplicity" 或者 "-Dusethreads
-Duseithreads"。缺省情況下，打開這些配置選項中的一個就把這個
per-interpreter 全局變量 "PL_perl_destruct_level" 設置為 1。所以清理
是自動的，并且解釋器變量變正確的初始化。即使你不用同時運行多個解釋器，
而是要像前面的例子那樣順序運行，但還是建議你用 "-Dusemultiplicity"
選項來編譯
perl。否則一些解釋器的變量在連續(xù)運行過程中不會正確的初始化，你
的運行程序可能會崩潰。
如果你打算在不同線程中并發(fā)運行多個解釋器時，使用 "-Dusethreads
-Duseithreads" 而不是"-Dusemultiplicity" 可能更合適。因為這可以對解釋
器支持鏈接到系統(tǒng)的線程庫。
讓我們來試一下：
#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() 的調(diào)用。這對于全局狀態(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.）如果你有多個解釋器并且同時對這些解釋器交叉調(diào) 用
perl API，就應該總是使用它。
當 "interp" 在一個不是創(chuàng)建它的線程（使用 perl_alloc() 或者更深奧 的
perl_clone()）使用時，也應該調(diào)用 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 庫
如果你在使用上面的例子中試圖嵌入一個腳本，這個腳本調(diào)用一個使用 C 或者
C++ 庫的 Perl 模塊（例如 *Socket*），可能會發(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.)
出什么錯了？
你的解釋器不知道怎樣與這些擴展交流。一個小小的粘合代碼將會起到作用。直
到現(xiàn)在你還是用 NULL 作為第二個參數(shù)調(diào)用 *perl_parse()*。
perl_parse(my_perl, NULL, argc, my_argv, NULL);
這是使用粘合代碼的地方，它在 Perl 和鏈接的 C/C++ 函數(shù)創(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);
}
對于每個要鏈接到你的 Perl 可執(zhí)行程序的擴展（由你電腦的初始化配置決定或
者當加入一個新的擴展），創(chuàng)建一個 Perl 函數(shù)整合擴展中的函數(shù)。通常這個函
數(shù)叫 *Module::boostrap()*，當你使用 *use Module* 就調(diào)用了這個函數(shù)。 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()* 的第二個參數(shù)中：
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`
詳細內(nèi)容參考 perlxs、perlguts 和 perlapi。
在 Win32 嵌入 Perl
一般，這里顯示的所有代碼在 Windows 下不用任何修改就能工作。
盡管這樣，這里有一些命令行例子的警告。對于初學者，在 Win32 本身的命令
行中是不能使用反引號的。在 CPAN 的 ExtUtils::Embed 中有一個稱為 genmake
腳本。這可以從單個的 C 源文件中創(chuàng)建一個簡單的 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 中使用更穩(wěn)健的環(huán)境（ You may wish
to use a more robust environment such as the Microsoft Developer
Studio.）。在這種情況下中，用這個來產(chǎn)生 perlxsi.c：
perl -MExtUtils::Embed -e xsinit
創(chuàng)建一個新的工程，然后 Insert -> Files 到工程中：perlxsi.c，perl.lib，
和你自己的源文件，例如 interp.c。一般你可以在 C:\perl\lib\CORE 中找 到
perl.lib。如果沒有的話，你可以用 "perl -V:archlib" 中找到 CORE
目錄。studio 還要知道在哪里找到 Perl 的 include 文件。這個路徑可以通過
Tools -> Options -> Directories 菜單來加入。最后，選擇 Build -> Build
interp.exe，這樣就好了。
隱藏 Perl_
在編譯標簽中加入 -DPERL_NO_SHORT_NAMES，你就可以隱藏 Perl 公共接口的簡短
形式。這意味著你不能這樣寫：
warn("%d bottles of beer on the wall", bottlecount);
你必須寫明確完全的形式：
Perl_warn(aTHX_ "%d bottles of beer on the wall", bottlecount);
（參考 "Background and PERL_IMPLICIT_CONTEXT for the explanation of the
"aTHX_"." in perlguts）隱藏簡短的形式對于避免和其它軟件包的沖突（C
預處理 或者其它）。（Perl 用簡短名字定義了 2400
API，所以很有可能發(fā)生沖突。）
MORAL
有時可以在 C 中寫出 *運行更快的代碼（write faster
code）*，但是你總是可以在 Perl 中*更快地寫出代碼（write code
faster）*。因為你可以相互使用對方，只 要你需要可以結(jié)合起來。
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]
