#include <assert.h>
#include <EXTERN.h>
#include <perl.h>
#include <XSUB.h>
#include <sys/mman.h>
#include <sys/types.h>
#include <sys/stat.h>
#include <fcntl.h>
#include <gtk/gtk.h>
#include "entity.h"

/* quiet compiler.. this is sometimes defined in perly.h */
#ifdef PACKAGE
#undef PACKAGE
#endif

#define PERL_ENTITY_INIT "E-init.pl"

/* For perl 5004 compat. */
#ifndef ERRSV
#define ERRSV GvSV (errgv)
#endif				/* ERRSV */

/* This variable is used to keep track of which node has called a perl
 * function so that we know from where the various C functions called from
 * perl, know where to find the object root (<object> tag).
 * 
 * This only really works because the whole thing is a single thread. In the
 * future, we may need to do some other magic to make this work. */

static PerlInterpreter *my_perl;


/* For keeping track of nodes */
XS (XS_Entity_enode_ptr);
XS (XS_Entity_enode_ref);
XS (XS_Entity_enode_unref);

/* Interlanguage calling. */
XS (XS_Entity_enode_call);

/* Base Interface */
XS (XS_Entity_enode_new_child);
XS (XS_Entity_enode_type);
XS (XS_Entity_enode_path);
XS (XS_Entity_enode_description);

/* Node Search Routines */
XS (XS_Entity_enode_parent);
XS (XS_Entity_enode_child);
XS (XS_Entity_enode_child_rx);
XS (XS_Entity_enode_children);
XS (XS_Entity_enode_children_rx);
XS (XS_Entity_enode_children_attrib);
XS (XS_Entity_enode_children_attrib_rx);

/* Attribute Properties, and Attribute Support Queries */
XS (XS_Entity_enode_attrib);
XS (XS_Entity_enode_attrib_quiet);
XS (XS_Entity_enode_attrib_is_true);
XS (XS_Entity_enode_list_set_attribs);
XS (XS_Entity_enode_supported_attribs);
XS (XS_Entity_enode_attrib_description);
XS (XS_Entity_enode_attrib_value_type);
XS (XS_Entity_enode_attrib_possible_values);
XS (XS_Entity_enode_attribs_sync);

/* Node destruction */
XS (XS_Entity_enode_destroy);
XS (XS_Entity_enode_destroy_children);

/* Raw XML Interfaces */
XS (XS_Entity_enode_get_xml);
XS (XS_Entity_enode_get_child_xml);
XS (XS_Entity_enode_append_xml);

/* Node Data interface */
XS (XS_Entity_enode_set_data);
XS (XS_Entity_enode_get_data);
XS (XS_Entity_enode_append_data);
XS (XS_Entity_enode_insert_data);
XS (XS_Entity_enode_delete_data);

/* ... */



/* These are used to bootstrap dynamic module loading in perl */
void boot_DynaLoader _((CV * cv));

void
xs_init ()
{
    char *file = __FILE__;
    /* DynaLoader is a special case */
#ifdef STATIC_PERL
    newXS ("DynaLoader::boot_DynaLoader", boot_DynaLoader, file);
#endif
}

static gint perl_initialized = FALSE;

static gint
perl_not_initialized (void)
{
    return (!perl_initialized);
}

