/*
Copyright (C) 2001-2003, The Perl Foundation.
$Id: env.pmc 16275 2006-12-28 01:20:44Z particle $

=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.
*/
#ifndef WIN32
extern char **environ;
#endif

static PMC * Env_PMC;
pmclass Env singleton does 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* get_pointer() {
        return Env_PMC;
    }

    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 in not in ISO-C.

=cut

*/

    PMC* get_iter() {
        PMC *iter = pmc_new_init(interp, enum_class_Iterator, SELF);
        PMC *key = pmc_new(interp, enum_class_Key);
        PMC_struct_val(iter) = 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 in not in ISO-C.

=cut

*/

    INTVAL elements() {
        INTVAL rv = 0;
        while (environ[rv] != NULL) { rv++; }
        return rv;
    }

/*

=item C<INTVAL get_integer()>

Returns the size of the hash.

=cut

*/

    INTVAL get_integer() {
        return DYNSELF.elements();
    }

/*

=item C<FLOATVAL get_number()>

Returns the size of the hash.

=cut

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

/*

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

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

=cut

*/

    STRING* get_string_keyed(PMC* key) {
        int free_it = 0;
        STRING *retval;
        char *keyname, *envp, *p, *val = NULL;

        switch (PObj_get_FLAGS(key) & KEY_type_FLAGS) {
            case KEY_integer_FLAG:
                if (PMC_int_val(key) < 0) {
                    retval = string_from_cstring(interp, "", 0);
                }
                else {
                    envp = environ[PMC_int_val(key)];
                    p = strchr(envp, '=');
                    retval = string_from_cstring(interp, envp, (p-envp));
                }
                break;
            default:
                keyname = string_to_cstring(interp,
                    VTABLE_get_string(interp, key));
                if (keyname) {
                    val = Parrot_getenv(keyname, &free_it);
                    string_cstring_free(keyname);
                    if (val) {
                        retval = string_from_cstring(interp, val, 0);
                    }
                    else {
                        retval = string_from_cstring(interp, "", 0);
                    }
                }
                else {
                    retval = string_from_cstring(interp, "", 0);
                }
                if (free_it && val) mem_sys_free(val);
                break;
        }
        return retval;
    }

/*

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

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

=cut

*/

    PMC* get_pmc_keyed(PMC* key) {
        char *keyname = string_to_cstring(INTERP,
            VTABLE_get_string(INTERP, key));
        int free_it = 0;
        STRING *retval;
        PMC *return_pmc;
        char *val = NULL;

        if (keyname) {
            val = Parrot_getenv(keyname, &free_it);
            string_cstring_free(keyname);
            if (val) {
                retval = string_from_cstring(INTERP, val, 0);
            }
            else {
                retval = string_from_cstring(INTERP, "", 0);
            }
        }
        else {
            retval = string_from_cstring(INTERP, "", 0);
        }
        if (free_it && val) mem_sys_free(val);
        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

*/

    void set_string_keyed(PMC* key, STRING* value) {
        char *keyname = string_to_cstring(INTERP,
            VTABLE_get_string(INTERP, key));
        char *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

*/

    void set_pmc_keyed(PMC* key, PMC* value) {
        char *keyname = string_to_cstring(INTERP,
            VTABLE_get_string(INTERP, key));
        STRING *str_value = VTABLE_get_string(INTERP, value);
        char *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

*/

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

        if (keyname) {
            char *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

*/

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

        if (keyname) {
            char *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_basic_types.html#Hash_types>

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

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

=cut

*/

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