/*=====================================
* llrpt_createnode -- Create GEDCOM node
* usage: createnode(STRING, STRING) -> NODE
* args: (tag, value)
*===================================*/
PVALUE
llrpt_createnode (PNODE node, SYMTAB stab, BOOLEAN *eflg)
{
PNODE arg = iargs(node);
NODE newnode=0;
NODE prnt=NULL; /* parent node for new node */
STRING xref=NULL; /* xref for new node */
PVALUE val1=NULL, val2=NULL;
STRING str1=NULL; /* 1st arg, which is tag for new node */
STRING str2=NULL; /* 2nd arg, which is value for new node */
val1 = eval_and_coerce(PSTRING, arg, stab, eflg);
if (*eflg) {
prog_var_error(node, stab, arg, val1, nonstrx, "createnode", "1");
delete_pvalue(val1);
return NULL;
}
/* 1st arg is tag for new node */
str1 = pvalue_to_string(val1);
val2 = eval_and_coerce(PSTRING, arg=inext(arg), stab, eflg);
if (*eflg) {
prog_var_error(node, stab, arg, val2, nonstrx, "createnode", "2");
delete_pvalue(val2);
return NULL;
}
/* 2nd arg is value for new node */
str2 = pvalue_to_string(val2);
newnode = create_temp_node(xref, str1, str2, prnt);
return create_pvalue_from_node(newnode);
}
/*============================================
* llrpt_detachnode -- Remove node from GEDCOM tree
* usage: detachnode(NODE) -> VOID
* (This is the historic deletenode)
*==========================================*/
PVALUE
llrpt_detachnode (PNODE node, SYMTAB stab, BOOLEAN *eflg)
{
PNODE arg = iargs(node);
NODE dead, prnt;
PVALUE val = eval_and_coerce(PGNODE, arg, stab, eflg);
if (*eflg) {
prog_var_error(node, stab, arg, val, nonnod1, "detachnode");
delete_pvalue(val);
return NULL;
}
dead = pvalue_to_node(val);
if ((prnt = nparent(dead))) {
NODE prev = NULL, next;
NODE curs = nchild(prnt);
while (curs && curs != dead) {
prev = curs;
curs = nsibling(curs);
}
ASSERT(curs); /* else broken tree: dead was not child of its parent */
next = nsibling(dead);
if (prev == NULL)
nchild(prnt) = next;
else
nsibling(prev) = next;
}
/* unparent node, but ensure its locking is only releative to new parent */
dolock_node_in_cache(dead, FALSE);
nparent(dead) = NULL;
dolock_node_in_cache(dead, TRUE);
nsibling(dead) = NULL;
/* we don't actually delete the node, garbage collection must get it */
return NULL;
}
/*======================================
* llrpt_writeindi -- Write person to database
* usage: writeindi(INDI) -> BOOLEAN
*====================================*/
PVALUE
llrpt_writeindi (PNODE node, SYMTAB stab, BOOLEAN *eflg)
{
NODE indi1;
PNODE arg = iargs(node);
NODE indi2 = eval_indi(arg, stab, eflg, NULL);
STRING rawrec=0, msg;
INT len, cnt;
BOOLEAN rtn=FALSE;
if (*eflg || !indi2) {
prog_var_error(node, stab, arg, 0, nonind1, "writeindi");
return NULL;
}
/* make a copy, so we can delete it */
indi2 = copy_node_subtree(indi2);
/* get existing record */
rawrec = retrieve_raw_record(rmvat(nxref(indi2)), &len);
if (!rawrec) {
/*
TODO: What do we do here ? Are they adding a new indi ?
or did they get the xref wrong ?
*/
goto end_writeindi;
}
ASSERT(indi1 = string_to_node(rawrec));
cnt = resolve_refn_links(indi2);
/* validate for showstopper errors */
if (!valid_indi_tree(indi2, &msg, indi1)) {
/* TODO: What to do with msg ? */
goto end_writeindi;
}
if (cnt > 0) {
/* unresolvable refn links */
/* TODO: optional argument to make this fatal ? */
}
if (equal_tree(indi1, indi2)) {
/* optimization :) */
rtn = TRUE;
goto end_writeindi;
}
if (readonly) {
/* TODO: database is read only error message */
goto end_writeindi;
}
replace_indi(indi1, indi2);
strfree(&rawrec);
rtn = TRUE;
end_writeindi:
return create_pvalue_from_bool(rtn);
}
/*=====================================
* llrpt_writefam -- Write family to database
* usage: writefam(FAM) -> BOOLEAN
*===================================*/
PVALUE
llrpt_writefam (PNODE node, SYMTAB stab, BOOLEAN *eflg)
{
NODE fam1;
NODE fam2 = eval_fam(iargs(node), stab, eflg, NULL);
STRING rawrec=0, msg;
INT len, cnt;
BOOLEAN rtn=FALSE;
if (*eflg) return NULL;
/* make a copy, so we can delete it */
fam2 = copy_node_subtree(fam2);
/* get existing record */
rawrec = retrieve_raw_record(rmvat(nxref(fam2)), &len);
if (!rawrec) {
/*
TODO: What do we do here ? Are they adding a new fam ?
or did they get the xref wrong ?
*/
goto end_writefam;
}
ASSERT(fam1 = string_to_node(rawrec));
cnt = resolve_refn_links(fam2);
/* validate for showstopper errors */
if (!valid_fam_tree(fam2, &msg, fam1)) {
/* TODO: What to do with msg ? */
goto end_writefam;
}
if (cnt > 0) {
/* unresolvable refn links */
/* TODO: optional argument to make this fatal ? */
}
if (equal_tree(fam1, fam2)) {
/* optimization :) */
rtn = TRUE;
goto end_writefam;
}
if (readonly) {
/* TODO: database is read only error message */
goto end_writefam;
}
replace_fam(fam1, fam2);
strfree(&rawrec);
rtn = TRUE;
end_writefam:
return create_pvalue_from_bool(rtn);
}
/*================================================+
* evaluate_ufunc -- Evaluate user defined function
* node: [in] parsed node of function definition
* stab: [in] function's symbol table
* eflg: [out] error flag
*===============================================*/
PVALUE
evaluate_ufunc (PNODE node, SYMTAB stab, BOOLEAN *eflg)
{
STRING procname = (STRING) iname(node);
PNODE func, arg, parm;
SYMTAB newstab = NULL;
PVALUE val=NULL;
INTERPTYPE irc;
INT count=0;
*eflg = TRUE;
/* find func in local or global table */
func = get_proc_node(procname, irptinfo(node)->functab, gfunctab, &count);
if (!func) {
if (!count)
prog_error(node, _("Undefined func: %s"), procname);
else
prog_error(node, _("Ambiguous call to func: %s"), procname);
goto ufunc_leave;
}
newstab = create_symtab_proc(procname, stab);
arg = (PNODE) iargs(node);
parm = (PNODE) iargs(func);
while (arg && parm) {
BOOLEAN eflg=TRUE;
PVALUE value = evaluate(arg, stab, &eflg);
if (eflg) {
if (getlloptint("FullReportCallStack", 0) > 0)
prog_error(node, "In user function %s()", procname);
return INTERROR;
}
insert_symtab(newstab, iident(parm), value);
arg = inext(arg);
parm = inext(parm);
}
if (arg || parm) {
prog_error(node, "``%s'': mismatched args and params\n", procname);
goto ufunc_leave;
}
irc = interpret((PNODE) ibody(func), newstab, &val);
switch (irc) {
case INTRETURN:
case INTOKAY:
#ifdef DEBUG
llwprintf("Successful ufunc call -- val returned was ");
show_pvalue(val);
llwprintf("\n");
#endif
*eflg = FALSE;
goto ufunc_leave;
case INTBREAK:
case INTCONTINUE:
case INTERROR:
break;
}
if (getlloptint("FullReportCallStack", 0) > 0)
prog_error(node, "In user function %s()", procname);
*eflg = TRUE;
delete_pvalue(val);
val=NULL;
ufunc_leave:
if (newstab) {
remove_symtab(newstab);
newstab = NULL;
}
return val;
}
/*=======================================
* llrpt_addnode -- Add a node to a GEDCOM tree
* usage: addnode(NODE, NODE, NODE) -> VOID
* args: (node being added, parent, previous child)
*=====================================*/
PVALUE
llrpt_addnode (PNODE node, SYMTAB stab, BOOLEAN *eflg)
{
PNODE arg = iargs(node);
NODE newchild, next, prnt, prev;
/* first argument, node (must be nonnull) */
PVALUE val = eval_and_coerce(PGNODE, arg, stab, eflg);
if (*eflg) {
prog_var_error(node, stab, arg, val, nonnodx, "addnode", "1");
delete_pvalue(val);
return NULL;
}
newchild = remove_node_and_delete_pvalue(&val);
if (!newchild) {
prog_var_error(node, stab, arg, val, nonnodx, "addnode", "1");
return NULL;
}
/* second argument, parent (must be nonnull) */
val = eval_and_coerce(PGNODE, arg=inext(arg), stab, eflg);
if (*eflg) {
prog_var_error(node, stab, arg, val, nonnodx, "addnode", "2");
return NULL;
}
prnt = remove_node_and_delete_pvalue(&val);
if (!prnt) {
prog_var_error(node, stab, arg, val, nonnodx, "addnode", "2");
return NULL;
}
/* third argument, prior sibling (may be null) */
val = eval_and_coerce(PGNODE, arg=inext(arg), stab, eflg);
if (*eflg) {
prog_var_error(node, stab, arg, val, nonnodx, "addnode", "3");
delete_pvalue(val);
return NULL;
}
prev = remove_node_and_delete_pvalue(&val);
if (prev) {
/* Check that previous sibling actually is child of new parent */
if (prnt != nparent(prev)) {
prog_error(node, "2nd arg to addnode must be parent of 3rd arg");
*eflg = 1;
return NULL;
}
}
/* reparent node, but ensure its locking is only relative to new parent */
dolock_node_in_cache(newchild, FALSE);
nparent(newchild) = prnt;
newchild->n_cel = prnt->n_cel;
set_temp_node(newchild, is_temp_node(prnt));
dolock_node_in_cache(newchild, TRUE);
if (prev == NULL) {
next = nchild(prnt);
nchild(prnt) = newchild;
} else {
next = nsibling(prev);
nsibling(prev) = newchild;
}
nsibling(newchild) = next;
return NULL;
}
