perlembed - 如何在 C 程序中嵌入 Perl
您是否想要
阅读关于反引号以及 perlfunc 中的 system 和 exec。
阅读关于 "perlfunc 中的 do"、"perlfunc 中的 eval"、"perlfunc 中的 require" 和 "perlfunc 中的 use"。
重新思考你的设计。
继续阅读...
编译您的 C 程序
在您的 C 程序中添加 Perl 解释器
从您的 C 程序中调用 Perl 子例程
从您的 C 程序中评估 Perl 语句
从您的 C 程序中执行 Perl 模式匹配和替换
从您的 C 程序中处理 Perl 堆栈
维护持久解释器
维护多个解释器实例
从您的 C 程序中使用 Perl 模块，这些模块本身使用 C 库
在 Win32 下嵌入 Perl
如果你在编译本手册中的脚本时遇到问题，你并不孤单。基本规则：以与编译你的 Perl 完全相同的方式编译程序。（抱歉大喊。）
此外，每个使用 Perl 的 C 程序都必须链接到 perl 库。你问那是什么？Perl 本身是用 C 编写的；perl 库是用于创建你的 perl 可执行文件（/usr/bin/perl 或等效文件）的已编译 C 程序的集合。（推论：除非 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}'以下是如何在我的 Linux 机器上编译下一节中的示例，"将 Perl 解释器添加到你的 C 程序中"
% 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（这是一行。）在我的运行旧版 5.003_05 的 DEC Alpha 上，咒语略有不同
% 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`如果您的 Perl 发行版中没有 ExtUtils::Embed 模块，您可以从 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 指针。通常作为最后一个参数传递给 perl_parse，这里的 env 被替换为 NULL，这意味着将使用当前环境。
宏 PERL_SYS_INIT3() 和 PERL_SYS_TERM() 提供了运行 Perl 解释器所需的 C 运行时环境的系统特定调整；无论您创建或销毁多少个解释器，它们都应该只调用一次。在创建第一个解释器之前调用 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_run 之前，将文件名放在 argv[1] 中，从文件中读取和执行 Perl 语句。
要调用单个 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 代码片段。它们是 "perlapi 中的 eval_sv" 和 "perlapi 中的 eval_pv"。
可以说，这些是您从 C 程序中执行 Perl 代码片段时唯一需要的例程。您的代码可以像您希望的那样长；它可以包含多个语句；它可以使用 "perlfunc 中的 use"、"perlfunc 中的 require" 和 "perlfunc 中的 do" 来包含外部 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 的 ** 运算符提供给它（这不像听起来那么有用，因为 Perl 使用 C 的 pow() 函数实现 **）。首先，我将在 power.pl 中创建一个存根求幂函数。
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() 清理，那么您将免受大多数命名空间问题的困扰。
在这种情况下，避免命名空间冲突的一种方法是将文件名转换为一个保证唯一的包名，然后使用 "perlfunc 中的 eval" 将代码编译到该包中。在下面的示例中，每个文件只会被编译一次。或者，应用程序可以选择在不再需要文件后清理与该文件关联的符号表。使用 "perlapi 中的 call_argv"，我们将调用位于文件 persistent.pl 中的子例程 Embed::Persistent::eval_file，并将文件名和布尔清理/缓存标志作为参数传递。
请注意，该进程将继续为它使用的每个文件增长。此外，可能存在 AUTOLOADed 子例程和其他导致 Perl 符号表增长的条件。您可能希望添加一些逻辑来跟踪进程大小，或者在一定数量的请求后重新启动自身，以确保内存消耗最小化。您还希望尽可能使用 "perlfunc 中的 my" 来限定您的变量。
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 运行时将尝试通过更新传递给 perl_parse() 的 argv 指向的内存，以及在可用时调用 API 函数（如 setproctitle()）来使该值显示为“ps”报告的程序名称。当嵌入 perl 时，这种行为可能不合适，可以通过在调用 perl_parse() 之前将值 `1` 赋给变量 `PL_origalen` 来禁用。
例如，上面的 persistent.c 示例如果删除了 `PL_origalen = 1;` 赋值，则可能会发生段错误。这是因为 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 时使用了 Configure 选项 -Dusemultiplicity 或选项 -Dusethreads -Duseithreads。默认情况下，启用这些 Configure 选项之一会将每个解释器的全局变量 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如果您尝试了上面的示例，并尝试嵌入一个使用 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 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);(有关 aTHX_ 的解释，请参阅 "perlguts 中的背景和 MULTIPLICITY"。 ) 隐藏简写形式对于避免各种讨厌的（C 预处理器或其他）与其他软件包的冲突非常有用（Perl 使用这些简写名称定义了大约 2400 个 API，多几个或少几个，因此肯定有冲突的空间。）
您有时可以在 C 中编写更快的代码，但您始终可以在 Perl 中更快地编写代码。因为您可以从彼此中使用，所以可以根据需要组合它们。
Jon Orwant <[email protected]> 和 Doug MacEachern <[email protected]>，Tim Bunce、Tom Christiansen、Guy Decoux、Hallvard Furuseth、Dov Grobgeld 和 Ilya Zakharevich 做出了少量贡献。
Doug MacEachern 在《Perl 杂志》第一卷第四期上发表了一篇关于嵌入的文章（http://www.tpj.com/）。Doug 也是最广泛使用的 Perl 嵌入的开发者：mod_perl 系统（perl.apache.org），它将 Perl 嵌入到 Apache Web 服务器中。Oracle、Binary Evolution、ActiveState 和 Ben Sugars 的 nsapi_perl 已将此模型用于 Oracle、Netscape 和 Internet Information Server Perl 插件。
版权所有 (C) 1995, 1996, 1997, 1998 Doug MacEachern 和 Jon Orwant。保留所有权利。
本文件可以在与 Perl 本身相同的条款下分发。