perlxsperlapi

How to set a Perl environment variable from an XSUB?


I am trying to set a Perl environment variable from an XSUB. I want it to take immediate effect before the XSUB exits. Here is my XS file, 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"));

and here is a Perl script that uses the 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";
    }
}

The output is:

Before: undef
C1: getenv : ms
C1: PerlEnv_getenv : ms
C2: getenv : s
C2: PerlEnv_getenv : s
After: ms

I would like to know if it is possible to set the environment variable without using eval_pv()? Is there a specific API function that I can use?

Observations:


Solution

  • I don't know why my_setenv doesn't work (since $ENV{PERL_MEM_LOG} = "abc"; ends up calling my_setenv), but the following does:

    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");
    

    Test:

    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();
    }