+SV *explain_ref = NULL;
+PerlInterpreter *root_perl_context;
+
+#define GRS_BUF_SIZE 8192
+
+
+/*
+ * Inspects the SV indicated by svp, and returns a null pointer if
+ * it's an undefined value, or a string allocation from `stream'
+ * otherwise. Using this when filling in addinfo avoids those
+ * irritating "Use of uninitialized value in subroutine entry"
+ * warnings from Perl.
+ */
+char *string_or_undef(SV **svp, ODR stream) {
+ STRLEN len;
+ char *ptr, *buf;
+
+ if (!SvOK(*svp))
+ return 0;
+
+ ptr = SvPV(*svp, len);
+ buf = (char*) odr_malloc(stream, len+1);
+ strcpy(buf, ptr);
+ return buf;
+}
+
+
+CV * simpleserver_sv2cv(SV *handler) {
+ STRLEN len;
+ char *buf;
+
+ if (SvPOK(handler)) {
+ CV *ret;
+ buf = SvPV( handler, len);
+ if ( !( ret = perl_get_cv(buf, FALSE ) ) ) {
+ fprintf( stderr, "simpleserver_sv2cv: No such handler '%s'\n\n", buf );
+ exit(1);
+ }
+
+ return ret;
+ } else {
+ return (CV *) handler;
+ }
+}
+
+/* debugging routine to check for destruction of Perl interpreters */
+#ifdef USE_ITHREADS
+void tst_clones(void)
+{
+ int i;
+ PerlInterpreter *parent = PERL_GET_CONTEXT;
+ for (i = 0; i<5000; i++)
+ {
+ PerlInterpreter *perl_interp;
+
+ PERL_SET_CONTEXT(parent);
+ PL_perl_destruct_level = 2;
+ perl_interp = perl_clone(parent, CLONEf_CLONE_HOST);
+ PL_perl_destruct_level = 2;
+ PERL_SET_CONTEXT(perl_interp);
+ perl_destruct(perl_interp);
+ perl_free(perl_interp);
+ }
+ exit (0);
+}
+#endif
+
+int simpleserver_clone(void) {
+#ifdef USE_ITHREADS
+ yaz_mutex_enter(simpleserver_mutex);
+ if (1)
+ {
+ PerlInterpreter *current = PERL_GET_CONTEXT;
+
+ /* if current is unset, then we're in a new thread with
+ * no Perl interpreter for it. So we must create one .
+ * This will only happen when threaded is used..
+ */
+ if (!current) {
+ PerlInterpreter *perl_interp;
+ PERL_SET_CONTEXT( root_perl_context );
+ perl_interp = perl_clone(root_perl_context, CLONEf_CLONE_HOST);
+ PERL_SET_CONTEXT( perl_interp );
+ }
+ }
+ yaz_mutex_leave(simpleserver_mutex);
+#endif
+ return 0;
+}
+
+
+void simpleserver_free(void) {
+ yaz_mutex_enter(simpleserver_mutex);
+ if (1)
+ {
+ PerlInterpreter *current_interp = PERL_GET_CONTEXT;
+
+ /* If current Perl Interp is different from root interp, then
+ * we're in threaded mode and we must destroy..
+ */
+ if (current_interp != root_perl_context) {
+ PL_perl_destruct_level = 2;
+ PERL_SET_CONTEXT(current_interp);
+ perl_destruct(current_interp);
+ perl_free(current_interp);
+ }
+ }
+ yaz_mutex_leave(simpleserver_mutex);
+}
+
+
+Z_GenericRecord *read_grs1(char *str, ODR o)
+{
+ int type, ivalue;
+ char line[GRS_BUF_SIZE+1], *buf, *ptr, *original;
+ char value[GRS_BUF_SIZE+1];
+ Z_GenericRecord *r = 0;
+
+ original = str;
+ r = (Z_GenericRecord *)odr_malloc(o, sizeof(*r));
+ r->elements = (Z_TaggedElement **) odr_malloc(o, sizeof(Z_TaggedElement*) * GRS_MAX_FIELDS);
+ r->num_elements = 0;
+
+ for (;;)
+ {
+ Z_TaggedElement *t;
+ Z_ElementData *c;
+ int len;
+
+ ptr = strchr(str, '\n');
+ if (!ptr) {
+ return r;
+ }
+ len = ptr - str;
+ if (len > GRS_BUF_SIZE) {
+ yaz_log(YLOG_WARN, "GRS string too long - truncating (%d > %d)", len, GRS_BUF_SIZE);
+ len = GRS_BUF_SIZE;
+ }
+ strncpy(line, str, len);
+ line[len] = 0;
+ buf = line;
+ str = ptr + 1;
+ while (*buf && isspace(*buf))
+ buf++;
+ if (*buf == '}') {
+ memmove(original, str, strlen(str));
+ return r;
+ }
+ if (sscanf(buf, "(%d,%[^)])", &type, value) != 2)
+ {
+ yaz_log(YLOG_WARN, "Bad data in '%s'", buf);
+ return r;
+ }
+ if (!type && *value == '0')
+ return r;
+ if (!(buf = strchr(buf, ')')))
+ return r;
+ buf++;
+ while (*buf && isspace(*buf))
+ buf++;
+ if (r->num_elements >= GRS_MAX_FIELDS)
+ {
+ yaz_log(YLOG_WARN, "Max number of GRS-1 elements exceeded [GRS_MAX_FIELDS=%d]", GRS_MAX_FIELDS);
+ exit(0);
+ }
+ r->elements[r->num_elements] = t = (Z_TaggedElement *) odr_malloc(o, sizeof(Z_TaggedElement));
+ t->tagType = odr_intdup(o, type);
+ t->tagValue = (Z_StringOrNumeric *)
+ odr_malloc(o, sizeof(Z_StringOrNumeric));
+ if ((ivalue = atoi(value)))
+ {
+ t->tagValue->which = Z_StringOrNumeric_numeric;
+ t->tagValue->u.numeric = odr_intdup(o, ivalue);
+ }
+ else
+ {
+ t->tagValue->which = Z_StringOrNumeric_string;
+ t->tagValue->u.string = odr_strdup(o, value);
+ }
+ t->tagOccurrence = 0;
+ t->metaData = 0;
+ t->appliedVariant = 0;
+ t->content = c = (Z_ElementData *)odr_malloc(o, sizeof(Z_ElementData));
+ if (*buf == '{')
+ {
+ c->which = Z_ElementData_subtree;
+ c->u.subtree = read_grs1(str, o);
+ }
+ else
+ {
+ c->which = Z_ElementData_string;
+ c->u.string = odr_strdup(o, buf);
+ }
+ r->num_elements++;
+ }
+}
+
+