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