/*
 * This file is based on Class::XSAccessor
 * by Steffen Müller, Copyright (C) 2008 by Steffen Mueller
 *
 * Copyright (C) 2008 Martin Kutter
 *
 */

#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"

#include "AutoXS.h"

HV * global_hash_ref;
HV * global_hierarchy_of;
HV * global_attribute_of;

HV* global_do_cache_class_of;
HV* global_cache_of;

autoxs_hashkey global_ref_key;

char * get_class(SV* obj, HV* class_stash) {
    char * class_name;
    class_stash = SvSTASH(SvRV(obj));
    if ((class_stash == NULL) || ((SV*)class_stash == &PL_sv_undef)) {
        croak("No stash found");
    }
    class_name = HvNAME(class_stash);
    if (class_name == NULL) {
        croak("Ooops: Lost object class name");
    }
    return class_name;
}


void init(SV* data_hash_ref, SV* attribute_hash_ref, SV * do_cache_class_ref, SV* cache_ref) {
    global_hash_ref = (HV*)SvRV(data_hash_ref);
    global_attribute_of = (HV*)SvRV(attribute_hash_ref);

    global_ref_key.key = newSVpvn("ref", 3);
    PERL_HASH(global_ref_key.hash, "ref", 3);

    global_hierarchy_of = newHV();

    global_do_cache_class_of = (HV*)SvRV(do_cache_class_ref);
    global_cache_of = (HV*)SvRV(cache_ref);

}

AV * hierarchy_of(char * class_name) {
    AV* retval = newAV();
    dSP;
    int count;
    int i;

    ENTER;
    SAVETMPS;

    PUSHMARK(SP);
    XPUSHs(sv_2mortal(newSVpv(class_name,0)));
    PUTBACK;

    count = call_pv("Class::Std::Fast::_hierarchy_of", G_ARRAY);

    SPAGAIN;

    for (i = 1; i <= count; ++i) {
        av_push(retval, newSVsv(POPs));
    }

    PUTBACK;
    FREETMPS;
    LEAVE;
    return retval;
}

void demolish(SV* class_name, unsigned int class_len, SV * object) {
    //char * demolish_c = malloc(SvCUR(class_name) + 11);
    char * demolish_c = malloc(class_len + 11);
    strcpy(demolish_c, SvPV_nolen(class_name));
    strcat(demolish_c, "::DEMOLISH");

    if (get_cv(demolish_c, 0)) {
        // printf("DEMOLISH\n");
        dSP;
        ENTER;
        SAVETMPS;

        PUSHMARK(SP);
        XPUSHs(object);
        PUTBACK;

        call_pv(demolish_c, G_SCALAR|G_DISCARD);

        SPAGAIN;
        PUTBACK;
        FREETMPS;
        LEAVE;
    }
    free(demolish_c);
    return;
}

void cache_store (SV* object, char* class_name, unsigned int len, HV* class_stash) {
    SV** pool_ref;
    AV* pool;

    if (pool_ref = hv_fetch(global_cache_of, class_name, len, 0)) {
        pool = (AV*)SvRV(*pool_ref);
    }
    else {
        pool = newAV();
        hv_store(global_cache_of, class_name, len, newRV_inc((SV*)pool), 0);
    }

    sv_bless(object, class_stash);
    SvREFCNT_inc(object);
    av_push(pool, object);
}

// TODO: add safety checks...
void destroy(SV* object) {
    SV* ident = SvRV(object);
    HV* class_stash;

    // class_stash is returned via parameter list
    char * class_name; // = get_class(object, class_stash);
    unsigned int len;
    unsigned int base_class_len;
    I32 i = 0;
    I32 j;

    SV** parent_ref;
    AV * parent_from;
    I32 parent_len;

    SV** attr_ref;
    AV * attr_from;
    I32 attr_len;

    HE* he;

    SV** attr;
    SV** base_class;

    SV** cache_ref;

    class_stash = SvSTASH(SvRV(object));
    if ((class_stash == NULL) || ((SV*)class_stash == &PL_sv_undef)) {
        croak("No stash found");
    }
    class_name = HvNAME(class_stash);
    if (class_name == NULL) {
        croak("Ooops: Lost object class name");
    }
    len = strlen(class_name);

    // if there exists a hierarchy_of entry
    if (parent_ref = hv_fetch(global_hierarchy_of, class_name, len, 0)) {
        parent_from = (AV*)SvRV(*parent_ref);
    }
    else {
        // get hierarchy from perl
        parent_from = hierarchy_of(class_name);
        // store in hierarchy_of hash
        //printf("hierarchy of\n");
        hv_store(global_hierarchy_of, class_name, len, newRV_inc((SV*)parent_from), 0);
    }
    {
        parent_len = av_len(parent_from);

        // for all classes in hierarchy
        for (; i <= parent_len; ) {
            // printf("%d\n", i);
            if (base_class = av_fetch(parent_from, i++,0)) {
                // call DEMOLISH if exists
                base_class_len = SvCUR(*base_class);
                demolish(*base_class, base_class_len, object);

                //if (attr_ref = hv_fetch(global_attribute_of, SvPV_nolen(*base_class), SvCUR(*base_class), 0)) {
                if (attr_ref = hv_fetch(global_attribute_of, SvPV_nolen(*base_class), base_class_len, 0)) {
                    if (! SvROK(*attr_ref))
                        croak("Oops - not a reference");
                    attr_from = (AV*)SvRV(*attr_ref);
                    attr_len = av_len(attr_from);
                    // for all attributes in class
                    for (j = 0; j <= attr_len;) {
                        // printf("attr\n");
                        if (attr = av_fetch(attr_from, j++, 0)) {
                            if (he = hv_fetch_ent((HV*)SvRV(*attr), global_ref_key.key, 0, global_ref_key.hash)) {
                                // TODO: check whether he contains a hash ref
                                if (! SvROK(HeVAL(he)))
                                    croak("Oops - not a reference");
                                hv_delete_ent((HV*)SvRV(HeVAL(he)), ident, G_DISCARD, 0);
                            }
                        }
                    }
                }
            }
        }
        if (hv_exists(global_do_cache_class_of, class_name, len)) {
            cache_store(object, class_name, len, class_stash);
        }
    }
}

