/*
Copyright (C) 2001-2008, The Perl Foundation.
$Id: /mirror/trunk/src/pmc/env.pmc 34445 2008-12-27T07:50:08.238923Z petdance  $

=head1 NAME

src/pmc/env.pmc - System Environment

=head1 DESCRIPTION

C<Env> is a singleton class which provides access to the system environment.

=head2 Methods

=over 4

=cut

*/

#include "parrot/parrot.h"

/* array of environment variables,
   speced in POSIX.1, but not in ISO-C
   MS C compilers know about environ, as it is declared in stdlib.h.
   OS X doesn't allow access to "environ" from within shared libraries.
*/
#ifndef WIN32
#  ifdef __APPLE_CC__
#    include <crt_externs.h>
#    define environ (*_NSGetEnviron())
#  else /* !__APPLE_CC__ */
extern char **environ;
#  endif /* __APPLE_CC__ */
#endif /* !WIN32 */

static PMC *Env_PMC;
pmclass Env singleton provides hash {

/*

=item C<void *get_pointer()>

=item C<void set_pointer(void *ptr)>

These two functions are part of the singleton creation interface. For more
information see F<src/pmc.c>.

=cut

*/
    void class_init() {
        Env_PMC = NULL;
    }

    VTABLE void *get_pointer() {
        return Env_PMC;
    }

    VTABLE void set_pointer(void *ptr) {
        Env_PMC = (PMC *)ptr;
    }

/*

=item C<PMC *get_iter()>

Returns a new iterator for the environment.
This method is questionable, as environ is not in ISO-C.

=cut

*/

    VTABLE PMC *get_iter() {
        STRING *name         = CONST_STRING(interp, "set_key");
        PMC    *iter         = pmc_new_init(interp, enum_class_Iterator, SELF);
        PMC    *key          = pmc_new(interp, enum_class_Key);

        Parrot_PCCINVOKE(interp, iter, name, "P->", key);
        PObj_get_FLAGS(key) |= KEY_integer_FLAG;
        PMC_int_val(key)     = 0;

        if (!environ[0])
            PMC_int_val(key) = -1;

        return iter;
    }

/*

=item C<INTVAL elements()>

Returns the number of elements in the environment.
This method is questionable, as environ is not in ISO-C.

=cut

*/

    VTABLE INTVAL elements() {
        INTVAL rv = 0;

        while (environ[rv] != NULL)
            rv++;

        return rv;
    }

/*

=item C<INTVAL get_integer()>

Returns the size of the hash.

=cut

*/

    VTABLE INTVAL get_integer() {
        return SELF.elements();
    }

/*

=item C<FLOATVAL get_number()>

Returns the size of the hash.

=cut

*/
    VTABLE FLOATVAL get_number() {
        return SELF.elements();
    }

/*

=item C<STRING *get_string_keyed(PMC *key)>

Returns the Parrot string value for the environment variable C<*key>.

=cut

*/

    VTABLE STRING *get_string_keyed(PMC *key) {
        if ((PObj_get_FLAGS(key) & KEY_type_FLAGS) == KEY_integer_FLAG) {
            INTVAL const keynum = VTABLE_get_integer(INTERP, key);
            if (keynum < 0 || keynum >= SELF.elements()) {
                return string_from_literal(interp, "");
            }
            else {
                const char * const envp = environ[keynum];
                const char * const p    = strchr(envp, '=');
                return string_from_cstring(interp, envp, (UINTVAL)(p - envp));
            }
        }
        else {
            char * const keyname = string_to_cstring(interp,
                VTABLE_get_string(interp, key));

            if (keyname) {
                int free_it = 0;
                char * const val = Parrot_getenv(keyname, &free_it);
                string_cstring_free(keyname);

                if (val) {
                    STRING * const retval = string_from_cstring(interp, val, 0);

                    if (free_it)
                        mem_sys_free(val);

                    return retval;

                }
            }

            return string_from_literal(interp, "");
        }
    }

/*

=item C<STRING *get_pmc_keyed(PMC *key)>

Returns a String PMC for the environment variable C<*key>.

=cut

*/

    VTABLE PMC *get_pmc_keyed(PMC *key) {
        char * const keyname = string_to_cstring(INTERP,
            VTABLE_get_string(INTERP, key));

        char   *val     = NULL;
        STRING *retval  = NULL;
        PMC    *return_pmc;

        if (keyname) {
            int free_it = 0;
            val         = Parrot_getenv(keyname, &free_it);
            string_cstring_free(keyname);

            if (val) {
                retval = string_from_cstring(INTERP, val, 0);
                if (free_it)
                    mem_sys_free(val);
            }
        }

        if (!retval)
            retval = string_from_literal(INTERP, "");

        return_pmc = pmc_new(INTERP, enum_class_String);

        VTABLE_set_string_native(INTERP, return_pmc, retval);
        return return_pmc;
    }

/*

=item C<void set_string_keyed(PMC *key, STRING *value)>

Sets the environment variable C<*key> to C<*value>.

=cut

*/

    VTABLE void set_string_keyed(PMC *key, STRING *value) {
        char * const keyname = string_to_cstring(INTERP,
            VTABLE_get_string(INTERP, key));
        char * const env_val = string_to_cstring(INTERP, value);

        if (keyname && env_val)
            Parrot_setenv(keyname, env_val);

        if (keyname)
            string_cstring_free(keyname);

        if (env_val)
            string_cstring_free(env_val);
    }

/*

=item C<void set_pmc_keyed(PMC *key, PMC *value)>

Sets the environment variable C<*key> to C<*value>.

=cut

*/

    VTABLE void set_pmc_keyed(PMC *key, PMC *value) {
        char * const keyname = string_to_cstring(INTERP,
            VTABLE_get_string(INTERP, key));

        const STRING * const str_value = VTABLE_get_string(INTERP, value);
        char         * const env_val   = string_to_cstring(INTERP, str_value);

        if (keyname && env_val)
            Parrot_setenv(keyname, env_val);

        if (keyname)
            string_cstring_free(keyname);

        if (env_val)
            string_cstring_free(env_val);
    }

/*

=item C<INTVAL exists_keyed(PMC *key)>

Returns whether the environment variable for C<*key> exists.

=cut

*/

    VTABLE INTVAL exists_keyed(PMC *key) {
        char * const keyname = string_to_cstring(INTERP,
            VTABLE_get_string(INTERP, key));

        if (keyname) {
            int free_it;
            char * const val = Parrot_getenv(keyname, &free_it);
            string_cstring_free(keyname);

            if (val) {
                if (free_it)
                    mem_sys_free(val);
                return 1;
            }
        }

        return 0;
    }

/*

=item C<void delete_keyed(PMC *key)>

Deletes the the environment variable for C<*key>.

=cut

*/

    VTABLE void delete_keyed(PMC *key) {
        char * const keyname = string_to_cstring(INTERP,
            VTABLE_get_string(INTERP, key));

        if (keyname) {
            int          free_it;
            char * const val = Parrot_getenv(keyname, &free_it);

            if (val) {
                if (free_it)
                    mem_sys_free(val);

                Parrot_unsetenv(keyname);
            }

            string_cstring_free(keyname);
        }
    }
}

/*

=back

=head1 SEE ALS0

PDD -
L<http://www.parrotcode.org/docs/pdd/pdd17_pdd.html#Hash_types>

Environment in Perl 6 - L<http://dev.perl.org/perl6/rfc/318.html>

Module for Perl 5 - L<http://search.cpan.org/~stas/Env-C-0.06/>

=cut

*/

/*
 * Local variables:
 *   c-file-style: "parrot"
 * End:
 * vim: expandtab shiftwidth=4:
 */
