/*
Copyright (C) 2006-2008, The Perl Foundation.
$Id: /mirror/trunk/languages/lua/src/pmc/lua.pmc 35368 2009-01-10T12:09:00.109716Z fperrad  $

=head1 NAME

pmc/lua.pmc - Lua native runtime

=head1 DESCRIPTION

This singleton PMC holds some static methods.

=head2 Methods

=over 4

=cut

*/

#include "lua_private.h"
#include <locale.h>

INTVAL dynpmc_LuaBoolean;
INTVAL dynpmc_LuaFunction;
INTVAL dynpmc_LuaNil;
INTVAL dynpmc_LuaNumber;
INTVAL dynpmc_LuaString;
INTVAL dynpmc_LuaTable;
INTVAL dynpmc_LuaUserdata;

static PMC * Lua_PMC;


pmclass Lua
    singleton
    dynpmc
    group lua_group {

/*
* Class initialization.
*/
    void class_init() {
        Lua_PMC = NULL;

        if (pass) {
            dynpmc_LuaBoolean = pmc_type(INTERP,
              const_string(INTERP, "LuaBoolean"));
            dynpmc_LuaFunction = pmc_type(INTERP,
              const_string(INTERP, "LuaFunction"));
            dynpmc_LuaNil = pmc_type(INTERP,
              const_string(INTERP, "LuaNil"));
            dynpmc_LuaNumber = pmc_type(INTERP,
              const_string(INTERP, "LuaNumber"));
            dynpmc_LuaString = pmc_type(INTERP,
              const_string(INTERP, "LuaString"));
            dynpmc_LuaTable = pmc_type(INTERP,
              const_string(INTERP, "LuaTable"));
            dynpmc_LuaUserdata = pmc_type(INTERP,
              const_string(INTERP, "LuaUserdata"));
        }
    }

/*

=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

*/
    VTABLE void* get_pointer() {
        return Lua_PMC;
    }

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

/*

=item C<PMC* clock()>

=cut

*/
    METHOD PMC* clock() {
        PMC     *retval = pmc_new(INTERP, dynpmc_LuaNumber);
        FLOATVAL f      = (clock())/(FLOATVAL)CLOCKS_PER_SEC;
        VTABLE_set_number_native(INTERP, retval, f);
        RETURN(PMC *retval);
    }

/*

=item C<PMC* mktime(PMC *tm)>

=cut

*/
    METHOD PMC* mktime(PMC *tm) {
        time_t t;
        struct tm ts;
        PMC *retval;

        ts.tm_sec   = VTABLE_get_integer_keyed_int(INTERP, tm, 0);
        ts.tm_min   = VTABLE_get_integer_keyed_int(INTERP, tm, 1);
        ts.tm_hour  = VTABLE_get_integer_keyed_int(INTERP, tm, 2);
        ts.tm_mday  = VTABLE_get_integer_keyed_int(INTERP, tm, 3);
        ts.tm_mon   = VTABLE_get_integer_keyed_int(INTERP, tm, 4);
        ts.tm_year  = VTABLE_get_integer_keyed_int(INTERP, tm, 5);
        ts.tm_isdst = VTABLE_get_integer_keyed_int(INTERP, tm, 8);

        t = mktime(&ts);

        if (t == -1)
            retval = pmc_new(INTERP, dynpmc_LuaNil);
        else {
            retval = pmc_new(INTERP, dynpmc_LuaNumber);
            VTABLE_set_integer_native(INTERP, retval, t);
        }

        RETURN(PMC *retval);
    }

/*

=item C<PMC* setlocale(INTVAL category, STRING *locale)>

=cut

*/
    METHOD PMC* setlocale(INTVAL category, STRING *locale) {
        static const int cat[] = {
            LC_ALL, LC_COLLATE, LC_CTYPE, LC_MONETARY, LC_NUMERIC, LC_TIME
        };

        char *loc = (locale != NULL) ? string_to_cstring(INTERP, locale) : NULL;
        char *p   = setlocale(cat[category], loc);
        PMC  *retval;

        if (p) {
            retval = pmc_new(INTERP, dynpmc_LuaString);
            VTABLE_set_string_native(INTERP, retval,
                                     string_from_cstring(INTERP, p, 0));
        }
        else
            retval = pmc_new(INTERP, dynpmc_LuaNil);

        RETURN(PMC *retval);
    }

/*

=item C<STRING* strftime(STRING *fmt, PMC *tm)>

=cut

*/
    METHOD STRING* strftime(STRING* fmt, PMC* tm) {
        char        b[200];
        STRING     *retval;
        size_t      reslen;
        struct tm   stm;

        stm.tm_sec   = VTABLE_get_integer_keyed_int(INTERP, tm, 0);
        stm.tm_min   = VTABLE_get_integer_keyed_int(INTERP, tm, 1);
        stm.tm_hour  = VTABLE_get_integer_keyed_int(INTERP, tm, 2);
        stm.tm_mday  = VTABLE_get_integer_keyed_int(INTERP, tm, 3);
        stm.tm_mon   = VTABLE_get_integer_keyed_int(INTERP, tm, 4) - 1;
        stm.tm_year  = VTABLE_get_integer_keyed_int(INTERP, tm, 5) - 1900;
        stm.tm_wday  = VTABLE_get_integer_keyed_int(INTERP, tm, 6);
        stm.tm_yday  = VTABLE_get_integer_keyed_int(INTERP, tm, 7);
        stm.tm_isdst = VTABLE_get_integer_keyed_int(INTERP, tm, 8);

        { /* Limit s scope and lifetime */
            char *s = string_to_cstring(INTERP, fmt);
            reslen = strftime(b, sizeof b, s, &stm);
            string_cstring_free(s);
        }

        retval = string_from_cstring(INTERP, b, reslen);
        RETURN(STRING *retval);
    }

/*

=item C<STRING* tmpname()>

=cut

*/
    METHOD STRING* tmpname() {
        char    buff[32];
        STRING *retval;
        int     e;
#ifdef WIN32
        e = (tmpnam(buff) == NULL);
#else
        strcpy(buff, "/tmp/lua_XXXXXX");
        e = mkstemp(buff);

        if (e != -1)
            close(e);

        e = (e == -1);
#endif
        if (e)
            Parrot_ex_throw_from_c_args(INTERP, NULL, 1,
                "unable to generate a unique filename");

        retval = string_from_cstring(INTERP, buff, 0);
        RETURN(STRING *retval);
    }

}
/*

=back

=cut

*/

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