static void
initialize_perl (void)
{
    char *perl_args[] = { "perl", NULL, NULL, NULL, "-w" };
    gint ret;

    if (perl_initialized)
	return;
    else
	perl_initialized = TRUE;

    perl_args[1] =
	g_strconcat ("-I", g_get_home_dir (), "/entity/modules", NULL);
    perl_args[2] = g_strconcat ("-I", DATADIR, NULL);
    perl_args[3] = g_strconcat (DATADIR, "/", PERL_ENTITY_INIT, NULL);
    EDEBUG (("perl", "Calling: %s %s %s %s", perl_args[0], perl_args[1],
	     perl_args[2], perl_args[3]));

    my_perl = perl_alloc ();
    perl_construct (my_perl);
    ret = perl_parse (my_perl, xs_init, 5, perl_args, NULL);

    if (ret) {
	g_error ("Error initializing perl, perhaps couldn't load '%s'",
		 PERL_ENTITY_INIT);
    }

    perl_run (my_perl);

    /* load up custom XML/Entity perl functions */

    /* For keeping node association. */
    newXS ("Entity::enode_ptr", XS_Entity_enode_ptr, "Entity");
    newXS ("Entity::enode_ref", XS_Entity_enode_ref, "Entity");
    newXS ("Entity::enode_unref", XS_Entity_enode_unref, "Entity");

    /* Interlanguage calling. */
    newXS ("Entity::enode_call", XS_Entity_enode_call, "Entity");

    /* Base Interface */
    newXS ("Entity::enode_new_child", XS_Entity_enode_new_child, "Entity");
    newXS ("Entity::enode_type", XS_Entity_enode_type, "Entity");
    newXS ("Entity::enode_path", XS_Entity_enode_path, "Entity");
    newXS ("Entity::enode_description", XS_Entity_enode_description, "Entity");

    /* Node Search Routines */
    newXS ("Entity::enode_parent", XS_Entity_enode_parent, "Entity");
    newXS ("Entity::enode_child", XS_Entity_enode_child, "Entity");
    newXS ("Entity::enode_child_rx", XS_Entity_enode_child_rx, "Entity");
    newXS ("Entity::enode_children", XS_Entity_enode_children, "Entity");
    newXS ("Entity::enode_children_rx", XS_Entity_enode_children_rx, "Entity");
    newXS ("Entity::enode_children_attrib", XS_Entity_enode_children_attrib,
	   "Entity");
    newXS ("Entity::enode_children_attrib_rx",
	   XS_Entity_enode_children_attrib_rx, "Entity");

    /* Attribute Properties, and Attribute Support Queries */
    newXS ("Entity::enode_attrib", XS_Entity_enode_attrib, "Entity");
    newXS ("Entity::enode_attrib_quiet", XS_Entity_enode_attrib_quiet, "Entity");
    newXS ("Entity::enode_attrib_is_true", XS_Entity_enode_attrib_is_true,
	   "Entity");
    newXS ("Entity::enode_list_set_attribs", XS_Entity_enode_list_set_attribs,
	   "Entity");
    newXS ("Entity::enode_supported_attribs", XS_Entity_enode_supported_attribs,
	   "Entity");
    newXS ("Entity::enode_attrib_description",
	   XS_Entity_enode_attrib_description, "Entity");
    newXS ("Entity::enode_attrib_value_type", XS_Entity_enode_attrib_value_type,
	   "Entity");
    newXS ("Entity::enode_attrib_possible_values",
	   XS_Entity_enode_attrib_possible_values, "Entity");
    newXS ("Entity::enode_attribs_sync", XS_Entity_enode_attribs_sync,
	   "Entity");

    /* Node destruction */
    newXS ("Entity::enode_destroy", XS_Entity_enode_destroy, "Entity");
    newXS ("Entity::enode_destroy_children", XS_Entity_enode_destroy_children,
	   "Entity");

    /* Raw XML Interfaces */
    newXS ("Entity::enode_get_xml", XS_Entity_enode_get_xml, "Entity");
    newXS ("Entity::enode_get_child_xml", XS_Entity_enode_get_child_xml,
	   "Entity");
    newXS ("Entity::enode_append_xml", XS_Entity_enode_append_xml, "Entity");

    /* Node Data interface */
    newXS ("Entity::enode_set_data", XS_Entity_enode_set_data, "Entity");
    newXS ("Entity::enode_get_data", XS_Entity_enode_get_data, "Entity");
    newXS ("Entity::enode_append_data", XS_Entity_enode_append_data, "Entity");
    newXS ("Entity::enode_delete_data", XS_Entity_enode_delete_data, "Entity");
    newXS ("Entity::enode_insert_data", XS_Entity_enode_insert_data, "Entity");
}

/* Here we are setting/getting the appopriate namespace * (using the
 * 'package' command in perl to set it) */
static gchar *
get_perl_namespace (void)
{
    return (enode_call_get_namespace ("perl"));
}