MODULE = Class::Std::Fast_XS      PACKAGE = Class::Std::Fast_XS

void destroy(object);
    SV * object;

void init(data_hash_ref, attribute_hash_ref, do_cache_class_ref, cache_ref)
    SV*     data_hash_ref;
    SV*     attribute_hash_ref;
    SV*     do_cache_class_ref;
    SV*     cache_ref;

void
getter(self)
        SV* self;
    ALIAS:
    INIT:
        /* Get the const hash key struct from the global storage */
        /* ix is the magic integer variable that is set by the perl guts for us.
         * We uses it to identify the currently running alias of the accessor. Gollum! */
        const autoxs_hashkey readfrom = AutoXS_hashkeys[ix];
        HE* he;
        HE* value_ent;
        SV* key;
    PPCODE:
        if (he = hv_fetch_ent(global_hash_ref, readfrom.key, 0, readfrom.hash)) {
            if (value_ent = hv_fetch_ent((HV*)SvRV(HeVAL(he)), SvRV(self), 0, 0)) {
                XPUSHs(HeVAL(value_ent));
            }
            else {
                XSRETURN_UNDEF;
            }
        }
        else {
            XSRETURN_UNDEF;
        }



void
setter(self, newvalue)
    SV* self;
    SV* newvalue;
  ALIAS:
  INIT:
    /* Get the const hash key struct from the global storage */
    /* ix is the magic integer variable that is set by the perl guts for us.
     * We uses it to identify the currently running alias of the accessor. Gollum! */
    const autoxs_hashkey readfrom = AutoXS_hashkeys[ix];
    HE* he;
    SV* key;

    PPCODE:
    SvREFCNT_inc(newvalue);
    if (he = hv_fetch_ent(global_hash_ref, readfrom.key, 0, readfrom.hash)) {
        key = SvRV(self);
        if (NULL == hv_store_ent((HV*)SvRV(HeVAL(he)), key, newvalue, 0)) {
          croak("Failed to write new value to hash.");
        }
    }
    XPUSHs(self);


void
newxs_getter(name, key)
  char* name;
  char* key;
  PPCODE:
    char* file = __FILE__;
    const unsigned int functionIndex = get_next_hashkey();
    {
      CV * cv;
      unsigned int len;
      autoxs_hashkey hashkey;
      /* This code is very similar to what you get from using the ALIAS XS syntax.
       * Except I took it from the generated C code. Hic sunt dragones, I suppose... */
      cv = newXS(name, XS_Class__Std__Fast_XS_getter, file);
      if (cv == NULL)
        croak("ARG! SOMETHING WENT REALLY WRONG!");
      XSANY.any_i32 = functionIndex;

      /* Precompute the hash of the key and store it in the global structure */
      len = strlen(key);
      hashkey.key = newSVpvn(key, len);
      PERL_HASH(hashkey.hash, key, len);
      AutoXS_hashkeys[functionIndex] = hashkey;
    }


void
newxs_setter(name, key)
  char* name;
  char* key;
  PPCODE:
    char* file = __FILE__;
    const unsigned int functionIndex = get_next_hashkey();
    {
      CV * cv;
      unsigned int len;
      autoxs_hashkey hashkey;
      /* This code is very similar to what you get from using the ALIAS XS syntax.
       * Except I took it from the generated C code. Hic sunt dragones, I suppose... */
      cv = newXS(name, XS_Class__Std__Fast_XS_setter, file);
      if (cv == NULL)
        croak("ARG! SOMETHING WENT REALLY WRONG!");
      XSANY.any_i32 = functionIndex;

      /* Precompute the hash of the key and store it in the global structure */
      len = strlen(key);
      hashkey.key = newSVpvn(key, len);
      PERL_HASH(hashkey.hash, key, len);
      AutoXS_hashkeys[functionIndex] = hashkey;
    }