Added a modified version of ztest.pl called grs_test.pl, which shows how to
[simpleserver-moved-to-github.git] / SimpleServer.xs
1 /*
2  * Copyright (c) 2000, Index Data.
3  *
4  * Permission to use, copy, modify, distribute, and sell this software and
5  * its documentation, in whole or in part, for any purpose, is hereby granted,
6  * provided that:
7  *
8  * 1. This copyright and permission notice appear in all copies of the
9  * software and its documentation. Notices of copyright or attribution
10  * which appear at the beginning of any file must remain unchanged.
11  *
12  * 2. The name of Index Data or the individual authors may not be used to
13  * endorse or promote products derived from this software without specific
14  * prior written permission.
15  *
16  * THIS SOFTWARE IS PROVIDED "AS IS" AND WITHOUT WARRANTY OF ANY KIND,
17  * EXPRESS, IMPLIED, OR OTHERWISE, INCLUDING WITHOUT LIMITATION, ANY
18  * WARRANTY OF MERCHANTABILITY OR FITNESS FOR A PARTICULAR PURPOSE.
19  * IN NO EVENT SHALL INDEX DATA BE LIABLE FOR ANY SPECIAL, INCIDENTAL,
20  * INDIRECT OR CONSEQUENTIAL DAMAGES OF ANY KIND, OR ANY DAMAGES
21  * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER OR
22  * NOT ADVISED OF THE POSSIBILITY OF DAMAGE, AND ON ANY THEORY OF
23  * LIABILITY, ARISING OUT OF OR IN CONNECTION WITH THE USE OR PERFORMANCE
24  * OF THIS SOFTWARE.
25  */
26
27 /*$Log: SimpleServer.xs,v $
28 /*Revision 1.7  2001-03-13 14:17:15  sondberg
29 /*Added support for GRS-1.
30 /**/
31
32
33 #include "EXTERN.h"
34 #include "perl.h"
35 #include "XSUB.h"
36 #include <yaz/backend.h>
37 #include <yaz/log.h>
38 #include <yaz/wrbuf.h>
39 #include <stdio.h>
40 #include <unistd.h>
41 #include <stdlib.h>
42 #include <ctype.h>
43 #define GRS_MAX_FIELDS 50
44 #ifdef ASN_COMPILED
45 #include <yaz/ill.h>
46 #endif
47 #ifndef sv_undef                /* To fix the problem with Perl 5.6.0 */
48 #define sv_undef PL_sv_undef
49 #endif
50
51 typedef struct {
52         SV *handle;
53
54         SV *init_ref;
55         SV *close_ref;
56         SV *sort_ref;
57         SV *search_ref;
58         SV *fetch_ref;
59         SV *present_ref;
60         SV *esrequest_ref;
61         SV *delete_ref;
62         SV *scan_ref;
63 } Zfront_handle;
64
65 SV *init_ref = NULL;
66 SV *close_ref = NULL;
67 SV *sort_ref = NULL;
68 SV *search_ref = NULL;
69 SV *fetch_ref = NULL;
70 SV *present_ref = NULL;
71 SV *esrequest_ref = NULL;
72 SV *delete_ref = NULL;
73 SV *scan_ref = NULL;
74 int MAX_OID = 15;
75
76
77 Z_GenericRecord *read_grs1(char *str, ODR o)
78 {
79         int type, ivalue;
80         char line[512], *buf, *ptr, *original;
81         char value[512];
82         Z_GenericRecord *r = 0;
83
84         original = str;
85         for (;;)
86         {
87                 Z_TaggedElement *t;
88                 Z_ElementData *c;
89         
90                 ptr = strchr(str, '\n');
91                 if (!ptr) {
92                         return r;
93                 }
94                 strncpy(line, str, ptr - str);
95                 line[ptr - str] = 0;
96                 buf = line;
97                 str = ptr + 1;
98                 while (*buf && isspace(*buf))
99                         buf++;
100                 if (*buf == '}') {
101                         memmove(original, str, strlen(str));
102                         return r;
103                 }
104                 if (sscanf(buf, "(%d,%[^)])", &type, value) != 2)
105                 {
106                         yaz_log(LOG_WARN, "Bad data in '%s'", buf);
107                         return 0;
108                 }
109                 if (!type && *value == '0')
110                         return r;
111                 if (!(buf = strchr(buf, ')')))
112                         return 0;
113                 buf++;
114                 while (*buf && isspace(*buf))
115                         buf++;
116                 if (!*buf)
117                         return 0;
118                 if (!r)
119                 {
120                         r = (Z_GenericRecord *)odr_malloc(o, sizeof(*r));
121                         r->elements = (Z_TaggedElement **)
122                         odr_malloc(o, sizeof(Z_TaggedElement*) * GRS_MAX_FIELDS);
123                         r->num_elements = 0;
124                 }
125                 r->elements[r->num_elements] = t = (Z_TaggedElement *) odr_malloc(o, sizeof(Z_TaggedElement));
126                 t->tagType = (int *)odr_malloc(o, sizeof(int));
127                 *t->tagType = type;
128                 t->tagValue = (Z_StringOrNumeric *)
129                         odr_malloc(o, sizeof(Z_StringOrNumeric));
130                 if ((ivalue = atoi(value)))
131                 {
132                         t->tagValue->which = Z_StringOrNumeric_numeric;
133                         t->tagValue->u.numeric = (int *)odr_malloc(o, sizeof(int));
134                         *t->tagValue->u.numeric = ivalue;
135                 }
136                 else
137                 {
138                         t->tagValue->which = Z_StringOrNumeric_string;
139                         t->tagValue->u.string = (char *)odr_malloc(o, strlen(value)+1);
140                         strcpy(t->tagValue->u.string, value);
141                 }
142                 t->tagOccurrence = 0;
143                 t->metaData = 0;
144                 t->appliedVariant = 0;
145                 t->content = c = (Z_ElementData *)odr_malloc(o, sizeof(Z_ElementData));
146                 if (*buf == '{')
147                 {
148                         c->which = Z_ElementData_subtree;
149                         c->u.subtree = read_grs1(str, o);
150                 }
151                 else
152                 {
153                         c->which = Z_ElementData_string;
154 /*                      buf[strlen(buf)-1] = '\0';*/
155                         buf[strlen(buf)] = '\0';
156                         c->u.string = odr_strdup(o, buf);
157                 }
158                 r->num_elements++;
159         }
160 }
161
162
163
164
165 static void oid2str(Odr_oid *o, WRBUF buf)
166 {
167     for (; *o >= 0; o++) {
168         char ibuf[16];
169         sprintf(ibuf, "%d", *o);
170         wrbuf_puts(buf, ibuf);
171         if (o[1] > 0)
172             wrbuf_putc(buf, '.');
173     }
174 }
175
176
177 static int rpn2pquery(Z_RPNStructure *s, WRBUF buf)
178 {
179     switch (s->which) {
180         case Z_RPNStructure_simple: {
181             Z_Operand *o = s->u.simple;
182
183             switch (o->which) {
184                 case Z_Operand_APT: {
185                     Z_AttributesPlusTerm *at = o->u.attributesPlusTerm;
186
187                     if (at->attributes) {
188                         int i;
189                         char ibuf[16];
190
191                         for (i = 0; i < at->attributes->num_attributes; i++) {
192                             wrbuf_puts(buf, "@attr ");
193                             if (at->attributes->attributes[i]->attributeSet) {
194                                 oid2str(at->attributes->attributes[i]->attributeSet, buf);
195                                 wrbuf_putc(buf, ' ');
196                             }
197                             sprintf(ibuf, "%d=", *at->attributes->attributes[i]->attributeType);
198                             assert(at->attributes->attributes[i]->which == Z_AttributeValue_numeric);
199                             wrbuf_puts(buf, ibuf);
200                             sprintf(ibuf, "%d ", *at->attributes->attributes[i]->value.numeric);
201                             wrbuf_puts(buf, ibuf);
202                         }
203                     }
204                     switch (at->term->which) {
205                         case Z_Term_general: {
206                             wrbuf_putc(buf, '"');
207                             wrbuf_write(buf, (char*) at->term->u.general->buf, at->term->u.general->len);
208                             wrbuf_puts(buf, "\" ");
209                             break;
210                         }
211                         default: abort();
212                     }
213                     break;
214                 }
215                 default: abort();
216             }
217             break;
218         }
219         case Z_RPNStructure_complex: {
220             Z_Complex *c = s->u.complex;
221
222             switch (c->roperator->which) {
223                 case Z_Operator_and: wrbuf_puts(buf, "@and "); break;
224                 case Z_Operator_or: wrbuf_puts(buf, "@or "); break;
225                 case Z_Operator_and_not: wrbuf_puts(buf, "@not "); break;
226                 case Z_Operator_prox: abort();
227                 default: abort();
228             }
229             if (!rpn2pquery(c->s1, buf))
230                 return 0;
231             if (!rpn2pquery(c->s2, buf))
232                 return 0;
233             break;
234         }
235         default: abort();
236     }
237     return 1;
238 }
239
240
241 WRBUF zquery2pquery(Z_Query *q)
242 {
243     WRBUF buf = wrbuf_alloc();
244
245     if (q->which != Z_Query_type_1 && q->which != Z_Query_type_101) 
246         return 0;
247     if (q->u.type_1->attributeSetId) {
248         /* Output attribute set ID */
249         wrbuf_puts(buf, "@attrset ");
250         oid2str(q->u.type_1->attributeSetId, buf);
251         wrbuf_putc(buf, ' ');
252     }
253     return rpn2pquery(q->u.type_1->RPNStructure, buf) ? buf : 0;
254 }
255
256
257 int bend_sort(void *handle, bend_sort_rr *rr)
258 {
259         HV *href;
260         AV *aref;
261         SV **temp;
262         SV *err_code;
263         SV *err_str;
264         SV *status;
265         STRLEN len;
266         char *ptr;
267         char *ODR_err_str;
268         char **input_setnames;
269         Zfront_handle *zhandle = (Zfront_handle *)handle;
270         int i;
271         
272         dSP;
273         ENTER;
274         SAVETMPS;
275         
276         aref = newAV();
277         input_setnames = rr->input_setnames;
278         for (i = 0; i < rr->num_input_setnames; i++)
279         {
280                 av_push(aref, newSVpv(*input_setnames++, 0));
281         }
282         href = newHV();
283         hv_store(href, "INPUT", 5, newRV( (SV*) aref), 0);
284         hv_store(href, "OUTPUT", 6, newSVpv(rr->output_setname, 0), 0);
285         hv_store(href, "HANDLE", 6, zhandle->handle, 0);
286         hv_store(href, "STATUS", 6, newSViv(0), 0);
287
288         PUSHMARK(sp);
289
290         XPUSHs(sv_2mortal(newRV( (SV*) href)));
291
292         PUTBACK;
293
294         perl_call_sv(sort_ref, G_SCALAR | G_DISCARD);
295
296         SPAGAIN;
297
298         temp = hv_fetch(href, "ERR_CODE", 8, 1);
299         err_code = newSVsv(*temp);
300
301         temp = hv_fetch(href, "ERR_STR", 7, 1);
302         err_str = newSVsv(*temp);
303
304         temp = hv_fetch(href, "STATUS", 6, 1);
305         status = newSVsv(*temp);
306
307
308         
309
310         PUTBACK;
311         FREETMPS;
312         LEAVE;
313
314         hv_undef(href),
315         av_undef(aref);
316         rr->errcode = SvIV(err_code);
317         rr->sort_status = SvIV(status);
318         ptr = SvPV(err_str, len);
319         ODR_err_str = (char *)odr_malloc(rr->stream, len + 1);
320         strcpy(ODR_err_str, ptr);
321         rr->errstring = ODR_err_str;
322
323         sv_free(err_code);
324         sv_free(err_str);
325         sv_free(status);
326         
327         return 0;
328 }
329
330
331 int bend_search(void *handle, bend_search_rr *rr)
332 {
333         HV *href;
334         AV *aref;
335         SV **temp;
336         SV *hits;
337         SV *err_code;
338         SV *err_str;
339         char *ODR_errstr;
340         STRLEN len;
341         int i;
342         char **basenames;
343         int n;
344         WRBUF query;
345         char *ptr;
346         SV *point;
347         SV *ODR_point;
348         Zfront_handle *zhandle = (Zfront_handle *)handle;
349
350         dSP;
351         ENTER;
352         SAVETMPS;
353
354         aref = newAV();
355         basenames = rr->basenames;
356         for (i = 0; i < rr->num_bases; i++)
357         {
358                 av_push(aref, newSVpv(*basenames++, 0));
359         }
360         href = newHV();         
361         hv_store(href, "SETNAME", 7, newSVpv(rr->setname, 0), 0);
362         hv_store(href, "REPL_SET", 8, newSViv(rr->replace_set), 0);
363         hv_store(href, "ERR_CODE", 8, newSViv(0), 0);
364         hv_store(href, "ERR_STR", 7, newSVpv("", 0), 0);
365         hv_store(href, "HITS", 4, newSViv(0), 0);
366         hv_store(href, "DATABASES", 9, newRV( (SV*) aref), 0);
367         hv_store(href, "HANDLE", 6, zhandle->handle, 0);
368         hv_store(href, "PID", 3, newSViv(getpid()), 0);
369         query = zquery2pquery(rr->query);
370         if (query)
371         {
372                 hv_store(href, "QUERY", 5, newSVpv((char *)query->buf, query->pos), 0);
373         }
374         else
375         {       
376                 rr->errcode = 108;
377         }
378         PUSHMARK(sp);
379         
380         XPUSHs(sv_2mortal(newRV( (SV*) href)));
381         
382         PUTBACK;
383
384         n = perl_call_sv(search_ref, G_SCALAR | G_DISCARD);
385
386         SPAGAIN;
387
388         temp = hv_fetch(href, "HITS", 4, 1);
389         hits = newSVsv(*temp);
390
391         temp = hv_fetch(href, "ERR_CODE", 8, 1);
392         err_code = newSVsv(*temp);
393
394         temp = hv_fetch(href, "ERR_STR", 7, 1);
395         err_str = newSVsv(*temp);
396
397         temp = hv_fetch(href, "HANDLE", 6, 1);
398         point = newSVsv(*temp);
399
400         PUTBACK;
401         FREETMPS;
402         LEAVE;
403         
404         hv_undef(href);
405         av_undef(aref);
406         rr->hits = SvIV(hits);
407         rr->errcode = SvIV(err_code);
408         ptr = SvPV(err_str, len);
409         ODR_errstr = (char *)odr_malloc(rr->stream, len + 1);
410         strcpy(ODR_errstr, ptr);
411         rr->errstring = ODR_errstr;
412 /*      ODR_point = (SV *)odr_malloc(rr->stream, sizeof(*point));
413         memcpy(ODR_point, point, sizeof(*point));
414         zhandle->handle = ODR_point;*/
415         zhandle->handle = point;
416         handle = zhandle;
417         sv_free(hits);
418         sv_free(err_code);
419         sv_free(err_str);
420         sv_free( (SV*) aref);
421         sv_free( (SV*) href);
422         /*sv_free(point);*/
423         wrbuf_free(query, 1);
424         return 0;
425 }
426
427
428 WRBUF oid2dotted(int *oid)
429 {
430
431         WRBUF buf = wrbuf_alloc();
432         int dot = 0;
433
434         for (; *oid != -1 ; oid++)
435         {
436                 char ibuf[16];
437                 if (dot)
438                 {
439                         wrbuf_putc(buf, '.');
440                 }
441                 else
442                 {
443                         dot = 1;
444                 }
445                 sprintf(ibuf, "%d", *oid);
446                 wrbuf_puts(buf, ibuf);
447         }
448         return buf;
449 }
450                 
451
452 int dotted2oid(char *dotted, int *buffer)
453 {
454         int *oid;
455         char ibuf[16];
456         char *ptr;
457         int n = 0;
458
459         ptr = ibuf;
460         oid = buffer;
461         while (*dotted)
462         {
463                 if (*dotted == '.')
464                 {
465                         n++;
466                         if (n == MAX_OID)  /* Terminate if more than MAX_OID entries */
467                         {
468                                 *oid = -1;
469                                 return -1;
470                         }
471                         *ptr = 0;
472                         sscanf(ibuf, "%d", oid++);
473                         ptr = ibuf;
474                         dotted++;
475
476                 }
477                 else
478                 {
479                         *ptr++ = *dotted++;
480                 }
481         }
482         if (n < MAX_OID)
483         {
484                 *ptr = 0;
485                 sscanf(ibuf, "%d", oid++);
486         }
487         *oid = -1;
488         return 0;
489 }
490
491
492 int bend_fetch(void *handle, bend_fetch_rr *rr)
493 {
494         HV *href;
495         SV **temp;
496         SV *basename;
497         SV *record;
498         SV *last;
499         SV *err_code;
500         SV *err_string;
501         SV *sur_flag;
502         SV *point;
503         SV *rep_form;
504         char *ptr;
505         char *ODR_record;
506         char *ODR_basename;
507         char *ODR_errstr;
508         int *ODR_oid_buf;
509         oident *oid;
510         WRBUF oid_dotted;
511         Zfront_handle *zhandle = (Zfront_handle *)handle;
512
513         Z_RecordComposition *composition;
514         Z_ElementSetNames *simple;
515         STRLEN length;
516
517         dSP;
518         ENTER;
519         SAVETMPS;
520
521         rr->errcode = 0;
522         href = newHV();
523         hv_store(href, "SETNAME", 7, newSVpv(rr->setname, 0), 0);
524         temp = hv_store(href, "OFFSET", 6, newSViv(rr->number), 0);
525         oid_dotted = oid2dotted(rr->request_format_raw);
526         hv_store(href, "REQ_FORM", 8, newSVpv((char *)oid_dotted->buf, oid_dotted->pos), 0);
527         hv_store(href, "REP_FORM", 8, newSVpv((char *)oid_dotted->buf, oid_dotted->pos), 0);
528         hv_store(href, "BASENAME", 8, newSVpv("", 0), 0);
529         hv_store(href, "RECORD", 6, newSVpv("", 0), 0);
530         hv_store(href, "LAST", 4, newSViv(0), 0);
531         hv_store(href, "ERR_CODE", 8, newSViv(0), 0);
532         hv_store(href, "ERR_STR", 7, newSVpv("", 0), 0);
533         hv_store(href, "SUR_FLAG", 8, newSViv(0), 0);
534         hv_store(href, "HANDLE", 6, zhandle->handle, 0);
535         hv_store(href, "PID", 3, newSViv(getpid()), 0);
536         if (rr->comp)
537         {
538                 composition = rr->comp;
539                 if (composition->which == Z_RecordComp_simple)
540                 {
541                         simple = composition->u.simple;
542                         if (simple->which == Z_ElementSetNames_generic)
543                         {
544                                 hv_store(href, "COMP", 4, newSVpv(simple->u.generic, 0), 0);
545                         } 
546                         else
547                         {
548                                 rr->errcode = 26;
549                         }
550                 }
551                 else
552                 {
553                         rr->errcode = 26;
554                 }
555         }
556
557         PUSHMARK(sp);
558
559         XPUSHs(sv_2mortal(newRV( (SV*) href)));
560
561         PUTBACK;
562         
563         perl_call_sv(fetch_ref, G_SCALAR | G_DISCARD);
564
565         SPAGAIN;
566
567         temp = hv_fetch(href, "BASENAME", 8, 1);
568         basename = newSVsv(*temp);
569
570         temp = hv_fetch(href, "RECORD", 6, 1);
571         record = newSVsv(*temp);
572
573         temp = hv_fetch(href, "LAST", 4, 1);
574         last = newSVsv(*temp);
575
576         temp = hv_fetch(href, "ERR_CODE", 8, 1);
577         err_code = newSVsv(*temp);
578
579         temp = hv_fetch(href, "ERR_STR", 7, 1),
580         err_string = newSVsv(*temp);
581
582         temp = hv_fetch(href, "SUR_FLAG", 8, 1);
583         sur_flag = newSVsv(*temp);
584
585         temp = hv_fetch(href, "REP_FORM", 8, 1);
586         rep_form = newSVsv(*temp);
587
588         temp = hv_fetch(href, "HANDLE", 6, 1);
589         point = newSVsv(*temp);
590
591         PUTBACK;
592         FREETMPS;
593         LEAVE;
594
595         hv_undef(href);
596         
597         ptr = SvPV(basename, length);
598         ODR_basename = (char *)odr_malloc(rr->stream, length + 1);
599         strcpy(ODR_basename, ptr);
600         rr->basename = ODR_basename;
601
602         ptr = SvPV(rep_form, length);
603         ODR_oid_buf = (int *)odr_malloc(rr->stream, (MAX_OID + 1) * sizeof(int));
604         if (dotted2oid(ptr, ODR_oid_buf) == -1)         /* Maximum number of OID elements exceeded */
605         {
606                 printf("Net::Z3950::SimpleServer: WARNING: OID structure too long, max length is %d\n", MAX_OID);
607         }
608         rr->output_format_raw = ODR_oid_buf;    
609         
610         ptr = SvPV(record, length);
611         oid = oid_getentbyoid(ODR_oid_buf);
612         if (oid->value == VAL_GRS1)             /* Treat GRS-1 records separately */
613         {
614                 rr->record = (char *) read_grs1(ptr, rr->stream);
615                 rr->len = -1;
616         }
617         else
618         {
619                 ODR_record = (char *)odr_malloc(rr->stream, length + 1);
620                 strcpy(ODR_record, ptr);
621                 rr->record = ODR_record;
622                 rr->len = length;
623         }
624         zhandle->handle = point;
625         handle = zhandle;
626         rr->last_in_set = SvIV(last);
627         
628         if (!(rr->errcode))
629         {
630                 rr->errcode = SvIV(err_code);
631                 ptr = SvPV(err_string, length);
632                 ODR_errstr = (char *)odr_malloc(rr->stream, length + 1);
633                 strcpy(ODR_errstr, ptr);
634                 rr->errstring = ODR_errstr;
635         }
636         rr->surrogate_flag = SvIV(sur_flag);
637
638         wrbuf_free(oid_dotted, 1);
639         sv_free((SV*) href);
640         sv_free(basename);
641         sv_free(record);
642         sv_free(last);
643         sv_free(err_string);
644         sv_free(err_code),
645         sv_free(sur_flag);
646         sv_free(rep_form);
647         
648         return 0;
649 }
650
651
652 int bend_present(void *handle, bend_present_rr *rr)
653 {
654
655         HV *href;
656         SV **temp;
657         SV *err_code;
658         SV *err_string;
659         SV *hits;
660         SV *point;
661         STRLEN len;
662         Z_RecordComposition *composition;
663         Z_ElementSetNames *simple;
664         char *ODR_errstr;
665         char *ptr;
666         Zfront_handle *zhandle = (Zfront_handle *)handle;
667
668 /*      WRBUF oid_dotted; */
669
670         dSP;
671         ENTER;
672         SAVETMPS;
673
674         href = newHV();
675         hv_store(href, "HANDLE", 6, zhandle->handle, 0);
676         hv_store(href, "ERR_CODE", 8, newSViv(0), 0);
677         hv_store(href, "ERR_STR", 7, newSVpv("", 0), 0);
678         hv_store(href, "START", 5, newSViv(rr->start), 0);
679         hv_store(href, "SETNAME", 7, newSVpv(rr->setname, 0), 0);
680         hv_store(href, "NUMBER", 6, newSViv(rr->number), 0);
681         /*oid_dotted = oid2dotted(rr->request_format_raw);
682         hv_store(href, "REQ_FORM", 8, newSVpv((char *)oid_dotted->buf, oid_dotted->pos), 0);*/
683         hv_store(href, "HITS", 4, newSViv(0), 0);
684         hv_store(href, "PID", 3, newSViv(getpid()), 0);
685         if (rr->comp)
686         {
687                 composition = rr->comp;
688                 if (composition->which == Z_RecordComp_simple)
689                 {
690                         simple = composition->u.simple;
691                         if (simple->which == Z_ElementSetNames_generic)
692                         {
693                                 hv_store(href, "COMP", 4, newSVpv(simple->u.generic, 0), 0);
694                         } 
695                         else
696                         {
697                                 rr->errcode = 26;
698                                 return 0;
699                         }
700                 }
701                 else
702                 {
703                         rr->errcode = 26;
704                         return 0;
705                 }
706         }
707
708         PUSHMARK(sp);
709         
710         XPUSHs(sv_2mortal(newRV( (SV*) href)));
711         
712         PUTBACK;
713         
714         perl_call_sv(present_ref, G_SCALAR | G_DISCARD);
715         
716         SPAGAIN;
717
718         temp = hv_fetch(href, "ERR_CODE", 8, 1);
719         err_code = newSVsv(*temp);
720
721         temp = hv_fetch(href, "ERR_STR", 7, 1);
722         err_string = newSVsv(*temp);
723
724         temp = hv_fetch(href, "HITS", 4, 1);
725         hits = newSVsv(*temp);
726
727         temp = hv_fetch(href, "HANDLE", 6, 1);
728         point = newSVsv(*temp);
729
730         PUTBACK;
731         FREETMPS;
732         LEAVE;
733         
734         hv_undef(href);
735         rr->errcode = SvIV(err_code);
736         rr->hits = SvIV(hits);
737
738         ptr = SvPV(err_string, len);
739         ODR_errstr = (char *)odr_malloc(rr->stream, len + 1);
740         strcpy(ODR_errstr, ptr);
741         rr->errstring = ODR_errstr;
742 /*      wrbuf_free(oid_dotted, 1);*/
743         zhandle->handle = point;
744         handle = zhandle;
745         sv_free(err_code);
746         sv_free(err_string);
747         sv_free(hits);
748         sv_free( (SV*) href);
749
750         return 0;
751 }
752
753
754 int bend_esrequest(void *handle, bend_esrequest_rr *rr)
755 {
756         perl_call_sv(esrequest_ref, G_VOID | G_DISCARD | G_NOARGS);
757         return 0;
758 }
759
760
761 int bend_delete(void *handle, bend_delete_rr *rr)
762 {
763         perl_call_sv(delete_ref, G_VOID | G_DISCARD | G_NOARGS);
764         return 0;
765 }
766
767
768 int bend_scan(void *handle, bend_scan_rr *rr)
769 {
770         perl_call_sv(scan_ref, G_VOID | G_DISCARD | G_NOARGS);
771         return 0;
772 }
773
774
775 bend_initresult *bend_init(bend_initrequest *q)
776 {
777         bend_initresult *r = (bend_initresult *) odr_malloc (q->stream, sizeof(*r));
778         HV *href;
779         SV **temp;
780         SV *name;
781         SV *ver;
782         SV *err_str;
783         SV *status;
784         Zfront_handle *zhandle =  (Zfront_handle *) xmalloc (sizeof(*zhandle));
785         STRLEN len;
786         int n;
787         SV *handle;
788         /*char *name_ptr;
789         char *ver_ptr;*/
790         char *ptr;
791
792         dSP;
793         ENTER;
794         SAVETMPS;
795
796         /*q->bend_sort = bend_sort;*/
797         if (search_ref)
798         {
799                 q->bend_search = bend_search;
800         }
801         if (present_ref)
802         {
803                 q->bend_present = bend_present;
804         }
805         /*q->bend_esrequest = bend_esrequest;*/
806         /*q->bend_delete = bend_delete;*/
807         if (fetch_ref)
808         {
809                 q->bend_fetch = bend_fetch;
810         }
811         /*q->bend_scan = bend_scan;*/
812         href = newHV(); 
813         hv_store(href, "IMP_NAME", 8, newSVpv("", 0), 0);
814         hv_store(href, "IMP_VER", 7, newSVpv("", 0), 0);
815         hv_store(href, "ERR_CODE", 8, newSViv(0), 0);
816         hv_store(href, "PEER_NAME", 9, newSVpv(q->peer_name, 0), 0);
817         hv_store(href, "HANDLE", 6, newSVsv(&sv_undef), 0);
818         hv_store(href, "PID", 3, newSViv(getpid()), 0);
819
820         PUSHMARK(sp);   
821
822         XPUSHs(sv_2mortal(newRV( (SV*) href)));
823
824         PUTBACK;
825
826         if (init_ref != NULL)
827         {
828                 perl_call_sv(init_ref, G_SCALAR | G_DISCARD);
829         }
830
831         SPAGAIN;
832
833         temp = hv_fetch(href, "IMP_NAME", 8, 1);
834         name = newSVsv(*temp);
835
836         temp = hv_fetch(href, "IMP_VER", 7, 1);
837         ver = newSVsv(*temp);
838
839         temp = hv_fetch(href, "ERR_CODE", 8, 1);
840         status = newSVsv(*temp);
841
842         temp = hv_fetch(href, "HANDLE", 6, 1);
843         handle= newSVsv(*temp);
844
845         hv_undef(href);
846         PUTBACK;
847         FREETMPS;
848         LEAVE;
849         zhandle->handle = handle;
850         r->errcode = SvIV(status);
851         r->handle = zhandle;
852         ptr = SvPV(name, len);
853         q->implementation_name = (char *)xmalloc(len + 1);
854         strcpy(q->implementation_name, ptr);
855 /*      q->implementation_name = SvPV(name, len);*/
856         ptr = SvPV(ver, len);
857         q->implementation_version = (char *)xmalloc(len + 1);
858         strcpy(q->implementation_version, ptr);
859         
860         return r;
861 }
862
863
864 void bend_close(void *handle)
865 {
866         HV *href;
867         Zfront_handle *zhandle = (Zfront_handle *)handle;
868         SV **temp;
869
870         dSP;
871         ENTER;
872         SAVETMPS;
873
874         if (close_ref == NULL)
875         {
876                 return;
877         }
878
879         href = newHV();
880         hv_store(href, "HANDLE", 6, zhandle->handle, 0);
881
882         PUSHMARK(sp);
883
884         XPUSHs(sv_2mortal(newRV((SV *)href)));
885
886         PUTBACK;
887         
888         perl_call_sv(close_ref, G_SCALAR | G_DISCARD);
889         
890         SPAGAIN;
891
892         PUTBACK;
893         FREETMPS;
894         LEAVE;
895
896         xfree(handle);
897         
898         return;
899 }
900
901
902 MODULE = Net::Z3950::SimpleServer       PACKAGE = Net::Z3950::SimpleServer
903
904 void
905 set_init_handler(arg)
906                 SV *arg
907         CODE:
908                 init_ref = newSVsv(arg);
909                 
910
911 void
912 set_close_handler(arg)
913                 SV *arg
914         CODE:
915                 close_ref = newSVsv(arg);
916
917
918 void
919 set_sort_handler(arg)
920                 SV *arg
921         CODE:
922                 sort_ref = newSVsv(arg);
923
924 void
925 set_search_handler(arg)
926                 SV *arg
927         CODE:
928                 search_ref = newSVsv(arg);
929
930
931 void
932 set_fetch_handler(arg)
933                 SV *arg
934         CODE:
935                 fetch_ref = newSVsv(arg);
936
937
938 void
939 set_present_handler(arg)
940                 SV *arg
941         CODE:
942                 present_ref = newSVsv(arg);
943
944
945 void
946 set_esrequest_handler(arg)
947                 SV *arg
948         CODE:
949                 esrequest_ref = newSVsv(arg);
950
951
952 void
953 set_delete_handler(arg)
954                 SV *arg
955         CODE:
956                 delete_ref = newSVsv(arg);
957
958
959 void
960 set_scan_handler(arg)
961                 SV *arg
962         CODE:
963                 scan_ref = newSVsv(arg);
964
965
966 int
967 start_server(...)
968         PREINIT:
969                 char **argv;
970                 char **argv_buf;
971                 char *ptr;
972                 int i;
973                 STRLEN len;
974         CODE:
975                 argv_buf = (char **)xmalloc((items + 1) * sizeof(char *));
976                 argv = argv_buf;
977                 for (i = 0; i < items; i++)
978                 {
979                         ptr = SvPV(ST(i), len);
980                         *argv_buf = (char *)xmalloc(len + 1);
981                         strcpy(*argv_buf++, ptr); 
982                 }
983                 *argv_buf = NULL;
984                 
985                 RETVAL = statserv_main(items, argv, bend_init, bend_close);
986         OUTPUT:
987                 RETVAL