static SV *
perl_get_enode (ENode * node)
{
    SV *sv;
    gint count;
    dSP;
    STRLEN n_a;

    if (!node)
	return (NULL);

    ENTER;
    SAVETMPS;

    PUSHMARK (sp);

    XPUSHs (sv_2mortal (newSVpv ("ENode", strlen ("ENode"))));
    XPUSHs (sv_2mortal (newSViv ((IV) node)));

    PUTBACK;

    count = perl_call_pv ("ENode::new_from_ptr", G_SCALAR | G_EVAL);

    SPAGAIN;

    if (SvTRUE (ERRSV)) {
	fprintf (stderr, "Perl: %s: %s",
		 "ENode::enode_from_ptr", SvPV (ERRSV, n_a));
	return FALSE;
    }

    sv = POPs;


    EDEBUG (("perl-embed", "returned %d from ENode::enode_from_ptr", count));


    /* Increment refcount so it survives the FREETMPS below, after that it's
     * * down to 1 which I beleive is safe for pushing onto stack and having
     * * it freed properly.  MW Not quite, but we have to _dec once the func
     * is * called. */
    SvREFCNT_inc (sv);

    PUTBACK;
    FREETMPS;
    LEAVE;

    EDEBUG (("perl-embed", "SvROK is %d, refcount %d", SvROK (sv),
	     SvREFCNT (sv)));

    return (sv);
}

/* Freed MW */
EBuf *
execute_perl_function (ENode * calling_node, gchar * function, GSList * args)
{
    int stack_size;
    EBuf *retbuf;
    static GString *perl_cmd = NULL;
    GSList *tmp;
    GSList *nodelist = NULL;
    LangArg *arg;
    gchar *namespace;
    SV *enode_sv = NULL;
    dSP;
    STRLEN n_a;

    /* insure perl init */
    if (perl_not_initialized ()) {
	g_warning
	    ("Attempt to call perl function '%s' when there hasn't been any perl blocks.",
	     function);
	enode_call_free_arg_list_items (args);
	return (NULL);
    }

    namespace = get_perl_namespace ();

    if (!perl_cmd)
	perl_cmd = g_string_sized_new (1024);

    g_string_truncate (perl_cmd, 0);

    /* Only set the namespace if they're calling into 'main' */
    if (!strstr (function, "::")) {
	g_string_append (perl_cmd, namespace);
	g_string_append (perl_cmd, "::");
    }
    g_string_append (perl_cmd, function);

    ENTER;
    SAVETMPS;
    PUSHMARK (sp);

    tmp = args;

    while (tmp) {
	arg = (LangArg *) tmp->data;

	if (arg->type == LANG_NODE) {
	    enode_sv = perl_get_enode (arg->data);

	    EDEBUG (("perl-embed", "SvROK is now %d, refcount %d",
		     SvROK (enode_sv), SvREFCNT (enode_sv)));
	    if (enode_sv) {
		XPUSHs (enode_sv);
		nodelist = g_slist_append (nodelist, enode_sv);
	    } else {
		EDEBUG (("perl-embed2", "Node not found :("));
	    }
	}
	    else if (arg->type == LANG_STRING ||
		     arg->type == LANG_INT ||
		     arg->type == LANG_DOUBLE || arg->type == LANG_BINSTRING) {
	    if (arg->size > 0) {
		EDEBUG (
			("perl-embed", "arg = %s, size= %i", arg->data,
			 arg->size));
		XPUSHs (sv_2mortal (newSVpv (arg->data, arg->size)));
	    } else {
		XPUSHs (sv_2mortal (newSVpv ("", 1)));
	    }
	}

	enode_call_free_arg (arg);
	tmp = tmp->next;
    }

    PUTBACK;
    stack_size = perl_call_pv (perl_cmd->str, G_EVAL);
    SPAGAIN;

    /* OK, time to get the return value. */
    EDEBUG (("perl-embed-test", "stack_size = %i", stack_size));

    if (stack_size) {		/* Don't deal with lists, just get the first. 
				 */
	gchar *tmpstr;
	tmpstr = POPp;
	EDEBUG (("perl-embed-test", "POPp = %s", tmpstr));
	retbuf = ebuf_new_with_str (tmpstr);
    } else {
	retbuf = NULL;
    }

    /* Free our perl enodes. */
    for (tmp = nodelist; tmp; tmp = tmp->next) {
	enode_sv = tmp->data;
	SvREFCNT_dec (enode_sv);
    }
    g_slist_free (nodelist);

    if (SvTRUE (ERRSV)) {
	g_warning ("Perl: %s: %s", function, SvPV (ERRSV, n_a));
	return (NULL);
    }

    PUTBACK;			/* This is really needed or perl dies. Spent
				 * around 1hr on this. */
    FREETMPS;
    LEAVE;

    return (retbuf);
}

static void
my_perl_eval_pv (gchar * p)
{
    dSP;
    SV *sv = newSVpv (p, 0);

    PUSHMARK (SP);
    perl_eval_sv (sv, G_SCALAR | G_KEEPERR);
    SvREFCNT_dec (sv);

    SPAGAIN;
    PUTBACK;
}

