From 78d6e69ff8ed9dbe611e8e57eb11a477d5497eaa Mon Sep 17 00:00:00 2001 From: "Anders S. Mortensen" Date: Fri, 24 Aug 2001 14:00:20 +0000 Subject: [PATCH] Added support for scan. --- Makefile | 165 +++++++++++++++------------------------------ SimpleServer.c | 200 ++++++++++++++++++++++++++++++++++++++++++++----------- SimpleServer.pm | 19 +++--- SimpleServer.xs | 132 ++++++++++++++++++++++++++++++++++-- ztest.pl | 44 +++++++++++- 5 files changed, 397 insertions(+), 163 deletions(-) diff --git a/Makefile b/Makefile index fa00ff6..b4d3a3b 100644 --- a/Makefile +++ b/Makefile @@ -1,7 +1,7 @@ # This Makefile is for the Net::Z3950::SimpleServer extension to perl. # # It was generated automatically by MakeMaker version -# 5.45 (Revision: 1.222) from the contents of +# 5.4302 (Revision: 1.222) from the contents of # Makefile.PL. Don't edit this file, edit Makefile.PL instead. # # ANY CHANGES MADE HERE WILL BE LOST! @@ -21,7 +21,7 @@ # --- MakeMaker const_config section: -# These definitions are from config.sh (via /usr/local/lib/perl5/5.6.0/i686-linux/Config.pm) +# These definitions are from config.sh (via /usr/lib/perl5/5.00503/i386-linux/Config.pm) # They may have been overridden via Makefile.PL or on the command line AR = ar @@ -33,15 +33,14 @@ DLSRC = dl_dlopen.xs LD = cc LDDLFLAGS = -shared -L/usr/local/lib LDFLAGS = -L/usr/local/lib -LIBC = /lib/libc-2.1.3.so +LIBC = LIB_EXT = .a OBJ_EXT = .o OSNAME = linux -OSVERS = 2.2.14-5.0 +OSVERS = 2.2.1-ac1 RANLIB = : SO = so EXE_EXT = -FULL_AR = /usr/bin/ar # --- MakeMaker constants section: @@ -57,35 +56,33 @@ INST_EXE = blib/script INST_LIB = blib/lib INST_ARCHLIB = blib/arch INST_SCRIPT = blib/script -PREFIX = /usr/local +PREFIX = /usr INSTALLDIRS = site -INSTALLPRIVLIB = $(PREFIX)/lib/perl5/5.6.0 -INSTALLARCHLIB = $(PREFIX)/lib/perl5/5.6.0/i686-linux -INSTALLSITELIB = $(PREFIX)/lib/perl5/site_perl/5.6.0 -INSTALLSITEARCH = $(PREFIX)/lib/perl5/site_perl/5.6.0/i686-linux +INSTALLPRIVLIB = $(PREFIX)/lib/perl5/5.00503 +INSTALLARCHLIB = $(PREFIX)/lib/perl5/5.00503/i386-linux +INSTALLSITELIB = $(PREFIX)/lib/perl5/site_perl/5.005 +INSTALLSITEARCH = $(PREFIX)/lib/perl5/site_perl/5.005/i386-linux INSTALLBIN = $(PREFIX)/bin INSTALLSCRIPT = $(PREFIX)/bin -PERL_LIB = /usr/local/lib/perl5/5.6.0 -PERL_ARCHLIB = /usr/local/lib/perl5/5.6.0/i686-linux -SITELIBEXP = /usr/local/lib/perl5/site_perl/5.6.0 -SITEARCHEXP = /usr/local/lib/perl5/site_perl/5.6.0/i686-linux +PERL_LIB = /usr/lib/perl5/5.00503 +PERL_ARCHLIB = /usr/lib/perl5/5.00503/i386-linux +SITELIBEXP = /usr/lib/perl5/site_perl/5.005 +SITEARCHEXP = /usr/lib/perl5/site_perl/5.005/i386-linux LIBPERL_A = libperl.a FIRST_MAKEFILE = Makefile MAKE_APERL_FILE = Makefile.aperl PERLMAINCC = $(CC) -PERL_INC = /usr/local/lib/perl5/5.6.0/i686-linux/CORE +PERL_INC = /usr/lib/perl5/5.00503/i386-linux/CORE PERL = /usr/bin/perl FULLPERL = /usr/bin/perl -FULL_AR = /usr/bin/ar VERSION_MACRO = VERSION DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\" XS_VERSION_MACRO = XS_VERSION XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\" -PERL_MALLOC_DEF = -DPERL_EXTMALLOC_DEF -Dmalloc=Perl_malloc -Dfree=Perl_mfree -Drealloc=Perl_realloc -Dcalloc=Perl_calloc -MAKEMAKER = /usr/local/lib/perl5/5.6.0/ExtUtils/MakeMaker.pm -MM_VERSION = 5.45 +MAKEMAKER = /usr/lib/perl5/5.00503/ExtUtils/MakeMaker.pm +MM_VERSION = 5.4302 # FULLEXT = Pathname for extension directory (eg Foo/Bar/Oracle). # BASEEXT = Basename part of FULLEXT. May be just equal FULLEXT. (eg Oracle) @@ -108,17 +105,14 @@ XS_FILES= SimpleServer.xs C_FILES = SimpleServer.c O_FILES = SimpleServer.o H_FILES = -HTMLLIBPODS = -HTMLSCRIPTPODS = MAN1PODS = MAN3PODS = GRS1.pm \ SimpleServer.pm -HTMLEXT = html INST_MAN1DIR = blib/man1 INSTALLMAN1DIR = $(PREFIX)/man/man1 MAN1EXT = 1 INST_MAN3DIR = blib/man3 -INSTALLMAN3DIR = $(PREFIX)/man/man3 +INSTALLMAN3DIR = $(PREFIX)/lib/perl5/man/man3 MAN3EXT = 3 PERM_RW = 644 PERM_RWX = 755 @@ -158,21 +152,18 @@ TO_INST_PM = GRS1.pm \ OID.pm \ SimpleServer.pm \ grs_test.pl \ - hash2grs.pl \ ztest.pl PM_TO_BLIB = GRS1.pm \ $(INST_LIBDIR)/GRS1.pm \ ztest.pl \ $(INST_LIBDIR)/ztest.pl \ - hash2grs.pl \ - $(INST_LIBDIR)/hash2grs.pl \ - OID.pm \ - $(INST_LIBDIR)/OID.pm \ + SimpleServer.pm \ + $(INST_LIBDIR)/SimpleServer.pm \ grs_test.pl \ $(INST_LIBDIR)/grs_test.pl \ - SimpleServer.pm \ - $(INST_LIBDIR)/SimpleServer.pm + OID.pm \ + $(INST_LIBDIR)/OID.pm # --- MakeMaker tool_autosplit section: @@ -183,10 +174,10 @@ AUTOSPLITFILE = $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e 'use AutoSplit;au # --- MakeMaker tool_xsubpp section: -XSUBPPDIR = /usr/local/lib/perl5/5.6.0/ExtUtils +XSUBPPDIR = /usr/lib/perl5/5.00503/ExtUtils XSUBPP = $(XSUBPPDIR)/xsubpp XSPROTOARG = -XSUBPPDEPS = $(XSUBPPDIR)/typemap $(XSUBPP) +XSUBPPDEPS = $(XSUBPPDIR)/typemap XSUBPPARGS = -typemap $(XSUBPPDIR)/typemap @@ -267,12 +258,11 @@ DIST_DEFAULT = tardist # --- MakeMaker cflags section: -CCFLAGS = -fno-strict-aliasing -I/usr/local/include -D_LARGEFILE_SOURCE -D_FILE_OFFSET_BITS=64 +CCFLAGS = -Dbool=char -DHAS_BOOL -I/usr/local/include OPTIMIZE = -O2 PERLTYPE = LARGE = SPLIT = -MPOLLUTE = # --- MakeMaker const_loadlibs section: @@ -288,7 +278,7 @@ LD_RUN_PATH = /usr/local/lib # --- MakeMaker const_cccmd section: CCCMD = $(CC) -c $(INC) $(CCFLAGS) $(OPTIMIZE) \ - $(PERLTYPE) $(LARGE) $(SPLIT) $(MPOLLUTE) $(DEFINE_VERSION) \ + $(PERLTYPE) $(LARGE) $(SPLIT) $(DEFINE_VERSION) \ $(XS_DEFINE_VERSION) # --- MakeMaker post_constants section: @@ -324,13 +314,13 @@ PASTHRU = LIB="$(LIB)"\ # --- MakeMaker xs_c section: .xs.c: - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >xstmp.c && $(MV) xstmp.c $*.c # --- MakeMaker xs_o section: .xs$(OBJ_EXT): - $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs > $*.xsc && $(MV) $*.xsc $*.c + $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(XSUBPP) $(XSPROTOARG) $(XSUBPPARGS) $*.xs >xstmp.c && $(MV) xstmp.c $*.c $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c @@ -338,7 +328,7 @@ PASTHRU = LIB="$(LIB)"\ #all :: config $(INST_PM) subdirs linkext manifypods -all :: pure_all htmlifypods manifypods +all :: pure_all manifypods @$(NOOP) pure_all :: config pm_to_blib subdirs linkext @@ -356,21 +346,25 @@ config :: $(INST_ARCHAUTODIR)/.exists config :: $(INST_AUTODIR)/.exists @$(NOOP) -$(INST_AUTODIR)/.exists :: /usr/local/lib/perl5/5.6.0/i686-linux/CORE/perl.h +config :: Version_check + @$(NOOP) + + +$(INST_AUTODIR)/.exists :: /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h @$(MKPATH) $(INST_AUTODIR) - @$(EQUALIZE_TIMESTAMP) /usr/local/lib/perl5/5.6.0/i686-linux/CORE/perl.h $(INST_AUTODIR)/.exists + @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h $(INST_AUTODIR)/.exists -@$(CHMOD) $(PERM_RWX) $(INST_AUTODIR) -$(INST_LIBDIR)/.exists :: /usr/local/lib/perl5/5.6.0/i686-linux/CORE/perl.h +$(INST_LIBDIR)/.exists :: /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h @$(MKPATH) $(INST_LIBDIR) - @$(EQUALIZE_TIMESTAMP) /usr/local/lib/perl5/5.6.0/i686-linux/CORE/perl.h $(INST_LIBDIR)/.exists + @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h $(INST_LIBDIR)/.exists -@$(CHMOD) $(PERM_RWX) $(INST_LIBDIR) -$(INST_ARCHAUTODIR)/.exists :: /usr/local/lib/perl5/5.6.0/i686-linux/CORE/perl.h +$(INST_ARCHAUTODIR)/.exists :: /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h @$(MKPATH) $(INST_ARCHAUTODIR) - @$(EQUALIZE_TIMESTAMP) /usr/local/lib/perl5/5.6.0/i686-linux/CORE/perl.h $(INST_ARCHAUTODIR)/.exists + @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h $(INST_ARCHAUTODIR)/.exists -@$(CHMOD) $(PERM_RWX) $(INST_ARCHAUTODIR) @@ -378,9 +372,9 @@ config :: $(INST_MAN3DIR)/.exists @$(NOOP) -$(INST_MAN3DIR)/.exists :: /usr/local/lib/perl5/5.6.0/i686-linux/CORE/perl.h +$(INST_MAN3DIR)/.exists :: /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h @$(MKPATH) $(INST_MAN3DIR) - @$(EQUALIZE_TIMESTAMP) /usr/local/lib/perl5/5.6.0/i686-linux/CORE/perl.h $(INST_MAN3DIR)/.exists + @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h $(INST_MAN3DIR)/.exists -@$(CHMOD) $(PERM_RWX) $(INST_MAN3DIR) @@ -458,20 +452,14 @@ static :: Makefile $(INST_STATIC) $(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)/.exists $(RM_RF) $@ - $(FULL_AR) $(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@ + $(AR) $(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@ $(CHMOD) $(PERM_RWX) $@ @echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld -# --- MakeMaker htmlifypods section: - -htmlifypods : pure_all - @$(NOOP) - - # --- MakeMaker manifypods section: -POD2MAN_EXE = /usr/local/bin/pod2man +POD2MAN_EXE = /usr/bin/pod2man POD2MAN = $(PERL) -we '%m=@ARGV;for (keys %m){' \ -e 'next if -e $$m{$$_} && -M $$m{$$_} < -M $$_ && -M $$m{$$_} < -M "Makefile";' \ -e 'print "Manifying $$m{$$_}\n";' \ @@ -502,7 +490,7 @@ manifypods : pure_all GRS1.pm \ # the Makefile here so a later make realclean still has a makefile to use. clean :: - -rm -rf SimpleServer.c ./blib $(MAKE_APERL_FILE) $(INST_ARCHAUTODIR)/extralibs.all perlmain.c mon.out core core.*perl.*.? *perl.core so_locations pm_to_blib *~ */*~ */*/*~ *$(OBJ_EXT) *$(LIB_EXT) perl.exe $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def $(BASEEXT).exp + -rm -rf SimpleServer.c ./blib $(MAKE_APERL_FILE) $(INST_ARCHAUTODIR)/extralibs.all perlmain.c mon.out core so_locations pm_to_blib *~ */*~ */*/*~ *$(OBJ_EXT) *$(LIB_EXT) perl.exe $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def $(BASEEXT).exp -mv Makefile Makefile.old $(DEV_NULL) @@ -513,7 +501,7 @@ realclean purge :: clean rm -rf $(INST_AUTODIR) $(INST_ARCHAUTODIR) rm -f $(INST_DYNAMIC) $(INST_BOOT) rm -f $(INST_STATIC) - rm -f $(INST_LIBDIR)/GRS1.pm $(INST_LIBDIR)/ztest.pl $(INST_LIBDIR)/hash2grs.pl $(INST_LIBDIR)/OID.pm $(INST_LIBDIR)/grs_test.pl $(INST_LIBDIR)/SimpleServer.pm + rm -f $(INST_LIBDIR)/GRS1.pm $(INST_LIBDIR)/ztest.pl $(INST_LIBDIR)/SimpleServer.pm $(INST_LIBDIR)/grs_test.pl $(INST_LIBDIR)/OID.pm rm -rf Makefile Makefile.old @@ -625,8 +613,6 @@ pure_perl_install :: $(INST_ARCHLIB) $(INSTALLARCHLIB) \ $(INST_BIN) $(INSTALLBIN) \ $(INST_SCRIPT) $(INSTALLSCRIPT) \ - $(INST_HTMLLIBDIR) $(INSTALLHTMLPRIVLIBDIR) \ - $(INST_HTMLSCRIPTDIR) $(INSTALLHTMLSCRIPTDIR) \ $(INST_MAN1DIR) $(INSTALLMAN1DIR) \ $(INST_MAN3DIR) $(INSTALLMAN3DIR) @$(WARN_IF_OLD_PACKLIST) \ @@ -641,15 +627,12 @@ pure_site_install :: $(INST_ARCHLIB) $(INSTALLSITEARCH) \ $(INST_BIN) $(INSTALLBIN) \ $(INST_SCRIPT) $(INSTALLSCRIPT) \ - $(INST_HTMLLIBDIR) $(INSTALLHTMLSITELIBDIR) \ - $(INST_HTMLSCRIPTDIR) $(INSTALLHTMLSCRIPTDIR) \ $(INST_MAN1DIR) $(INSTALLMAN1DIR) \ $(INST_MAN3DIR) $(INSTALLMAN3DIR) @$(WARN_IF_OLD_PACKLIST) \ $(PERL_ARCHLIB)/auto/$(FULLEXT) doc_perl_install :: - -@$(MKPATH) $(INSTALLARCHLIB) -@$(DOC_INSTALL) \ "Module" "$(NAME)" \ "installed into" "$(INSTALLPRIVLIB)" \ @@ -659,7 +642,6 @@ doc_perl_install :: >> $(INSTALLARCHLIB)/perllocal.pod doc_site_install :: - -@$(MKPATH) $(INSTALLARCHLIB) -@$(DOC_INSTALL) \ "Module" "$(NAME)" \ "installed into" "$(INSTALLSITELIB)" \ @@ -687,53 +669,16 @@ FORCE: # --- MakeMaker perldepend section: PERL_HDRS = \ - $(PERL_INC)/EXTERN.h \ - $(PERL_INC)/INTERN.h \ - $(PERL_INC)/XSUB.h \ - $(PERL_INC)/av.h \ - $(PERL_INC)/cc_runtime.h \ - $(PERL_INC)/config.h \ - $(PERL_INC)/cop.h \ - $(PERL_INC)/cv.h \ - $(PERL_INC)/dosish.h \ - $(PERL_INC)/embed.h \ - $(PERL_INC)/embedvar.h \ - $(PERL_INC)/fakethr.h \ - $(PERL_INC)/form.h \ - $(PERL_INC)/gv.h \ - $(PERL_INC)/handy.h \ - $(PERL_INC)/hv.h \ - $(PERL_INC)/intrpvar.h \ - $(PERL_INC)/iperlsys.h \ - $(PERL_INC)/keywords.h \ - $(PERL_INC)/mg.h \ - $(PERL_INC)/nostdio.h \ - $(PERL_INC)/objXSUB.h \ - $(PERL_INC)/op.h \ - $(PERL_INC)/opcode.h \ - $(PERL_INC)/opnames.h \ - $(PERL_INC)/patchlevel.h \ - $(PERL_INC)/perl.h \ - $(PERL_INC)/perlapi.h \ - $(PERL_INC)/perlio.h \ - $(PERL_INC)/perlsdio.h \ - $(PERL_INC)/perlsfio.h \ - $(PERL_INC)/perlvars.h \ - $(PERL_INC)/perly.h \ - $(PERL_INC)/pp.h \ - $(PERL_INC)/pp_proto.h \ - $(PERL_INC)/proto.h \ - $(PERL_INC)/regcomp.h \ - $(PERL_INC)/regexp.h \ - $(PERL_INC)/regnodes.h \ - $(PERL_INC)/scope.h \ - $(PERL_INC)/sv.h \ - $(PERL_INC)/thrdvar.h \ - $(PERL_INC)/thread.h \ - $(PERL_INC)/unixish.h \ - $(PERL_INC)/utf8.h \ - $(PERL_INC)/util.h \ - $(PERL_INC)/warnings.h +$(PERL_INC)/EXTERN.h $(PERL_INC)/gv.h $(PERL_INC)/pp.h \ +$(PERL_INC)/INTERN.h $(PERL_INC)/handy.h $(PERL_INC)/proto.h \ +$(PERL_INC)/XSUB.h $(PERL_INC)/hv.h $(PERL_INC)/regcomp.h \ +$(PERL_INC)/av.h $(PERL_INC)/keywords.h $(PERL_INC)/regexp.h \ +$(PERL_INC)/config.h $(PERL_INC)/mg.h $(PERL_INC)/scope.h \ +$(PERL_INC)/cop.h $(PERL_INC)/op.h $(PERL_INC)/sv.h \ +$(PERL_INC)/cv.h $(PERL_INC)/opcode.h $(PERL_INC)/unixish.h \ +$(PERL_INC)/dosish.h $(PERL_INC)/patchlevel.h $(PERL_INC)/util.h \ +$(PERL_INC)/embed.h $(PERL_INC)/perl.h $(PERL_INC)/iperlsys.h \ +$(PERL_INC)/form.h $(PERL_INC)/perly.h $(OBJECT) : $(PERL_HDRS) @@ -811,7 +756,7 @@ testdb_static :: pure_all $(MAP_TARGET) # --- MakeMaker ppd section: # Creates a PPD (Perl Package Description) for a binary distribution. ppd: - @$(PERL) -e "print qq{\n}. qq{\tNet-Z3950-SimpleServer\n}. qq{\t\n}. qq{\t\n}. qq{\t\n}. qq{\t\t\n}. qq{\t\t\n}. qq{\t\t\n}. qq{\t\n}. qq{\n}" > Net-Z3950-SimpleServer.ppd + @$(PERL) -e "print qq{\n}. qq{\tNet-Z3950-SimpleServer\n}. qq{\t\n}. qq{\t\n}. qq{\t\n}. qq{\t\t\n}. qq{\t\t\n}. qq{\t\t\n}. qq{\t\n}. qq{\n}" > Net-Z3950-SimpleServer.ppd # --- MakeMaker pm_to_blib section: diff --git a/SimpleServer.c b/SimpleServer.c index 4b62b93..6d6629e 100644 --- a/SimpleServer.c +++ b/SimpleServer.c @@ -34,7 +34,10 @@ */ /*$Log: SimpleServer.c,v $ -/*Revision 1.10 2001-05-21 11:07:02 sondberg +/*Revision 1.11 2001-08-24 14:00:20 sondberg +/*Added support for scan. +/* +/*Revision 1.8 2001/05/21 11:07:02 sondberg /*Extended maximum numbers of GRS-1 elements. Should be done dynamically. /* /*Revision 1.7 2001/03/13 14:17:15 sondberg @@ -784,8 +787,126 @@ int bend_delete(void *handle, bend_delete_rr *rr) int bend_scan(void *handle, bend_scan_rr *rr) { - perl_call_sv(scan_ref, G_VOID | G_DISCARD | G_NOARGS); - return 0; + HV *href; + AV *aref; + AV *list; + AV *entries; + HV *scan_item; + struct scan_entry *scan_list; + struct scan_entry *buffer; + int *step_size = rr->step_size; + int i; + char **basenames; + SV **temp; + SV *list_ref = sv_newmortal(); + SV *err_code = sv_newmortal(); + SV *err_str = sv_newmortal(); + SV *point = sv_newmortal(); + SV *status = sv_newmortal(); + SV *number = sv_newmortal(); + char *ptr; + char *ODR_errstr; + STRLEN len; + + Zfront_handle *zhandle = (Zfront_handle *)handle; + + dSP; + ENTER; + SAVETMPS; + href = newHV(); + list = newAV(); + if (rr->term->term->which == Z_Term_general) + { + hv_store(href, "TERM", 4, newSVpv(rr->term->term->u.general->buf, 0), 0); + } else { + rr->errcode = 229; /* Unsupported term type */ + return 0; + } + hv_store(href, "STEP", 4, newSViv(*step_size), 0); + hv_store(href, "NUMBER", 6, newSViv(rr->num_entries), 0); + hv_store(href, "POS", 3, newSViv(rr->term_position), 0); + hv_store(href, "ERR_CODE", 8, newSViv(0), 0); + hv_store(href, "ERR_STR", 7, newSVpv("", 0), 0); + hv_store(href, "HANDLE", 6, zhandle->handle, 0); + hv_store(href, "STATUS", 6, newSViv(BEND_SCAN_SUCCESS), 0); + hv_store(href, "ENTRIES", 7, newRV((SV *) list), 0); + aref = newAV(); + basenames = rr->basenames; + for (i = 0; i < rr->num_bases; i++) + { + av_push(aref, newSVpv(*basenames++, 0)); + } + hv_store(href, "DATABASES", 9, newRV( (SV*) aref), 0); + + PUSHMARK(sp); + + XPUSHs(sv_2mortal(newRV( (SV*) href))); + + PUTBACK; + + perl_call_sv(scan_ref, G_SCALAR | G_DISCARD); + + SPAGAIN; + + temp = hv_fetch(href, "ERR_CODE", 8, 1); + err_code = newSVsv(*temp); + + temp = hv_fetch(href, "ERR_STR", 7, 1); + err_str = newSVsv(*temp); + + temp = hv_fetch(href, "HANDLE", 6, 1); + point = newSVsv(*temp); + + temp = hv_fetch(href, "STATUS", 6, 1); + status = newSVsv(*temp); + + temp = hv_fetch(href, "NUMBER", 6, 1); + number = newSVsv(*temp); + + temp = hv_fetch(href, "ENTRIES", 7, 1); + list_ref = newSVsv(*temp); + entries = (AV *)SvRV(list_ref); + + PUTBACK; + FREETMPS; + LEAVE; + + ptr = SvPV(err_str, len); + ODR_errstr = (char *)odr_malloc(rr->stream, len + 1); + strcpy(ODR_errstr, ptr); + rr->errstring = ODR_errstr; + rr->errcode = SvIV(err_code); + rr->num_entries = SvIV(number); + rr->status = SvIV(status); + scan_list = (struct scan_entry *) odr_malloc (rr->stream, rr->num_entries * sizeof(*scan_list)); + buffer = scan_list; + for (i = 0; i < rr->num_entries; i++) + { + scan_item = (HV *)SvRV(sv_2mortal(av_shift(entries))); + temp = hv_fetch(scan_item, "TERM", 4, 1); + ptr = SvPV(*temp, len); + buffer->term = (char *) odr_malloc (rr->stream, len + 1); + strcpy(buffer->term, ptr); + temp = hv_fetch(scan_item, "OCCURRENCE", 10, 1); + buffer->occurrences = SvIV(*temp); + buffer++; + hv_undef(scan_item); + } + rr->entries = scan_list; + zhandle->handle = point; + handle = zhandle; + /*sv_free(list_ref);*/ + sv_free(err_code); + sv_free(err_str); + sv_free(status); + sv_free(number); + /*sv_free(point);*/ + hv_undef(href); + av_undef(aref); + av_undef(list); + av_undef(entries); + + return 0; } @@ -825,7 +946,10 @@ bend_initresult *bend_init(bend_initrequest *q) { q->bend_fetch = bend_fetch; } - /*q->bend_scan = bend_scan;*/ + if (scan_ref) + { + q->bend_scan = bend_scan; + } href = newHV(); hv_store(href, "IMP_NAME", 8, newSVpv("", 0), 0); hv_store(href, "IMP_VER", 7, newSVpv("", 0), 0); @@ -916,17 +1040,17 @@ void bend_close(void *handle) } -#line 917 "SimpleServer.c" +#line 1041 "SimpleServer.c" XS(XS_Net__Z3950__SimpleServer_set_init_handler) { dXSARGS; if (items != 1) - Perl_croak(aTHX_ "Usage: Net::Z3950::SimpleServer::set_init_handler(arg)"); + croak("Usage: Net::Z3950::SimpleServer::set_init_handler(arg)"); { SV * arg = ST(0); -#line 913 "SimpleServer.xs" +#line 1037 "SimpleServer.xs" init_ref = newSVsv(arg); -#line 927 "SimpleServer.c" +#line 1051 "SimpleServer.c" } XSRETURN_EMPTY; } @@ -935,12 +1059,12 @@ XS(XS_Net__Z3950__SimpleServer_set_close_handler) { dXSARGS; if (items != 1) - Perl_croak(aTHX_ "Usage: Net::Z3950::SimpleServer::set_close_handler(arg)"); + croak("Usage: Net::Z3950::SimpleServer::set_close_handler(arg)"); { SV * arg = ST(0); -#line 920 "SimpleServer.xs" +#line 1044 "SimpleServer.xs" close_ref = newSVsv(arg); -#line 941 "SimpleServer.c" +#line 1065 "SimpleServer.c" } XSRETURN_EMPTY; } @@ -949,12 +1073,12 @@ XS(XS_Net__Z3950__SimpleServer_set_sort_handler) { dXSARGS; if (items != 1) - Perl_croak(aTHX_ "Usage: Net::Z3950::SimpleServer::set_sort_handler(arg)"); + croak("Usage: Net::Z3950::SimpleServer::set_sort_handler(arg)"); { SV * arg = ST(0); -#line 927 "SimpleServer.xs" +#line 1051 "SimpleServer.xs" sort_ref = newSVsv(arg); -#line 955 "SimpleServer.c" +#line 1079 "SimpleServer.c" } XSRETURN_EMPTY; } @@ -963,12 +1087,12 @@ XS(XS_Net__Z3950__SimpleServer_set_search_handler) { dXSARGS; if (items != 1) - Perl_croak(aTHX_ "Usage: Net::Z3950::SimpleServer::set_search_handler(arg)"); + croak("Usage: Net::Z3950::SimpleServer::set_search_handler(arg)"); { SV * arg = ST(0); -#line 933 "SimpleServer.xs" +#line 1057 "SimpleServer.xs" search_ref = newSVsv(arg); -#line 969 "SimpleServer.c" +#line 1093 "SimpleServer.c" } XSRETURN_EMPTY; } @@ -977,12 +1101,12 @@ XS(XS_Net__Z3950__SimpleServer_set_fetch_handler) { dXSARGS; if (items != 1) - Perl_croak(aTHX_ "Usage: Net::Z3950::SimpleServer::set_fetch_handler(arg)"); + croak("Usage: Net::Z3950::SimpleServer::set_fetch_handler(arg)"); { SV * arg = ST(0); -#line 940 "SimpleServer.xs" +#line 1064 "SimpleServer.xs" fetch_ref = newSVsv(arg); -#line 983 "SimpleServer.c" +#line 1107 "SimpleServer.c" } XSRETURN_EMPTY; } @@ -991,12 +1115,12 @@ XS(XS_Net__Z3950__SimpleServer_set_present_handler) { dXSARGS; if (items != 1) - Perl_croak(aTHX_ "Usage: Net::Z3950::SimpleServer::set_present_handler(arg)"); + croak("Usage: Net::Z3950::SimpleServer::set_present_handler(arg)"); { SV * arg = ST(0); -#line 947 "SimpleServer.xs" +#line 1071 "SimpleServer.xs" present_ref = newSVsv(arg); -#line 997 "SimpleServer.c" +#line 1121 "SimpleServer.c" } XSRETURN_EMPTY; } @@ -1005,12 +1129,12 @@ XS(XS_Net__Z3950__SimpleServer_set_esrequest_handler) { dXSARGS; if (items != 1) - Perl_croak(aTHX_ "Usage: Net::Z3950::SimpleServer::set_esrequest_handler(arg)"); + croak("Usage: Net::Z3950::SimpleServer::set_esrequest_handler(arg)"); { SV * arg = ST(0); -#line 954 "SimpleServer.xs" +#line 1078 "SimpleServer.xs" esrequest_ref = newSVsv(arg); -#line 1011 "SimpleServer.c" +#line 1135 "SimpleServer.c" } XSRETURN_EMPTY; } @@ -1019,12 +1143,12 @@ XS(XS_Net__Z3950__SimpleServer_set_delete_handler) { dXSARGS; if (items != 1) - Perl_croak(aTHX_ "Usage: Net::Z3950::SimpleServer::set_delete_handler(arg)"); + croak("Usage: Net::Z3950::SimpleServer::set_delete_handler(arg)"); { SV * arg = ST(0); -#line 961 "SimpleServer.xs" +#line 1085 "SimpleServer.xs" delete_ref = newSVsv(arg); -#line 1025 "SimpleServer.c" +#line 1149 "SimpleServer.c" } XSRETURN_EMPTY; } @@ -1033,12 +1157,12 @@ XS(XS_Net__Z3950__SimpleServer_set_scan_handler) { dXSARGS; if (items != 1) - Perl_croak(aTHX_ "Usage: Net::Z3950::SimpleServer::set_scan_handler(arg)"); + croak("Usage: Net::Z3950::SimpleServer::set_scan_handler(arg)"); { SV * arg = ST(0); -#line 968 "SimpleServer.xs" +#line 1092 "SimpleServer.xs" scan_ref = newSVsv(arg); -#line 1039 "SimpleServer.c" +#line 1163 "SimpleServer.c" } XSRETURN_EMPTY; } @@ -1047,16 +1171,15 @@ XS(XS_Net__Z3950__SimpleServer_start_server) { dXSARGS; { -#line 974 "SimpleServer.xs" +#line 1098 "SimpleServer.xs" char **argv; char **argv_buf; char *ptr; int i; STRLEN len; -#line 1054 "SimpleServer.c" +#line 1178 "SimpleServer.c" int RETVAL; - dXSTARG; -#line 980 "SimpleServer.xs" +#line 1104 "SimpleServer.xs" argv_buf = (char **)xmalloc((items + 1) * sizeof(char *)); argv = argv_buf; for (i = 0; i < items; i++) @@ -1068,8 +1191,9 @@ XS(XS_Net__Z3950__SimpleServer_start_server) *argv_buf = NULL; RETVAL = statserv_main(items, argv, bend_init, bend_close); -#line 1069 "SimpleServer.c" - XSprePUSH; PUSHi((IV)RETVAL); +#line 1192 "SimpleServer.c" + ST(0) = sv_newmortal(); + sv_setiv(ST(0), (IV)RETVAL); } XSRETURN(1); } diff --git a/SimpleServer.pm b/SimpleServer.pm index 523cf75..a7bb235 100644 --- a/SimpleServer.pm +++ b/SimpleServer.pm @@ -26,7 +26,10 @@ ## ## $Log: SimpleServer.pm,v $ -## Revision 1.6 2001-03-13 14:17:15 sondberg +## Revision 1.7 2001-08-24 14:00:20 sondberg +## Added support for scan. +## +## Revision 1.6 2001/03/13 14:17:15 sondberg ## Added support for GRS-1. ## @@ -57,19 +60,16 @@ my $count = 0; sub new { my $class = shift; - my $args = shift || croak "SimpleServer::new: Usage new(argument hash)"; - my $self = {}; + my %args = @_; + my $self = \%args; if ($count) { carp "SimpleServer.pm: WARNING: Multithreaded server unsupported"; } $count = 1; - $self->{INIT} = $args->{INIT}; - $self->{SEARCH} = $args->{SEARCH} || croak "SimpleServer.pm: ERROR: Unspecified search handler"; - $self->{FETCH} = $args->{FETCH} || croak "SimpleServer.pm: ERROR: Unspecified fetch handler"; - $self->{CLOSE} = $args->{CLOSE}; - $self->{PRESENT} = $args->{PRESENT}; + croak "SimpleServer.pm: ERROR: Unspecified search handler" unless defined($self->{SEARCH}); + croak "SimpleServer.pm: ERROR: Unspecified fetch handler" unless defined($self->{FETCH}); bless $self, $class; return $self; @@ -91,6 +91,9 @@ sub launch_server { if (defined($self->{PRESENT})) { set_present_handler($self->{PRESENT}); } + if (defined($self->{SCAN})) { + set_scan_handler($self->{SCAN}); + } start_server(@args); } diff --git a/SimpleServer.xs b/SimpleServer.xs index 74d2281..cbf2b5b 100644 --- a/SimpleServer.xs +++ b/SimpleServer.xs @@ -25,7 +25,10 @@ */ /*$Log: SimpleServer.xs,v $ -/*Revision 1.8 2001-05-21 11:07:02 sondberg +/*Revision 1.9 2001-08-24 14:00:20 sondberg +/*Added support for scan. +/* +/*Revision 1.8 2001/05/21 11:07:02 sondberg /*Extended maximum numbers of GRS-1 elements. Should be done dynamically. /* /*Revision 1.7 2001/03/13 14:17:15 sondberg @@ -775,8 +778,126 @@ int bend_delete(void *handle, bend_delete_rr *rr) int bend_scan(void *handle, bend_scan_rr *rr) { - perl_call_sv(scan_ref, G_VOID | G_DISCARD | G_NOARGS); - return 0; + HV *href; + AV *aref; + AV *list; + AV *entries; + HV *scan_item; + struct scan_entry *scan_list; + struct scan_entry *buffer; + int *step_size = rr->step_size; + int i; + char **basenames; + SV **temp; + SV *list_ref = sv_newmortal(); + SV *err_code = sv_newmortal(); + SV *err_str = sv_newmortal(); + SV *point = sv_newmortal(); + SV *status = sv_newmortal(); + SV *number = sv_newmortal(); + char *ptr; + char *ODR_errstr; + STRLEN len; + + Zfront_handle *zhandle = (Zfront_handle *)handle; + + dSP; + ENTER; + SAVETMPS; + href = newHV(); + list = newAV(); + if (rr->term->term->which == Z_Term_general) + { + hv_store(href, "TERM", 4, newSVpv(rr->term->term->u.general->buf, 0), 0); + } else { + rr->errcode = 229; /* Unsupported term type */ + return 0; + } + hv_store(href, "STEP", 4, newSViv(*step_size), 0); + hv_store(href, "NUMBER", 6, newSViv(rr->num_entries), 0); + hv_store(href, "POS", 3, newSViv(rr->term_position), 0); + hv_store(href, "ERR_CODE", 8, newSViv(0), 0); + hv_store(href, "ERR_STR", 7, newSVpv("", 0), 0); + hv_store(href, "HANDLE", 6, zhandle->handle, 0); + hv_store(href, "STATUS", 6, newSViv(BEND_SCAN_SUCCESS), 0); + hv_store(href, "ENTRIES", 7, newRV((SV *) list), 0); + aref = newAV(); + basenames = rr->basenames; + for (i = 0; i < rr->num_bases; i++) + { + av_push(aref, newSVpv(*basenames++, 0)); + } + hv_store(href, "DATABASES", 9, newRV( (SV*) aref), 0); + + PUSHMARK(sp); + + XPUSHs(sv_2mortal(newRV( (SV*) href))); + + PUTBACK; + + perl_call_sv(scan_ref, G_SCALAR | G_DISCARD); + + SPAGAIN; + + temp = hv_fetch(href, "ERR_CODE", 8, 1); + err_code = newSVsv(*temp); + + temp = hv_fetch(href, "ERR_STR", 7, 1); + err_str = newSVsv(*temp); + + temp = hv_fetch(href, "HANDLE", 6, 1); + point = newSVsv(*temp); + + temp = hv_fetch(href, "STATUS", 6, 1); + status = newSVsv(*temp); + + temp = hv_fetch(href, "NUMBER", 6, 1); + number = newSVsv(*temp); + + temp = hv_fetch(href, "ENTRIES", 7, 1); + list_ref = newSVsv(*temp); + entries = (AV *)SvRV(list_ref); + + PUTBACK; + FREETMPS; + LEAVE; + + ptr = SvPV(err_str, len); + ODR_errstr = (char *)odr_malloc(rr->stream, len + 1); + strcpy(ODR_errstr, ptr); + rr->errstring = ODR_errstr; + rr->errcode = SvIV(err_code); + rr->num_entries = SvIV(number); + rr->status = SvIV(status); + scan_list = (struct scan_entry *) odr_malloc (rr->stream, rr->num_entries * sizeof(*scan_list)); + buffer = scan_list; + for (i = 0; i < rr->num_entries; i++) + { + scan_item = (HV *)SvRV(sv_2mortal(av_shift(entries))); + temp = hv_fetch(scan_item, "TERM", 4, 1); + ptr = SvPV(*temp, len); + buffer->term = (char *) odr_malloc (rr->stream, len + 1); + strcpy(buffer->term, ptr); + temp = hv_fetch(scan_item, "OCCURRENCE", 10, 1); + buffer->occurrences = SvIV(*temp); + buffer++; + hv_undef(scan_item); + } + rr->entries = scan_list; + zhandle->handle = point; + handle = zhandle; + /*sv_free(list_ref);*/ + sv_free(err_code); + sv_free(err_str); + sv_free(status); + sv_free(number); + /*sv_free(point);*/ + hv_undef(href); + av_undef(aref); + av_undef(list); + av_undef(entries); + + return 0; } @@ -816,7 +937,10 @@ bend_initresult *bend_init(bend_initrequest *q) { q->bend_fetch = bend_fetch; } - /*q->bend_scan = bend_scan;*/ + if (scan_ref) + { + q->bend_scan = bend_scan; + } href = newHV(); hv_store(href, "IMP_NAME", 8, newSVpv("", 0), 0); hv_store(href, "IMP_VER", 7, newSVpv("", 0), 0); diff --git a/ztest.pl b/ztest.pl index 02a0042..f0a224e 100755 --- a/ztest.pl +++ b/ztest.pl @@ -26,6 +26,40 @@ sub my_init_handler { $args->{HANDLE} = $session; } +sub my_scan_handler { + my $args = shift; + my $term = $args->{TERM}; + my $entries = [ + { TERM => 'Number 1', + OCCURRENCE => 10 }, + { TERM => 'Number 2', + OCCURRENCE => 8 }, + { TERM => 'Number 3', + OCCURRENCE => 8 }, + { TERM => 'Number 4', + OCCURRENCE => 8 }, + { TERM => 'Number 5', + OCCURRENCE => 8 }, + { TERM => 'Number 6', + OCCURRENCE => 8 }, + { TERM => 'Number 7', + OCCURRENCE => 8 }, + { TERM => 'Number 8', + OCCURRENCE => 8 }, + { TERM => 'Number 9', + OCCURRENCE => 8 }, + { TERM => 'Number 10', + OCCURRENCE => 4 }, + ]; + + + $args->{NUMBER} = 10; + $args->{ENTRIES} = $entries; + print "Welcome to scan....\n"; + print "You scanned for term '$term'\n"; +} + + sub my_search_handler { my $args = shift; my $data = [{ @@ -84,16 +118,20 @@ sub my_fetch_handler { } -my $handler = Net::Z3950::SimpleServer->new({ +my $handler = new Net::Z3950::SimpleServer( INIT => \&my_init_handler, SEARCH => \&my_search_handler, - FETCH => \&my_fetch_handler }); + SCAN => \&my_scan_handler, + FETCH => \&my_fetch_handler ); $handler->launch_server("ztest.pl", @ARGV); ## $Log: ztest.pl,v $ -## Revision 1.7 2001-03-13 14:20:21 sondberg +## Revision 1.8 2001-08-24 14:00:20 sondberg +## Added support for scan. +## +## Revision 1.7 2001/03/13 14:20:21 sondberg ## Added CVS logging ## -- 1.7.10.4