#include #include #include #include #include #include #include #include #include #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 ( 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); }