void
execute_perl_code (ENode * calling_node, gchar * code)
{
    EBuf *perl_cmd = NULL;
    gchar *namespace;
    STRLEN n_a;

    if (perl_cmd == NULL)
	perl_cmd = ebuf_new_sized (1024);
    ebuf_truncate (perl_cmd, 0);

    enode_call_reference_push (calling_node);

    namespace = get_perl_namespace ();

    ebuf_append_str (perl_cmd, "package ");
    ebuf_append_str (perl_cmd, namespace);
    ebuf_append_str (perl_cmd,
		     "; ENode::import ('enode'); ENode::import ('enode_rx'); ");
    ebuf_append_str (perl_cmd,
		     "ENode::import ('elist'); ENode::import ('elist_rx'); ");
    ebuf_append_str (perl_cmd, code);

    EDEBUG (("perl-embed0", "executing perl '%s'", perl_cmd->str));
    my_perl_eval_pv (perl_cmd->str);
    ebuf_free (perl_cmd);

    if (SvTRUE (ERRSV)) {
	EBuf *name = enode_attrib (calling_node, "name", NULL);
	g_warning ("Error evaluating perl in node %s.%s: %s",
		   calling_node->element->str, name ? name->str : "NULL",
		   SvPV (ERRSV, n_a));
    }

    enode_call_reference_pop ();
}

/* Various XML handlers */
static void
perl_node_render (ENode * node)
{
    /* insure perl init */
    initialize_perl ();

    if (node && node->data)
	execute_perl_code (node, node->data->str);
}

static void
perl_node_destroy (ENode * node)
{
    /* TODO: Should do all that spiffy namespace cleaning stuff */
    return;
}

/* initialize perl */

#ifdef STATIC_PERL
void
perl_init (RendererFlags flags)
#else
void
renderer_init (RendererFlags flags)
#endif
{
    Element *element;

    /* initialize perl interpreter */
    /* initialize_perl (); */

    /* for extra cleaning.. we hope */
    /* PL_perl_destruct_level = 1; */

    if (flags & RENDERER_REGISTER) {
	/* Register perl as a tag type */
	element = g_malloc0 (sizeof (Element));
	element->render_func = perl_node_render;
	element->destroy_func = perl_node_destroy;
	element->description =
	    "Include embedded Perl in your Entity application.";
	element->tag = "perl";

	element_register (element);

	/* register perl language type */
	language_register ("perl", execute_perl_function);
    }
}





#define EARGS EBuf *_buf; gchar *_path; gint _len; _buf = NULL; _path = NULL; _len = 0

#define EARG_ENODE(argnode,argnum) \
			do { argnode = (ENode *) SvIV (ST (argnum)); } while (0)

#define EARG_EBUF(argbuf,argnum) do { _path = SvPV (ST (argnum), _len); \
			if (_path) \
				argbuf = ebuf_new_with_data (_path, _len); \
			else \
				argbuf = NULL; \
			} while (0)

#define EARG_STR(argstr,argnum) do { argstr = SvPV (ST (argnum), _len); } while (0)

#define EARG_INT(argint,argnum) do { argint = SvIV (ST (argnum)); } while (0)

#define EARG_DOUBLE(argdouble,argnum) do { argdouble = SvNV (ST (argnum)); } while (0)

#define XSRETURN_ENODE(node)	XSRETURN_IV ((IV) node)

#define XSRETURN_EBUF(buf) do { if (!buf) XSRETURN_UNDEF; \
			   	XST_mPV (0, buf->str); \
			   	XSRETURN (1); \
			   } while (0)

#define XSRETURN_STR(buf) do { if (!buf) XSRETURN_UNDEF; \
      			   XST_mPV (0, buf); \
      			   XSRETURN (1); \
			  } while (0)

#define CLEAR_STACK   while (items) { SV *foo; foo = POPs; items--; }



static void
arg_warn (gint good, gchar * func)
{
    if (!good)
	g_warning ("Perl: Incorrect number of arguments to function '%s'",
		   func);
}


