Как установить переменную окружения Perl из XSUB? - PullRequest
Новая
       34

Как установить переменную окружения Perl из XSUB?

1 голос
/ 07 февраля 2020

Я пытаюсь установить переменную окружения Perl из XSUB. Я хочу, чтобы он вступил в силу до выхода 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"));

, а вот скрипт Perl, использующий XSUB: 

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()? Могу ли я использовать определенную c API-функцию, которую я могу использовать?

Замечания:

  • eval_pv() работает как положено,
  • my_setenv() работает локально и заменяет значение, установленное eval_pv() до выхода XSUB, затем восстанавливается старое значение.
  • my_setenv() нельзя использовать для постоянной установки переменной среды Perl, ее действие действует только внутри XSUB.
  • getenv() и PerlEnv_getenv(), кажется, делают то же самое (?)

1 Ответ

1 голос
/ 08 февраля 2020

Я не знаю, почему my_setenv не работает (так как $ENV{PERL_MEM_LOG} = "abc"; заканчивается вызовом 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();
}
...