/*
- * $Id: SimpleServer.xs,v 1.30 2004-06-05 23:09:04 adam Exp $
+ * $Id: SimpleServer.xs,v 1.41 2006-04-19 12:37:32 mike Exp $
* ----------------------------------------------------------------------
*
* Copyright (c) 2000-2004, Index Data.
}
/* debugging routine to check for destruction of Perl interpreters */
-#if 1
-int tst_clones(void)
+#ifdef USE_ITHREADS
+void tst_clones(void)
{
int i;
PerlInterpreter *parent = PERL_GET_CONTEXT;
- for (i = 0; i<500; i++)
+ for (i = 0; i<5000; i++)
{
PerlInterpreter *perl_interp;
+ PERL_SET_CONTEXT(parent);
PL_perl_destruct_level = 2;
- perl_interp = perl_clone(parent, 0);
+ 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);
}
if (!current) {
PerlInterpreter *perl_interp;
PERL_SET_CONTEXT( root_perl_context );
- perl_interp = perl_clone(root_perl_context, 0);
+ perl_interp = perl_clone(root_perl_context, CLONEf_CLONE_HOST);
PERL_SET_CONTEXT( perl_interp );
}
}
}
-static int rpn2pquery(Z_RPNStructure *s, WRBUF buf)
-{
- switch (s->which) {
- case Z_RPNStructure_simple: {
- Z_Operand *o = s->u.simple;
-
- switch (o->which) {
- case Z_Operand_APT: {
- Z_AttributesPlusTerm *at = o->u.attributesPlusTerm;
-
- if (at->attributes) {
- int i;
- char ibuf[16];
-
- for (i = 0; i < at->attributes->num_attributes; i++) {
- wrbuf_puts(buf, "@attr ");
- if (at->attributes->attributes[i]->attributeSet) {
- oid2str(at->attributes->attributes[i]->attributeSet, buf);
- wrbuf_putc(buf, ' ');
- }
- sprintf(ibuf, "%d=", *at->attributes->attributes[i]->attributeType);
- assert(at->attributes->attributes[i]->which == Z_AttributeValue_numeric);
- wrbuf_puts(buf, ibuf);
- sprintf(ibuf, "%d ", *at->attributes->attributes[i]->value.numeric);
- wrbuf_puts(buf, ibuf);
- }
- }
- switch (at->term->which) {
- case Z_Term_general: {
- wrbuf_putc(buf, '"');
- wrbuf_write(buf, (char*) at->term->u.general->buf, at->term->u.general->len);
- wrbuf_puts(buf, "\" ");
- break;
- }
- default: abort();
- }
- break;
- }
- default: abort();
- }
- break;
- }
- case Z_RPNStructure_complex: {
- Z_Complex *c = s->u.complex;
-
- switch (c->roperator->which) {
- case Z_Operator_and: wrbuf_puts(buf, "@and "); break;
- case Z_Operator_or: wrbuf_puts(buf, "@or "); break;
- case Z_Operator_and_not: wrbuf_puts(buf, "@not "); break;
- case Z_Operator_prox: abort();
- default: abort();
- }
- if (!rpn2pquery(c->s1, buf))
- return 0;
- if (!rpn2pquery(c->s2, buf))
- return 0;
- break;
- }
- default: abort();
- }
- return 1;
-}
-
-
WRBUF zquery2pquery(Z_Query *q)
{
WRBUF buf = wrbuf_alloc();
if (q->which != Z_Query_type_1 && q->which != Z_Query_type_101)
return 0;
- if (q->u.type_1->attributeSetId) {
- /* Output attribute set ID */
- wrbuf_puts(buf, "@attrset ");
- oid2str(q->u.type_1->attributeSetId, buf);
- wrbuf_putc(buf, ' ');
- }
- return rpn2pquery(q->u.type_1->RPNStructure, buf) ? buf : 0;
+ yaz_rpnquery_to_wrbuf(buf, q->u.type_1);
+ return buf;
}
{
va_list ap;
- fprintf(stderr, "FATAL (yazwrap): ");
+ fprintf(stderr, "FATAL (SimpleServer): ");
va_start(ap, fmt);
vfprintf(stderr, fmt, ap);
va_end(ap);
case Z_RPNStructure_simple: {
Z_Operand *o = s->u.simple;
Z_AttributesPlusTerm *at;
+ if (o->which == Z_Operand_resultSetId) {
+ SV *sv2;
+ /* This code causes a SIGBUS on my machine, and I have no
+ idea why. It seems as clear as day to me */
+ char *rsid = (char*) o->u.resultSetId;
+ printf("Encoding resultSetId '%s'\n", rsid);
+ sv = newObject("Net::Z3950::RPN::RSID", (SV*) (hv = newHV()));
+ printf("Made sv=0x%lx, hv=0x%lx\n",
+ (unsigned long) sv ,(unsigned long) hv);
+ sv2 = newSVpv(rsid, strlen(rsid));
+ setMember(hv, "id", sv2);
+ printf("Set hv{id} to 0x%lx\n", (unsigned long) sv2);
+ return sv;
+ }
if (o->which != Z_Operand_APT)
- fatal("can't handle RPN simples other than APT");
+ fatal("can't handle RPN simples other than APT and RSID");
at = o->u.attributesPlusTerm;
if (at->term->which != Z_Term_general)
fatal("can't handle RPN terms other than general");
SV *point;
Zfront_handle *zhandle = (Zfront_handle *)handle;
CV* handler_cv = 0;
+ SV *rpnSV;
dSP;
ENTER;
hv_store(href, "DATABASES", 9, newRV( (SV*) aref), 0);
hv_store(href, "HANDLE", 6, zhandle->handle, 0);
hv_store(href, "PID", 3, newSViv(getpid()), 0);
- hv_store(href, "RPN", 3, zquery2perl(rr->query), 0);
+ if ((rpnSV = zquery2perl(rr->query)) != 0) {
+ hv_store(href, "RPN", 3, rpnSV, 0);
+ }
query = zquery2pquery(rr->query);
if (query)
{
hv_store(href, "QUERY", 5, newSVpv((char *)query->buf, query->pos), 0);
}
+ else if (rr->query->which == Z_Query_type_104 &&
+ rr->query->u.type_104->which == Z_External_CQL) {
+ hv_store(href, "CQL", 3,
+ newSVpv(rr->query->u.type_104->u.cql, 0), 0);
+ }
else
{
rr->errcode = 108;
+ return 0;
}
PUSHMARK(sp);
zhandle->handle = point;
sv_free( (SV*) aref);
sv_free( (SV*) href);
- wrbuf_free(query, 1);
+ if (query)
+ wrbuf_free(query, 1);
PUTBACK;
FREETMPS;
LEAVE;
href = newHV();
hv_store(href, "SETNAME", 7, newSVpv(rr->setname, 0), 0);
temp = hv_store(href, "OFFSET", 6, newSViv(rr->number), 0);
- oid_dotted = oid2dotted(rr->request_format_raw);
+ if (rr->request_format_raw != 0) {
+ oid_dotted = oid2dotted(rr->request_format_raw);
+ } else {
+ /* Probably an SRU request: assume XML is required */
+ oid_dotted = wrbuf_alloc();
+ wrbuf_puts(oid_dotted, "1.2.840.10003.5.109.10");
+ }
hv_store(href, "REQ_FORM", 8, newSVpv((char *)oid_dotted->buf, oid_dotted->pos), 0);
hv_store(href, "REP_FORM", 8, newSVpv((char *)oid_dotted->buf, oid_dotted->pos), 0);
hv_store(href, "BASENAME", 8, newSVpv("", 0), 0);
}
else
{
- rr->errcode = 26;
+ /* This is where we end up in the case of
+ * SRU. Since record composition ("element
+ * sets") are meaningless in SRU anyway, we
+ * just skip this.
+ */
}
}
bend_initresult *r = (bend_initresult *)
odr_malloc (q->stream, sizeof(*r));
char *ptr;
- char *user = NULL;
- char *passwd = NULL;
CV* handler_cv = 0;
dSP;
STRLEN len;
hv_store(href, "HANDLE", 6, newSVsv(&sv_undef), 0);
hv_store(href, "PID", 3, newSViv(getpid()), 0);
if (q->auth) {
+ char *user = NULL;
+ char *passwd = NULL;
if (q->auth->which == Z_IdAuthentication_open) {
- char *openpass = xstrdup (q->auth->u.open);
- char *cp = strchr (openpass, '/');
+ char *cp;
+ user = nmem_strdup (odr_getmem (q->stream), q->auth->u.open);
+ cp = strchr (user, '/');
if (cp) {
+ /* password after / given */
*cp = '\0';
- user = nmem_strdup (odr_getmem (q->stream), openpass);
- passwd = nmem_strdup (odr_getmem (q->stream), cp + 1);
+ passwd = cp+1;
}
- xfree(openpass);
} else if (q->auth->which == Z_IdAuthentication_idPass) {
user = q->auth->u.idPass->userId;
passwd = q->auth->u.idPass->password;
}
/* ### some code paths have user/password unassigned here */
- hv_store(href, "USER", 4, newSVpv(user, 0), 0);
- hv_store(href, "PASS", 4, newSVpv(passwd, 0), 0);
+ if (user)
+ hv_store(href, "USER", 4, newSVpv(user, 0), 0);
+ if (passwd)
+ hv_store(href, "PASS", 4, newSVpv(passwd, 0), 0);
}
PUSHMARK(sp);
sv_free((SV*) href);
}
- sv_free(zhandle->handle);
+ else
+ sv_free(zhandle->handle);
PUTBACK;
FREETMPS;
LEAVE;
MODULE = Net::Z3950::SimpleServer PACKAGE = Net::Z3950::SimpleServer
+PROTOTYPES: DISABLE
+
+
void
set_init_handler(arg)
SV *arg
RETVAL
+void
+yazlog(arg)
+ SV *arg
+ CODE:
+ STRLEN len;
+ char *ptr;
+ ptr = SvPV(arg, len);
+ yaz_log(YLOG_LOG, "%.*s", len, ptr);