/* Interlanguage calling. */
XS (XS_Entity_enode_call)
{
    ENode *calling_node;
    ENode *node;
    char *fmt;
    int i;
    GSList *args = NULL;
    char *function;
    EBuf *retval;

    char *string;
    int inter;
    EBuf *ebuffer;

    dXSARGS;
    EARGS;

    if (items < 1) {
	arg_warn (items < 1, "enode_call");
	XSRETURN_EMPTY;
    }

    EARG_ENODE (calling_node, 0);
    if (calling_node == NULL) {
	XSRETURN_EMPTY;
    }

    EARG_STR (function, 1);
    EARG_STR (fmt, 2);

    EDEBUG (("perl-embed2", "items = %i, %s", items, fmt));

    /* Make sure the fmt is set, u can call a function without it.. */
    if (fmt) {
	/* Run down the arguments collecting them into an argument list * for 
	 * enode_call_with_list(). Don't over run the number * of items in
	 * the list */
	for (i = 3; i < items && *fmt; i++, fmt++) {
	    if ('n' == *fmt) {
		EARG_STR (string, i);
		node = enode (string);
		ECHECK (node != NULL);
		args = enode_call_push_node (args, node);
	    } else if ('e' == *fmt) {
		EARG_EBUF (ebuffer, i);
		args = enode_call_push_data (args, ebuffer->str, ebuffer->len);
	    } else if ('s' == *fmt) {
		EARG_STR (string, i);
		args = enode_call_push_str (args, string);
	    } else if ('i' == *fmt) {
		EARG_INT (inter, i);
		args = enode_call_push_int (args, inter);
	    }
	    /* This one is a little tricky because you need to make sure that
	     * * there are enough items on the stack before pulling off the * 
	     * size of the buffer.  'e' should be used in favor of 'b' but *
	     * maybe someone has need for binary info. */
	    else if ('b' == *fmt && i + 1 < items) {
		EARG_STR (string, i);
		EARG_INT (inter, i + 1);
		args = enode_call_push_data (args, string, inter);
	    }
	}
    }

    /* EDEBUG (("perl-embed2", "args len = %i", g_slist_length (args) )); */
    retval = enode_call_with_list (calling_node, function, args);

    if (!retval)
	XSRETURN_EMPTY;

    XST_mPV (0, retval->str);
    ebuf_free (retval);

    XSRETURN (1);
}


/* Base Interface */
XS (XS_Entity_enode_new_child)
{
    gchar *type;
    ENode *node;
    ENode *new_child = NULL;
    EBuf *attr,
    *value;
    gint i;
    GSList *attribs = NULL;
    GSList *attribs_tail = NULL;
    dXSARGS;
    EARGS;

    arg_warn (items >= 2, "new_child");
    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_UNDEF;

    EARG_STR (type, 1);
    if (type == NULL)
	XSRETURN_UNDEF;

    for (i = 2; i < items; i += 2) {
	EARG_EBUF (attr, i);
	EARG_EBUF (value, i + 1);

	attribs = g_slist_append_tail (attribs, attr, &attribs_tail);
	attribs = g_slist_append_tail (attribs, value, &attribs_tail);
    }

    new_child = enode_new_child (node, type, attribs);

    XSRETURN_ENODE (new_child);
}

XS (XS_Entity_enode_type)
{
    EBuf *type;
    ENode *node;
    dXSARGS;
    EARGS;

    arg_warn (items == 1, "type");
    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;

    type = enode_type (node);

    XSRETURN_EBUF (type);
}

XS (XS_Entity_enode_ptr)
{
    ENode *node;
    dXSARGS;
    STRLEN n_a;
    EARGS;

    arg_warn (items == 1, "enode_ptr");

    node = enode (SvPV (ST (0), n_a));
    XSRETURN_ENODE (node);
}

XS (XS_Entity_enode_ref)
{
    ENode *node;
    dXSARGS;
    EARGS;

    arg_warn (items == 1, "enode_ref");

    EARG_ENODE (node, 0);
    ECHECK_RET (node != NULL);

    EDEBUG (("refcounting", "+1 ref to node %s", node->element->str));
    enode_ref (node);
}

XS (XS_Entity_enode_unref)
{
    ENode *node;
    dXSARGS;
    EARGS;

    arg_warn (items == 1, "enode_unref");

    EARG_ENODE (node, 0);
    ECHECK_RET (node != NULL);

    EDEBUG (("refcounting", "-1 ref to node %s", node->element->str));
    enode_unref (node);
}

XS (XS_Entity_enode_path)
{
    ENode *node;
    dXSARGS;
    EBuf *path;
    EARGS;

    arg_warn (items == 1, "path");
    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;

    path = enode_path (node);
    XSRETURN_EBUF (path);
}

