如何从 XSUB 设置 Perl 环境变量?
How to set a Perl environment variable from an XSUB?
我正在尝试从 XSUB 设置 Perl 环境变量。我希望它在 XSUB 退出之前立即生效。这是我的 XS 文件,Module.xs
:
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
MODULE = My::Module PACKAGE = My::Module
PROTOTYPES: DISABLE
void
set_env_test()
CODE:
I32 croak_on_error = 1;
eval_pv("$ENV{PERL_MEM_LOG}='ms'", croak_on_error);
printf("C1: getenv : %s\n", getenv("PERL_MEM_LOG"));
printf("C1: PerlEnv_getenv : %s\n", PerlEnv_getenv("PERL_MEM_LOG"));
my_setenv("PERL_MEM_LOG", "s");
printf("C2: getenv : %s\n", getenv("PERL_MEM_LOG"));
printf("C2: PerlEnv_getenv : %s\n", PerlEnv_getenv("PERL_MEM_LOG"));
这里是一个使用 XSUB 的 Perl 脚本:
use feature qw(say);
use strict;
use warnings;
use ExtUtils::testlib;
use My::Module;
{
say "Before: ", get_env();
My::Module::set_env_test();
say "After: ", get_env();
}
sub get_env {
if (exists $ENV{PERL_MEM_LOG}) {
return $ENV{PERL_MEM_LOG};
}
else {
return "undef";
}
}
输出为:
Before: undef
C1: getenv : ms
C1: PerlEnv_getenv : ms
C2: getenv : s
C2: PerlEnv_getenv : s
After: ms
我想知道是否可以在不使用eval_pv()
的情况下设置环境变量?有没有我可以使用的特定 API 函数?
观察:
eval_pv()
按预期工作,
my_setenv()
在本地工作并取代 eval_pv()
设置的值,直到 XSUB 退出,然后恢复旧值。
my_setenv()
不能用于永久设置Perl环境变量,其作用只在XSUB内有效。
getenv()
和 PerlEnv_getenv()
似乎做同样的事情 (?)
我不知道为什么 my_setenv
不起作用(因为 $ENV{PERL_MEM_LOG} = "abc";
最终变成 calling my_setenv
),但以下内容起作用:
HV *env_hv = get_hv("ENV", 0);
if (!env_hv)
croak("wut");
SV **svp = hv_fetchs(env_hv, "PERL_MEM_LOG", 1);
sv_setpvs_mg(*svp, "s");
测试:
use 5.014;
use warnings;
use Inline C => <<'__EOS__';
void set_env_test() {
I32 croak_on_error = 1;
eval_pv("$ENV{PERL_MEM_LOG}='ms'", croak_on_error);
printf("C1: getenv : %s\n", getenv("PERL_MEM_LOG"));
printf("C1: PerlEnv_getenv : %s\n", PerlEnv_getenv("PERL_MEM_LOG"));
HV *env_hv = get_hv("ENV", 0);
if (!env_hv)
croak("wut");
SV **svp = hv_fetchs(env_hv, "PERL_MEM_LOG", 1);
sv_setpvs_mg(*svp, "s");
printf("C2: getenv : %s\n", getenv("PERL_MEM_LOG"));
printf("C2: PerlEnv_getenv : %s\n", PerlEnv_getenv("PERL_MEM_LOG"));
}
__EOS__
sub get_env { $ENV{PERL_MEM_LOG} // "[undef]" }
{
say "Before: ", get_env();
set_env_test();
say "After: ", get_env();
}
我正在尝试从 XSUB 设置 Perl 环境变量。我希望它在 XSUB 退出之前立即生效。这是我的 XS 文件,Module.xs
:
#define PERL_NO_GET_CONTEXT
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
MODULE = My::Module PACKAGE = My::Module
PROTOTYPES: DISABLE
void
set_env_test()
CODE:
I32 croak_on_error = 1;
eval_pv("$ENV{PERL_MEM_LOG}='ms'", croak_on_error);
printf("C1: getenv : %s\n", getenv("PERL_MEM_LOG"));
printf("C1: PerlEnv_getenv : %s\n", PerlEnv_getenv("PERL_MEM_LOG"));
my_setenv("PERL_MEM_LOG", "s");
printf("C2: getenv : %s\n", getenv("PERL_MEM_LOG"));
printf("C2: PerlEnv_getenv : %s\n", PerlEnv_getenv("PERL_MEM_LOG"));
这里是一个使用 XSUB 的 Perl 脚本:
use feature qw(say);
use strict;
use warnings;
use ExtUtils::testlib;
use My::Module;
{
say "Before: ", get_env();
My::Module::set_env_test();
say "After: ", get_env();
}
sub get_env {
if (exists $ENV{PERL_MEM_LOG}) {
return $ENV{PERL_MEM_LOG};
}
else {
return "undef";
}
}
输出为:
Before: undef
C1: getenv : ms
C1: PerlEnv_getenv : ms
C2: getenv : s
C2: PerlEnv_getenv : s
After: ms
我想知道是否可以在不使用eval_pv()
的情况下设置环境变量?有没有我可以使用的特定 API 函数?
观察:
eval_pv()
按预期工作,my_setenv()
在本地工作并取代eval_pv()
设置的值,直到 XSUB 退出,然后恢复旧值。my_setenv()
不能用于永久设置Perl环境变量,其作用只在XSUB内有效。getenv()
和PerlEnv_getenv()
似乎做同样的事情 (?)
我不知道为什么 my_setenv
不起作用(因为 $ENV{PERL_MEM_LOG} = "abc";
最终变成 calling my_setenv
),但以下内容起作用:
HV *env_hv = get_hv("ENV", 0);
if (!env_hv)
croak("wut");
SV **svp = hv_fetchs(env_hv, "PERL_MEM_LOG", 1);
sv_setpvs_mg(*svp, "s");
测试:
use 5.014;
use warnings;
use Inline C => <<'__EOS__';
void set_env_test() {
I32 croak_on_error = 1;
eval_pv("$ENV{PERL_MEM_LOG}='ms'", croak_on_error);
printf("C1: getenv : %s\n", getenv("PERL_MEM_LOG"));
printf("C1: PerlEnv_getenv : %s\n", PerlEnv_getenv("PERL_MEM_LOG"));
HV *env_hv = get_hv("ENV", 0);
if (!env_hv)
croak("wut");
SV **svp = hv_fetchs(env_hv, "PERL_MEM_LOG", 1);
sv_setpvs_mg(*svp, "s");
printf("C2: getenv : %s\n", getenv("PERL_MEM_LOG"));
printf("C2: PerlEnv_getenv : %s\n", PerlEnv_getenv("PERL_MEM_LOG"));
}
__EOS__
sub get_env { $ENV{PERL_MEM_LOG} // "[undef]" }
{
say "Before: ", get_env();
set_env_test();
say "After: ", get_env();
}