Env-C
view release on metacpan or search on metacpan
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include "ppport.h"
#include <stdlib.h> /* setenv/getenv */
#include <stdio.h> /* sprintf */
/* configure-less detection of unsetenv for solaris */
#if defined(sun)
# if defined(__EXTENSIONS__) ||\
(!defined(_STRICT_STDC) && !defined(__XOPEN_OR_POSIX)) || \
defined(_XPG6)
# define HAVE_UNSETENV 1
# define HAVE_SETENV 1
# endif
#endif
#ifndef HAVE_UNSETENV
# elif PERL_BCDVERSION >= 0x5008000 && PERL_BCDVERSION < 0x5019006
/* FreeBSD: SIGV at exit on perls prior to 5.19.6
* see: https://rt.cpan.org/Ticket/Display.html?id=49872
*/
# if defined(__FreeBSD__)
# define USE_SAFE_PUTENV 1
# endif
# endif
#endif
inline int __setenv(const char *key, const char *val, int override) {
int RETVAL;
#if !HAVE_SETENV
if (override || getenv(key) == NULL) {
char *old_env = getenv( key );
char *buff = malloc(strlen(key) + strlen(val) + 2);
if (buff != NULL) {
sprintf(buff, "%s=%s", key, val);
#ifdef WIN32
RETVAL = _putenv(buff);
free(buff);
RETVAL = -1;
}
}
else {
RETVAL = -1;
}
#else
# ifdef USE_SAFE_PUTENV
PL_use_safe_putenv = 1;
# endif
RETVAL = setenv(key, val, override);
#endif
return RETVAL;
}
inline void __unsetenv(const char *key) {
#ifdef WIN32
char *buff;
#endif
#if defined( sun ) || defined( _AIX )
int key_len;
extern char **environ;
char **envp;
#endif
#ifdef WIN32
buff = malloc(strlen(key) + 2);
sprintf(buff, "%s=", key);
_putenv(buff);
free(buff);
#else
#if HAVE_UNSETENV
unsetenv(key);
#else
key_len = strlen(key);
for (envp = environ; *envp != NULL; envp++) {
if (strncmp(key, *envp, key_len) == 0 &&
(*envp)[key_len] == '=') {
free(*envp);
do {
envp[0] = envp[1];
} while (*envp++);
break;
CODE:
RETVAL = getenv(key);
OUTPUT:
RETVAL
MODULE = Env::C PACKAGE = Env::C PREFIX = env_c_
int
env_c_setenv(key, val, override=1)
char *key
char *val
int override;
CODE:
RETVAL = __setenv(key, val, override);
OUTPUT:
RETVAL
MODULE = Env::C PACKAGE = Env::C PREFIX = env_c_
void
env_c_unsetenv(key)
char *key
CODE:
__unsetenv(key);
MODULE = Env::C PACKAGE = Env::C PREFIX = env_c_
AV*
env_c_getallenv()
PREINIT:
int i = 0;
#ifndef __BORLANDC__
extern char **environ;
while ((char*)environ[i] != NULL) {
Perl_av_push(aTHX_ RETVAL, newSVpv((char*)environ[i++], 0));
}
OUTPUT:
RETVAL
MODULE = Env::C PACKAGE = Env::C PREFIX = env_c_
void
env_c_setenv_multi(...)
PPCODE:
int i;
if (items % 3)
croak("Usage: setenv_multi(var1, value1, override1, var2, value2, override2, ...)");
for (i=0; i<items; i+=3)
__setenv(SvPV_nolen(ST(i)), SvPV_nolen(ST(i+1)), SvIV(ST(i+2)));
XSRETURN(0);
MODULE = Env::C PACKAGE = Env::C PREFIX = env_c_
void
env_c_unsetenv_multi(...)
PPCODE:
int i;
for (i=0; i<items; i++)
__unsetenv(SvPV_nolen(ST(i)));
XSRETURN(0);
MODULE = Env::C PACKAGE = Env::C PREFIX = env_c_
# this is for leak.t, which needs to know if PERL_USE_SAFE_PUTENV is in
# effect
int
env_c_using_safe_putenv()
CODE:
Revision history for Perl extension Env::C.
0.15 2017-08-11
- make signture test an AUTHOR test
- Fix some compiler warnings [Thanks Petr PÃsaÅ™]
- Add setenv_multi() and unsetenv_multi() for bulk Env operations [Thanks
Sergey Panteleev]
0.14 2017-03-31
- minor POD updates [Thanks José JoaquÃn Atria]
- Add tests for override flag [Thanks José JoaquÃn Atria]
- Use is() instead of ok() in tests [Thanks José JoaquÃn Atria]
- apply skiplist to signature test
0.13 2015-05-02
- flip order of ppport.h and XSUB.h includes to fix duplicate declaration
exists, but in docker this is not (necessarily) true.
0.12 2014-11-03
- Narrow down "panic: free from wrong pool" error to perl with both threads,
and PERL_TRACK_MEMPOOL (enabled implicitly with DEBUGGING). work around
by using PL_use_safe_putenv only if building under threaded perl with
PERL_TRACK_MEMPOOL. [#99962]
0.11 2014-10-31
- FreeBSD: fix SIGV at exit for perl < 5.19.6 by using PL_use_safe_putenv.
This causes setenv to leak memory, but seems to be the only way to avoid
SIGV. [#49872]
- MANIFEST.SKIP: add MYMETA.json, MYMETA.yml
- update to latest ppport.h
- prereqs: require Test::More v0.88 or later, exclude optional
Module::Signature
0.10 2013-04-09
- fix memory leak due to PL_use_safe_putenv = 1 [#49872]
0.09 2012-06-25
libc by doing the same thing that the stdlib.h header does to reveal the
prototype. Ideally the Makefile.PL would detect the functions using a
compiler check, but this seems like the simplest approach for the moment.
[Patch by wez@messagesystems.com]
- include the latest ppport.h
0.06 Mon May 23 18:53:52 EDT 2005
- As AIX has no unsetenv, reuse the code for Solaris to implement it [Larry Pells <lpells@spillman.com>]
0.05 Thu May 19 15:05:37 EDT 2005
- add Solaris support [Larry Pells <lpells@spillman.com>]
0.04 Wed Jun 23 17:52:38 IDT 2004
- add the missing license info
- add MSWin32 support [Larry Pells <lpells@spillman.com>]
lib/Env/C.pm view on Meta::CPAN
version 0.15
=head1 SYNOPSIS
use Env::C;
my $key = "USER";
$val = Env::C::getenv($key) || '';
Env::C::setenv($key, "foobar", [$override]);
$new_val = Env::C::getenv($key) || '';
Env::C::unsetenv($key);
my $ar_env = Env::C::getallenv();
print join "\n", @$ar_env;
Env::C::setenv_multi(
"VAR1", "value1", 1,
"VAR2", "value2", 0
);
Env::C::unsetenv_multi("VAR1", "VAR2");
=head1 DESCRIPTION
This module provides a Perl API for getenv(3), setenv(3) and
unsetenv(3). It also can return all the C<environ> variables.
You also can use C<setenv_multi> and C<getenv_multi> for bulk
operations with environment.
Sometimes Perl invokes modules with underlaying C APIs which rely on
certain environment variables to be set. If these variables are set in
Perl and the glue code doesn't worry to set them on the C level, these
variables might not be seen by the C level. This module shows what
really the C level sees.
=head1 FUNCTIONS
=head2 getenv($key)
Returns the value of the environment variable matching the key or
C<undef>.
=head2 setenv($key, $value, [$override])
The C<setenv()> function adds the variable C<$key> to the environment with the
value C<$value>, if C<$key> does not already exist. If C<$key> does exist in
the environment, then its value is changed to C<$value> if C<$override> is
non-zero; if C<$override> is zero or is not passed, then the value of C<$key>
is not changed.
=head2 unsetenv($key)
The unsetenv() function deletes the variable C<$key> from the
environment.
=head2 setenv_multi($key1, $value1, $override1, $key2, $value2, $override2, ...)
Similar to C<setenv>, but works with several variables at once.
=head2 unsetenv_multi(@keys)
Similar to C<unsetenv>, but works with several variables at once.
=head2 getallenv()
my $ar_env = Env::C::getallenv();
print join "\n", @$ar_env;
The C<getallenv()> function returns an array reference which includes all
the environment variables.
=for Pod::Coverage using_safe_putenv
magic_nextpack|||
magic_regdata_cnt|||
magic_regdatum_get|||
magic_regdatum_set|||
magic_scalarpack|||
magic_set_all_env|||
magic_setarylen|||
magic_setcollxfrm|||
magic_setdbline|||
magic_setdefelem|||
magic_setenv|||
magic_sethint|||
magic_setisa|||
magic_setmglob|||
magic_setnkeys|||
magic_setpack|||
magic_setpos|||
magic_setregexp|||
magic_setsig|||
magic_setsubstr|||
magic_settaint|||
my_fflush_all||5.006000|
my_fork||5.007003|n
my_kid|||
my_lstat_flags|||
my_lstat||5.019003|
my_memcmp|||n
my_memset||5.004000|n
my_pclose||5.004000|
my_popen_list||5.007001|
my_popen||5.004000|
my_setenv|||
my_snprintf|5.009004||pvn
my_socketpair||5.007003|n
my_sprintf|5.009003||pvn
my_stat_flags|||
my_stat||5.019003|
my_strftime||5.007002|
my_strlcat|5.009004||pn
my_strlcpy|5.009004||pn
my_unexec|||
my_vsnprintf||5.009004|n
if (Env::C::using_safe_putenv()) {
plan skip_all => "perl leaks with PERL_USE_SAFE_PUTENV";
}
unless (-f '/proc/self/statm') {
plan skip_all => 'this test requires /proc/self/statm';
}
plan tests => 1;
Env::C::setenv(TZ => 'GMT');
my $start_size = memusage();
for (1..300000) {
$ENV{TZ} = 'GMT';
$ENV{TZ} = '';
}
my $end_size = memusage();
cmp_ok $end_size, '==', $start_size, 'setenv does not leak';
sub is_memusage_supported {
return 1 if -f "/proc/self/statm";
}
sub memusage {
my $pid = $$;
my ($size) = split /\s+/, slurp('/proc/self/statm');
t/smoke-multi.t view on Meta::CPAN
# docker). If not present, just use root.
unless (exists $ENV{USER}) {
$ENV{USER} = 'root';
}
my $env1 = Env::C::getallenv();
print "# ", scalar(@$env1), " env entries\n";
#print join "\n", @$env;
ok @$env1;
Env::C::setenv_multi(
FOO => foo => 1,
BAR => bar => 0,
USER => toor => 0,
);
my $env2 = Env::C::getallenv();
is_deeply [ sort(@$env1, 'FOO=foo', 'BAR=bar') ], [ sort @$env2 ], "setmulti 1";
Env::C::setenv_multi(
FOO => foo2 => 0,
BAR => bar2 => 1,
USER => toor => 1,
);
my $env3 = Env::C::getallenv();
is_deeply [ sort((grep { !/^USER=/ } @$env1), 'FOO=foo', 'BAR=bar2', 'USER=toor') ], [ sort @$env3 ], "setmulti 2";
Env::C::unsetenv_multi(qw/FOO BAR/);
my $env4 = Env::C::getallenv();
is_deeply [ sort((grep { !/^USER=/ } @$env1), 'USER=toor') ], [ sort @$env4 ], "unsetmulti";
# docker). If not present, just use root.
unless (exists $ENV{USER}) {
$ENV{USER} = 'root';
}
# getenv
my $key = "USER";
my $val_orig = Env::C::getenv($key);
is $val_orig, $ENV{$key}, "getenv matches perl ENV for $key";
# unsetenv
Env::C::unsetenv($key);
my $val = Env::C::getenv($key);
is $val, undef, "$key is no longer set in C env";
# setenv
my $val_new = "foobar";
Env::C::setenv($key, $val_new);
$val = Env::C::getenv($key) || '';
is $val, $val_new, "reinstated $key in C env";
my $overwrite = "barbaz";
Env::C::setenv($key, $overwrite, 0);
$val = Env::C::getenv($key) || '';
is $val, $val_new, "do not overwrite $key with explicitly false override";
Env::C::setenv($key, $val_new, 1);
$val = Env::C::getenv($key) || '';
is $val, $val_new, "overwrite $key with explicitly true override";
# restore
Env::C::setenv($key, $val_orig);
$val = Env::C::getenv($key) || '';
is $val, $val_orig, "restored $key (using setenv with implicit override)";
my $env = Env::C::getallenv();
print "# ", scalar(@$env), " env entries\n";
#print join "\n", @$env;
ok @$env;
cmp_ok scalar @$env, '==', scalar keys %ENV;
my @perl_env = map { "$_=$ENV{$_}" } keys %ENV;
is_deeply [sort @$env], [sort @perl_env];
( run in 0.692 second using v1.01-cache-2.11-cpan-3989ada0592 )