XS (XS_Entity_enode_description)
{
    dXSARGS;
    items = 0;
    XSRETURN_EMPTY;
}


XS (XS_Entity_enode_parent)
{
    ENode *parent;
    ENode *node;
    gchar *search = NULL;
    dXSARGS;
    EARGS;

    arg_warn (items == 1 || items == 2, "parent");

    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;
    if (items == 2) {
	EARG_STR (search, 1);
    }

    parent = enode_parent (node, search);

    XSRETURN_ENODE (parent);
}

XS (XS_Entity_enode_child)
{
    ENode *node,
    *found;
    gchar *search;
    dXSARGS;
    EARGS;

    arg_warn (items == 2, "child");

    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;

    EARG_STR (search, 1);

    found = enode_child (node, search);

    XSRETURN_ENODE (found);
}

XS (XS_Entity_enode_child_rx)
{
    ENode *node,
    *found;
    gchar *regex;
    dXSARGS;
    EARGS;

    arg_warn (items == 2, "child_rx");

    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;
    EARG_STR (regex, 1);

    found = enode_child_rx (node, regex);

    XSRETURN_ENODE (found);
}

XS (XS_Entity_enode_children)
{
    GSList *tmp;
    GSList *children;
    gint nret = 0;
    gchar *search = NULL;
    ENode *node;
    dXSARGS;
    EARGS;

    arg_warn (items == 1 || items == 2, "children");

    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;

    if (items == 2)
	EARG_STR (search, 1);

    CLEAR_STACK;

    children = enode_children (node, search);

    tmp = children;
    while (tmp) {
	ENode *node = tmp->data;

	XPUSHs (sv_2mortal (newSViv ((IV) node)));
	/* EXTEND (SP, 1); XST_mIV (nret, (IV) node); */

	nret++;
	tmp = tmp->next;
    }

    if (children)
	g_slist_free (children);

    if (nret) {
	XSRETURN (nret);
    } else {
	XSRETURN_EMPTY;
    }
}

XS (XS_Entity_enode_children_rx)
{
    GSList *tmp;
    GSList *children = NULL;
    gint nret = 0;
    gchar *regex = NULL;
    ENode *node;
    dXSARGS;
    EARGS;

    arg_warn (items == 2, "children_rx");

    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;

    EARG_STR (regex, 1);
    if (regex == NULL)
	XSRETURN_EMPTY;

    children = enode_children_rx (node, regex);

    CLEAR_STACK;

    tmp = children;
    while (tmp) {
	ENode *node = tmp->data;

	XPUSHs (sv_2mortal (newSViv ((IV) node)));

	nret++;
	tmp = tmp->next;
    }

    g_slist_free (children);

    if (nret) {
	XSRETURN (nret);
    } else {
	XSRETURN_EMPTY;
    }
}


XS (XS_Entity_enode_children_attrib)
{
    GSList *tmp;
    GSList *children;
    gint nret = 0;
    gchar *attrib = NULL;
    EBuf *value = NULL;
    ENode *node;
    dXSARGS;
    EARGS;

    arg_warn (items == 3, "children_attrib");

    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;

    EARG_STR (attrib, 1);
    if (attrib == NULL)
	XSRETURN_EMPTY;

    EARG_EBUF (value, 2);
    if (value == NULL)
	XSRETURN_EMPTY;

    children = enode_children_attrib (node, attrib, value);
    ebuf_free (value);

    CLEAR_STACK;

    if (children) {

	tmp = children;
	while (tmp) {
	    ENode *node = tmp->data;
	    /* EXTEND (SP, 1); XST_mIV (nret, (IV) node); */

	    XPUSHs (sv_2mortal (newSViv ((IV) node)));

	    /* This list thing could work I think.. */
	    /* av_push (lst, (sv_2mortal (newSViv ((IV) node)))); */

	    nret++;
	    tmp = tmp->next;
	}

	g_slist_free (children);

	XSRETURN (nret);
    } else {
	XSRETURN_EMPTY;
    }

}

