The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#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
# if !defined(sun) && !defined(_AIX)
#  define HAVE_UNSETENV 1
# endif
#endif
#ifndef HAVE_SETENV
# if !defined(WIN32) && !defined(sun)
#  define HAVE_SETENV 1
# endif
#endif

/* in order to work around system and perl implementation bugs/leaks, we need
 * to sometimes force PERL_USE_SAFE_PUTENV mode.
 */
#ifndef PERL_USE_SAFE_PUTENV
   /* Threaded perl with PERL_TRACK_MEMPOOL enabled causes
    * "panic: free from wrong pool at exit"
    * starting at 5.9.4 (confirmed through 5.20.1)
    * see: https://rt.cpan.org/Ticket/Display.html?id=99962
    */
# if PERL_BCDVERSION >= 0x5009004 && defined(USE_ITHREADS) && defined(PERL_TRACK_MEMPOOL)
#  define USE_SAFE_PUTENV 1
# 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

MODULE = Env::C        PACKAGE = Env::C  PREFIX = env_c_

char *
env_c_getenv(key)
    char *key

    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:
#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);
#else
            RETVAL = putenv(buff);
            if (old_env == NULL) {
                free(old_env);
            }
#endif
        }
        else {
            RETVAL = -1;
        }
    }
    else {
        RETVAL = -1;
    }
#else
# ifdef USE_SAFE_PUTENV
    PL_use_safe_putenv = 1;
# endif
    RETVAL = setenv(key, val, override);
#endif

    OUTPUT:
    RETVAL

MODULE = Env::C        PACKAGE = Env::C  PREFIX = env_c_

void
env_c_unsetenv(key)
    char *key

    PREINIT:
#ifdef WIN32
    char *buff;
#endif
#if defined( sun ) || defined( _AIX )
    int key_len;
    extern char **environ;
    char **envp;
#endif

    CODE:
#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;
        }
    }
#endif
#endif

MODULE = Env::C        PACKAGE = Env::C  PREFIX = env_c_

AV*
env_c_getallenv()

    PREINIT:
    int i = 0;
    char *p;
    AV *av = Nullav;
#ifndef __BORLANDC__
    extern char **environ;
#endif

    CODE:
    RETVAL = newAV();

    while ((char*)environ[i] != '\0') {
        Perl_av_push(aTHX_ RETVAL, newSVpv((char*)environ[i++], 0));
    }

    OUTPUT:
    RETVAL

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:
#if defined(PERL_USE_SAFE_PUTENV) || defined(USE_SAFE_PUTENV)
    RETVAL = 1;
#else
    RETVAL = 0;
#endif

    OUTPUT:
    RETVAL