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