XS (XS_Entity_enode_children_attrib_rx)
{
    GSList *tmp;
    GSList *children;
    gint nret = 0;
    gchar *attrib = NULL;
    gchar *regex = NULL;
    ENode *node;
    dXSARGS;
    EARGS;

    arg_warn (items == 3, "children_attrib_rx");

    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;

    EARG_STR (attrib, 1);
    if (attrib == NULL)
	XSRETURN_EMPTY;

    EARG_STR (regex, 2);
    if (regex == NULL)
	XSRETURN_EMPTY;

    children = enode_children_attrib_rx (node, attrib, regex);

    CLEAR_STACK;

    tmp = children;
    while (tmp) {
	ENode *node = tmp->data;

	XPUSHs (sv_2mortal (newSViv ((IV) node)));

	nret++;
	tmp = tmp->next;
    }

    g_slist_free (children);

    if (nret) {
	XSRETURN (nret);
    } else {
	XSRETURN_EMPTY;
    }
}


/* Attribute Properties, and Attribute Support Queries */
XS (XS_Entity_enode_attrib)
{
    gchar *attr;
    EBuf *val = NULL;
    EBuf *ret = NULL;
    ENode *node;
    dXSARGS;
    EARGS;

    arg_warn (items <= 3, "attrib");

    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;

    EARG_STR (attr, 1);

    if (items > 2) {
	EARG_EBUF (val, 2);
    }

    if (node)
	ret = enode_attrib (node, attr, val);

    if (val) {
	XSRETURN_EMPTY;
    } else {
	XSRETURN_EBUF (ret);
    }
}

/* Attribute Properties, and Attribute Support Queries */
XS (XS_Entity_enode_attrib_quiet)
{
    gchar *attr;
    EBuf *val = NULL;
    EBuf *ret = NULL;
    ENode *node;
    dXSARGS;
    EARGS;

    arg_warn (items <= 3, "attrib");

    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;

    EARG_STR (attr, 1);

    if (items > 2) {
	EARG_EBUF (val, 2);
    }

    if (node)
	ret = enode_attrib_quiet (node, attr, val);

    if (val) {
	XSRETURN_EMPTY;
    } else {
	XSRETURN_EBUF (ret);
    }
}

XS (XS_Entity_enode_attrib_is_true)
{
    gchar *attr;
    EBuf *val = NULL;
    int ret = FALSE;
    ENode *node;
    dXSARGS;
    EARGS;

    arg_warn (items == 2, "attrib_is_true");

    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;

    EARG_STR (attr, 1);

    val = enode_attrib (node, attr, NULL);

    if (ebuf_not_empty (val))
	ret = erend_value_is_true (val);

    EDEBUG (("perl-embed", "attrib is true? %i", ret));

    XSRETURN_IV (ret);		/* Ret should be 1 or 0 / TRUE or FALSE. */
}

XS (XS_Entity_enode_list_set_attribs)
{
    GSList *attribs;
    GSList *tmp;
    gint nret = 0;
    ENode *node;
    dXSARGS;
    EARGS;

    arg_warn (items == 1, "list_set_attribs");
    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;

    attribs = enode_list_set_attribs (node);
    tmp = attribs;

    CLEAR_STACK;

    while (tmp) {
	EBuf *attr = tmp->data;

	XPUSHs (sv_2mortal (newSVpv (attr->str, attr->len)));

	nret++;
	tmp = tmp->next;
    }
    g_slist_free (attribs);

    if (nret) {
	XSRETURN (nret);
    } else {
	XSRETURN_EMPTY;
    }
}

XS (XS_Entity_enode_supported_attribs)
{
    GSList *attribs;
    GSList *tmp;
    gint nret = 0;
    ENode *node;
    dXSARGS;
    EARGS;

    arg_warn (items == 1, "supported_attribs");
    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;

    attribs = enode_supported_attribs (node);
    tmp = attribs;

    CLEAR_STACK;

    while (tmp) {
	gchar *attr = tmp->data;

	XPUSHs (sv_2mortal (newSVpv (attr, strlen (attr))));

	nret++;
	tmp = tmp->next;
    }
    g_slist_free (attribs);

    if (nret) {
	XSRETURN (nret);
    } else {
	XSRETURN_EMPTY;
    }
}

XS (XS_Entity_enode_attrib_description)
{
    gchar *desc;
    gchar *attr;
    ENode *node;
    dXSARGS;
    EARGS;

    arg_warn (items == 2, "attrib_description");
    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;

    EARG_STR (attr, 1);
    desc = enode_attrib_description (node, attr);
    XSRETURN_STR (desc);
}

XS (XS_Entity_enode_attrib_value_type)
{
    gchar *desc;
    gchar *attr;
    ENode *node;
    dXSARGS;
    EARGS;

    arg_warn (items == 2, "attrib_value_type");
    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;
    EARG_STR (attr, 1);
    if (attr == NULL)
	XSRETURN_EMPTY;

    desc = enode_attrib_value_type (node, attr);
    XSRETURN_STR (desc);
}

