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