#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