XS (XS_Entity_enode_attrib_possible_values)
{
    gchar *desc;
    gchar *attr;
    ENode *node;
    dXSARGS;
    EARGS;

    arg_warn (items == 2, "attrib_possible_values");
    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;
    EARG_STR (attr, 1);
    if (attr == NULL)
	XSRETURN_EMPTY;
    desc = enode_attrib_possible_values (node, attr);
    XSRETURN_STR (desc);
}

XS (XS_Entity_enode_attribs_sync)
{
    ENode *node;
    dXSARGS;
    EARGS;

    arg_warn (items == 1, "attribs_sync");
    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;
    enode_attribs_sync (node);

    XSRETURN_EMPTY;
}


/* Node destruction */
XS (XS_Entity_enode_destroy)
{
    ENode *node;
    dXSARGS;
    EARGS;

    arg_warn (items == 1, "destroy");

    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;

    enode_destroy (node);

    XSRETURN_EMPTY;
}

XS (XS_Entity_enode_destroy_children)
{
    ENode *node;
    dXSARGS;
    EARGS;

    arg_warn (items == 1, "destroy_children");

    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;

    enode_destroy_children (node);

    XSRETURN_EMPTY;
}


/* Raw XML Interfaces */
XS (XS_Entity_enode_get_xml)
{
    ENode *node;
    EBuf *xml;
    dXSARGS;
    EARGS;

    arg_warn (items == 1, "get_xml");

    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;

    xml = enode_get_xml (node);
    XST_mPV (0, xml->str);
    ebuf_free (xml);
    XSRETURN (1);
}

XS (XS_Entity_enode_get_child_xml)
{
    ENode *node;
    EBuf *xml;
    dXSARGS;
    EARGS;

    arg_warn (items == 1, "get_child_xml");

    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;

    xml = enode_get_child_xml (node);
    XST_mPV (0, xml->str);
    ebuf_free (xml);
    XSRETURN (1);
}

XS (XS_Entity_enode_append_xml)
{
    ENode *node;
    EBuf *xml;
    dXSARGS;
    EARGS;

    arg_warn (items == 2, "append_xml");

    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;
    EARG_EBUF (xml, 1);
    if (xml == NULL)
	XSRETURN_EMPTY;

    enode_append_xml (node, xml);
    ebuf_free (xml);
}


XS (XS_Entity_enode_set_data)
{
    ENode *node;
    EBuf *data;
    dXSARGS;
    EARGS;

    arg_warn (items == 2, "set_data");

    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;
    EARG_EBUF (data, 1);
    if (data == NULL)
	XSRETURN_EMPTY;

    enode_set_data (node, data);
    ebuf_free (data);
}

XS (XS_Entity_enode_get_data)
{
    ENode *node;
    EBuf *data = NULL;
    dXSARGS;
    EARGS;

    arg_warn (items == 1, "get_data");

    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;

    data = enode_get_data (node);

    XSRETURN_EBUF (data);
}

XS (XS_Entity_enode_append_data)
{
    ENode *node;
    EBuf *data;
    dXSARGS;
    EARGS;

    arg_warn (items == 2, "append_data");

    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;
    EARG_EBUF (data, 1);
    if (data == NULL)
	XSRETURN_EMPTY;

    enode_append_data (node, data);
    ebuf_free (data);
}

XS (XS_Entity_enode_insert_data)
{
    ENode *node;
    EBuf *data;
    unsigned long offset;
    dXSARGS;
    EARGS;

    arg_warn (items == 3, "insert_data");

    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;
    EARG_INT (offset, 1);
    EARG_EBUF (data, 2);
    if (data == NULL)
	XSRETURN_EMPTY;

    enode_insert_data (node, offset, data);
    ebuf_free (data);
}

XS (XS_Entity_enode_delete_data)
{
    ENode *node;
    unsigned long offset;
    unsigned long count;
    dXSARGS;
    EARGS;

    arg_warn (items == 3, "delete_data");

    EARG_ENODE (node, 0);
    if (node == NULL)
	XSRETURN_EMPTY;
    EARG_INT (offset, 1);
    EARG_INT (count, 2);

    enode_delete_data (node, offset, count);
}


syntax highlighted by Code2HTML, v. 0.9.1