--- /dev/null
+Revision history for Perl extension Net::Z3950::Server.
+
+0.01 Wed Aug 30 14:54:01 2000
+ - original version; created by h2xs 1.19
+
--- /dev/null
+Changes
+Makefile.PL
+MANIFEST
+SimpleServer.pm
+SimpleServer.xs
+test.pl
+ztest.pl
+OID.pm
--- /dev/null
+# This Makefile is for the Net::Z3950::SimpleServer extension to perl.
+#
+# It was generated automatically by MakeMaker version
+# 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!
+#
+# MakeMaker ARGV: ()
+#
+# MakeMaker Parameters:
+
+# DEFINE => q[]
+# INC => q[]
+# LIBS => [q[-L/usr/local/lib -lyaz -lpthread -L/lib -lwrap -lnsl]]
+# NAME => q[Net::Z3950::SimpleServer]
+# VERSION_FROM => q[SimpleServer.pm]
+
+# --- MakeMaker post_initialize section:
+
+
+# --- MakeMaker const_config section:
+
+# 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
+CC = cc
+CCCDLFLAGS = -fpic
+CCDLFLAGS = -rdynamic
+DLEXT = so
+DLSRC = dl_dlopen.xs
+LD = cc
+LDDLFLAGS = -shared -L/usr/local/lib
+LDFLAGS = -L/usr/local/lib
+LIBC =
+LIB_EXT = .a
+OBJ_EXT = .o
+OSNAME = linux
+OSVERS = 2.2.5-22smp
+RANLIB = :
+SO = so
+EXE_EXT =
+
+
+# --- MakeMaker constants section:
+AR_STATIC_ARGS = cr
+NAME = Net::Z3950::SimpleServer
+DISTNAME = Net-Z3950-SimpleServer
+NAME_SYM = Net_Z3950_SimpleServer
+VERSION = 0.02
+VERSION_SYM = 0_02
+XS_VERSION = 0.02
+INST_BIN = blib/bin
+INST_EXE = blib/script
+INST_LIB = blib/lib
+INST_ARCHLIB = blib/arch
+INST_SCRIPT = blib/script
+PREFIX = /usr
+INSTALLDIRS = site
+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/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/lib/perl5/5.00503/i386-linux/CORE
+PERL = /usr/bin/perl
+FULLPERL = /usr/bin/perl
+
+VERSION_MACRO = VERSION
+DEFINE_VERSION = -D$(VERSION_MACRO)=\"$(VERSION)\"
+XS_VERSION_MACRO = XS_VERSION
+XS_DEFINE_VERSION = -D$(XS_VERSION_MACRO)=\"$(XS_VERSION)\"
+
+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)
+# ROOTEXT = Directory part of FULLEXT with leading slash (eg /DBD) !!! Deprecated from MM 5.32 !!!
+# PARENT_NAME = NAME without BASEEXT and no trailing :: (eg Foo::Bar)
+# DLBASE = Basename part of dynamic library. May be just equal BASEEXT.
+FULLEXT = Net/Z3950/SimpleServer
+BASEEXT = SimpleServer
+PARENT_NAME = Net::Z3950
+DLBASE = $(BASEEXT)
+VERSION_FROM = SimpleServer.pm
+INC =
+DEFINE =
+OBJECT = $(BASEEXT)$(OBJ_EXT)
+LDFROM = $(OBJECT)
+LINKTYPE = dynamic
+
+# Handy lists of source code files:
+XS_FILES= SimpleServer.xs
+C_FILES = SimpleServer.c
+O_FILES = SimpleServer.o
+H_FILES =
+MAN1PODS =
+MAN3PODS = SimpleServer.pm
+INST_MAN1DIR = blib/man1
+INSTALLMAN1DIR = $(PREFIX)/man/man1
+MAN1EXT = 1
+INST_MAN3DIR = blib/man3
+INSTALLMAN3DIR = $(PREFIX)/lib/perl5/man/man3
+MAN3EXT = 3
+PERM_RW = 644
+PERM_RWX = 755
+
+# work around a famous dec-osf make(1) feature(?):
+makemakerdflt: all
+
+.SUFFIXES: .xs .c .C .cpp .cxx .cc $(OBJ_EXT)
+
+# Nick wanted to get rid of .PRECIOUS. I don't remember why. I seem to recall, that
+# some make implementations will delete the Makefile when we rebuild it. Because
+# we call false(1) when we rebuild it. So make(1) is not completely wrong when it
+# does so. Our milage may vary.
+# .PRECIOUS: Makefile # seems to be not necessary anymore
+
+.PHONY: all config static dynamic test linkext manifest
+
+# Where is the Config information that we are using/depend on
+CONFIGDEP = $(PERL_ARCHLIB)/Config.pm $(PERL_INC)/config.h
+
+# Where to put things:
+INST_LIBDIR = $(INST_LIB)/Net/Z3950
+INST_ARCHLIBDIR = $(INST_ARCHLIB)/Net/Z3950
+
+INST_AUTODIR = $(INST_LIB)/auto/$(FULLEXT)
+INST_ARCHAUTODIR = $(INST_ARCHLIB)/auto/$(FULLEXT)
+
+INST_STATIC = $(INST_ARCHAUTODIR)/$(BASEEXT)$(LIB_EXT)
+INST_DYNAMIC = $(INST_ARCHAUTODIR)/$(DLBASE).$(DLEXT)
+INST_BOOT = $(INST_ARCHAUTODIR)/$(BASEEXT).bs
+
+EXPORT_LIST =
+
+PERL_ARCHIVE =
+
+TO_INST_PM = OID.pm \
+ SimpleServer.pm \
+ ztest.pl
+
+PM_TO_BLIB = SimpleServer.pm \
+ $(INST_LIBDIR)/SimpleServer.pm \
+ ztest.pl \
+ $(INST_LIBDIR)/ztest.pl \
+ OID.pm \
+ $(INST_LIBDIR)/OID.pm
+
+
+# --- MakeMaker tool_autosplit section:
+
+# Usage: $(AUTOSPLITFILE) FileToSplit AutoDirToSplitInto
+AUTOSPLITFILE = $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -e 'use AutoSplit;autosplit($$ARGV[0], $$ARGV[1], 0, 1, 1) ;'
+
+
+# --- MakeMaker tool_xsubpp section:
+
+XSUBPPDIR = /usr/lib/perl5/5.00503/ExtUtils
+XSUBPP = $(XSUBPPDIR)/xsubpp
+XSPROTOARG =
+XSUBPPDEPS = $(XSUBPPDIR)/typemap
+XSUBPPARGS = -typemap $(XSUBPPDIR)/typemap
+
+
+# --- MakeMaker tools_other section:
+
+SHELL = /bin/sh
+CHMOD = chmod
+CP = cp
+LD = cc
+MV = mv
+NOOP = $(SHELL) -c true
+RM_F = rm -f
+RM_RF = rm -rf
+TEST_F = test -f
+TOUCH = touch
+UMASK_NULL = umask 0
+DEV_NULL = > /dev/null 2>&1
+
+# The following is a portable way to say mkdir -p
+# To see which directories are created, change the if 0 to if 1
+MKPATH = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e mkpath
+
+# This helps us to minimize the effect of the .exists files A yet
+# better solution would be to have a stable file in the perl
+# distribution with a timestamp of zero. But this solution doesn't
+# need any changes to the core distribution and works with older perls
+EQUALIZE_TIMESTAMP = $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Command -e eqtime
+
+# Here we warn users that an old packlist file was found somewhere,
+# and that they should call some uninstall routine
+WARN_IF_OLD_PACKLIST = $(PERL) -we 'exit unless -f $$ARGV[0];' \
+-e 'print "WARNING: I have found an old package in\n";' \
+-e 'print "\t$$ARGV[0].\n";' \
+-e 'print "Please make sure the two installations are not conflicting\n";'
+
+UNINST=0
+VERBINST=1
+
+MOD_INSTALL = $(PERL) -I$(INST_LIB) -I$(PERL_LIB) -MExtUtils::Install \
+-e "install({@ARGV},'$(VERBINST)',0,'$(UNINST)');"
+
+DOC_INSTALL = $(PERL) -e '$$\="\n\n";' \
+-e 'print "=head2 ", scalar(localtime), ": C<", shift, ">", " L<", shift, ">";' \
+-e 'print "=over 4";' \
+-e 'while (defined($$key = shift) and defined($$val = shift)){print "=item *";print "C<$$key: $$val>";}' \
+-e 'print "=back";'
+
+UNINSTALL = $(PERL) -MExtUtils::Install \
+-e 'uninstall($$ARGV[0],1,1); print "\nUninstall is deprecated. Please check the";' \
+-e 'print " packlist above carefully.\n There may be errors. Remove the";' \
+-e 'print " appropriate files manually.\n Sorry for the inconveniences.\n"'
+
+
+# --- MakeMaker dist section:
+
+DISTVNAME = $(DISTNAME)-$(VERSION)
+TAR = tar
+TARFLAGS = cvf
+ZIP = zip
+ZIPFLAGS = -r
+COMPRESS = gzip --best
+SUFFIX = .gz
+SHAR = shar
+PREOP = @$(NOOP)
+POSTOP = @$(NOOP)
+TO_UNIX = @$(NOOP)
+CI = ci -u
+RCS_LABEL = rcs -Nv$(VERSION_SYM): -q
+DIST_CP = best
+DIST_DEFAULT = tardist
+
+
+# --- MakeMaker macro section:
+
+
+# --- MakeMaker depend section:
+
+
+# --- MakeMaker cflags section:
+
+CCFLAGS = -Dbool=char -DHAS_BOOL -I/usr/local/include
+OPTIMIZE = -O2 -m486 -fno-strength-reduce
+PERLTYPE =
+LARGE =
+SPLIT =
+
+
+# --- MakeMaker const_loadlibs section:
+
+# Net::Z3950::SimpleServer might depend on some other libraries:
+# See ExtUtils::Liblist for details
+#
+EXTRALIBS = -L/usr/local/lib -lyaz -lpthread -L/lib -lwrap -lnsl
+LDLOADLIBS = -L/usr/local/lib -lyaz -lpthread -L/lib -lwrap -lnsl
+BSLOADLIBS =
+LD_RUN_PATH = /usr/local/lib:/lib:/usr/lib
+
+
+# --- MakeMaker const_cccmd section:
+CCCMD = $(CC) -c $(INC) $(CCFLAGS) $(OPTIMIZE) \
+ $(PERLTYPE) $(LARGE) $(SPLIT) $(DEFINE_VERSION) \
+ $(XS_DEFINE_VERSION)
+
+# --- MakeMaker post_constants section:
+
+
+# --- MakeMaker pasthru section:
+
+PASTHRU = LIB="$(LIB)"\
+ LIBPERL_A="$(LIBPERL_A)"\
+ LINKTYPE="$(LINKTYPE)"\
+ PREFIX="$(PREFIX)"\
+ OPTIMIZE="$(OPTIMIZE)"
+
+
+# --- MakeMaker c_o section:
+
+.c$(OBJ_EXT):
+ $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c
+
+.C$(OBJ_EXT):
+ $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.C
+
+.cpp$(OBJ_EXT):
+ $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cpp
+
+.cxx$(OBJ_EXT):
+ $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cxx
+
+.cc$(OBJ_EXT):
+ $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.cc
+
+
+# --- MakeMaker xs_c section:
+
+.xs.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 >xstmp.c && $(MV) xstmp.c $*.c
+ $(CCCMD) $(CCCDLFLAGS) -I$(PERL_INC) $(DEFINE) $*.c
+
+
+# --- MakeMaker top_targets section:
+
+#all :: config $(INST_PM) subdirs linkext manifypods
+
+all :: pure_all manifypods
+ @$(NOOP)
+
+pure_all :: config pm_to_blib subdirs linkext
+ @$(NOOP)
+
+subdirs :: $(MYEXTLIB)
+ @$(NOOP)
+
+config :: Makefile $(INST_LIBDIR)/.exists
+ @$(NOOP)
+
+config :: $(INST_ARCHAUTODIR)/.exists
+ @$(NOOP)
+
+config :: $(INST_AUTODIR)/.exists
+ @$(NOOP)
+
+config :: Version_check
+ @$(NOOP)
+
+
+$(INST_AUTODIR)/.exists :: /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h
+ @$(MKPATH) $(INST_AUTODIR)
+ @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h $(INST_AUTODIR)/.exists
+
+ -@$(CHMOD) $(PERM_RWX) $(INST_AUTODIR)
+
+$(INST_LIBDIR)/.exists :: /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h
+ @$(MKPATH) $(INST_LIBDIR)
+ @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h $(INST_LIBDIR)/.exists
+
+ -@$(CHMOD) $(PERM_RWX) $(INST_LIBDIR)
+
+$(INST_ARCHAUTODIR)/.exists :: /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h
+ @$(MKPATH) $(INST_ARCHAUTODIR)
+ @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h $(INST_ARCHAUTODIR)/.exists
+
+ -@$(CHMOD) $(PERM_RWX) $(INST_ARCHAUTODIR)
+
+config :: $(INST_MAN3DIR)/.exists
+ @$(NOOP)
+
+
+$(INST_MAN3DIR)/.exists :: /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h
+ @$(MKPATH) $(INST_MAN3DIR)
+ @$(EQUALIZE_TIMESTAMP) /usr/lib/perl5/5.00503/i386-linux/CORE/perl.h $(INST_MAN3DIR)/.exists
+
+ -@$(CHMOD) $(PERM_RWX) $(INST_MAN3DIR)
+
+help:
+ perldoc ExtUtils::MakeMaker
+
+Version_check:
+ @$(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \
+ -MExtUtils::MakeMaker=Version_check \
+ -e "Version_check('$(MM_VERSION)')"
+
+
+# --- MakeMaker linkext section:
+
+linkext :: $(LINKTYPE)
+ @$(NOOP)
+
+
+# --- MakeMaker dlsyms section:
+
+
+# --- MakeMaker dynamic section:
+
+## $(INST_PM) has been moved to the all: target.
+## It remains here for awhile to allow for old usage: "make dynamic"
+#dynamic :: Makefile $(INST_DYNAMIC) $(INST_BOOT) $(INST_PM)
+dynamic :: Makefile $(INST_DYNAMIC) $(INST_BOOT)
+ @$(NOOP)
+
+
+# --- MakeMaker dynamic_bs section:
+
+BOOTSTRAP = SimpleServer.bs
+
+# As Mkbootstrap might not write a file (if none is required)
+# we use touch to prevent make continually trying to remake it.
+# The DynaLoader only reads a non-empty file.
+$(BOOTSTRAP): Makefile $(INST_ARCHAUTODIR)/.exists
+ @echo "Running Mkbootstrap for $(NAME) ($(BSLOADLIBS))"
+ @$(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" \
+ -MExtUtils::Mkbootstrap \
+ -e "Mkbootstrap('$(BASEEXT)','$(BSLOADLIBS)');"
+ @$(TOUCH) $(BOOTSTRAP)
+ $(CHMOD) $(PERM_RW) $@
+
+$(INST_BOOT): $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists
+ @rm -rf $(INST_BOOT)
+ -cp $(BOOTSTRAP) $(INST_BOOT)
+ $(CHMOD) $(PERM_RW) $@
+
+
+# --- MakeMaker dynamic_lib section:
+
+# This section creates the dynamically loadable $(INST_DYNAMIC)
+# from $(OBJECT) and possibly $(MYEXTLIB).
+ARMAYBE = :
+OTHERLDFLAGS =
+INST_DYNAMIC_DEP =
+
+$(INST_DYNAMIC): $(OBJECT) $(MYEXTLIB) $(BOOTSTRAP) $(INST_ARCHAUTODIR)/.exists $(EXPORT_LIST) $(PERL_ARCHIVE) $(INST_DYNAMIC_DEP)
+ LD_RUN_PATH="$(LD_RUN_PATH)" $(LD) -o $@ $(LDDLFLAGS) $(LDFROM) $(OTHERLDFLAGS) $(MYEXTLIB) $(PERL_ARCHIVE) $(LDLOADLIBS) $(EXPORT_LIST)
+ $(CHMOD) $(PERM_RWX) $@
+
+
+# --- MakeMaker static section:
+
+## $(INST_PM) has been moved to the all: target.
+## It remains here for awhile to allow for old usage: "make static"
+#static :: Makefile $(INST_STATIC) $(INST_PM)
+static :: Makefile $(INST_STATIC)
+ @$(NOOP)
+
+
+# --- MakeMaker static_lib section:
+
+$(INST_STATIC): $(OBJECT) $(MYEXTLIB) $(INST_ARCHAUTODIR)/.exists
+ $(RM_RF) $@
+ $(AR) $(AR_STATIC_ARGS) $@ $(OBJECT) && $(RANLIB) $@
+ $(CHMOD) $(PERM_RWX) $@
+ @echo "$(EXTRALIBS)" > $(INST_ARCHAUTODIR)/extralibs.ld
+
+
+
+# --- MakeMaker manifypods section:
+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";' \
+-e 'system(qq[$$^X ].q["-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" $(POD2MAN_EXE) ].qq[$$_>$$m{$$_}])==0 or warn "Couldn\047t install $$m{$$_}\n";' \
+-e 'chmod(oct($(PERM_RW))), $$m{$$_} or warn "chmod $(PERM_RW) $$m{$$_}: $$!\n";}'
+
+manifypods : pure_all SimpleServer.pm
+ @$(POD2MAN) \
+ SimpleServer.pm \
+ $(INST_MAN3DIR)/Net::Z3950::SimpleServer.$(MAN3EXT)
+
+# --- MakeMaker processPL section:
+
+
+# --- MakeMaker installbin section:
+
+
+# --- MakeMaker subdirs section:
+
+# none
+
+# --- MakeMaker clean section:
+
+# Delete temporary files but do not touch installed files. We don't delete
+# 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 so_locations pm_to_blib *~ */*~ */*/*~ *$(OBJ_EXT) *$(LIB_EXT) perl.exe $(BOOTSTRAP) $(BASEEXT).bso $(BASEEXT).def $(BASEEXT).exp
+ -mv Makefile Makefile.old $(DEV_NULL)
+
+
+# --- MakeMaker realclean section:
+
+# Delete temporary files (via clean) and also delete installed files
+realclean purge :: clean
+ rm -rf $(INST_AUTODIR) $(INST_ARCHAUTODIR)
+ rm -f $(INST_DYNAMIC) $(INST_BOOT)
+ rm -f $(INST_STATIC)
+ rm -f $(INST_LIBDIR)/SimpleServer.pm $(INST_LIBDIR)/ztest.pl $(INST_LIBDIR)/OID.pm
+ rm -rf Makefile Makefile.old
+
+
+# --- MakeMaker dist_basics section:
+
+distclean :: realclean distcheck
+
+distcheck :
+ $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=fullcheck \
+ -e fullcheck
+
+skipcheck :
+ $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=skipcheck \
+ -e skipcheck
+
+manifest :
+ $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=mkmanifest \
+ -e mkmanifest
+
+
+# --- MakeMaker dist_core section:
+
+dist : $(DIST_DEFAULT)
+ @$(PERL) -le 'print "Warning: Makefile possibly out of date with $$vf" if ' \
+ -e '-e ($$vf="$(VERSION_FROM)") and -M $$vf < -M "Makefile";'
+
+tardist : $(DISTVNAME).tar$(SUFFIX)
+
+zipdist : $(DISTVNAME).zip
+
+$(DISTVNAME).tar$(SUFFIX) : distdir
+ $(PREOP)
+ $(TO_UNIX)
+ $(TAR) $(TARFLAGS) $(DISTVNAME).tar $(DISTVNAME)
+ $(RM_RF) $(DISTVNAME)
+ $(COMPRESS) $(DISTVNAME).tar
+ $(POSTOP)
+
+$(DISTVNAME).zip : distdir
+ $(PREOP)
+ $(ZIP) $(ZIPFLAGS) $(DISTVNAME).zip $(DISTVNAME)
+ $(RM_RF) $(DISTVNAME)
+ $(POSTOP)
+
+uutardist : $(DISTVNAME).tar$(SUFFIX)
+ uuencode $(DISTVNAME).tar$(SUFFIX) \
+ $(DISTVNAME).tar$(SUFFIX) > \
+ $(DISTVNAME).tar$(SUFFIX)_uu
+
+shdist : distdir
+ $(PREOP)
+ $(SHAR) $(DISTVNAME) > $(DISTVNAME).shar
+ $(RM_RF) $(DISTVNAME)
+ $(POSTOP)
+
+
+# --- MakeMaker dist_dir section:
+
+distdir :
+ $(RM_RF) $(DISTVNAME)
+ $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=manicopy,maniread \
+ -e "manicopy(maniread(),'$(DISTVNAME)', '$(DIST_CP)');"
+
+
+# --- MakeMaker dist_test section:
+
+disttest : distdir
+ cd $(DISTVNAME) && $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) Makefile.PL
+ cd $(DISTVNAME) && $(MAKE)
+ cd $(DISTVNAME) && $(MAKE) test
+
+
+# --- MakeMaker dist_ci section:
+
+ci :
+ $(PERL) -I$(PERL_ARCHLIB) -I$(PERL_LIB) -MExtUtils::Manifest=maniread \
+ -e "@all = keys %{ maniread() };" \
+ -e 'print("Executing $(CI) @all\n"); system("$(CI) @all");' \
+ -e 'print("Executing $(RCS_LABEL) ...\n"); system("$(RCS_LABEL) @all");'
+
+
+# --- MakeMaker install section:
+
+install :: all pure_install doc_install
+
+install_perl :: all pure_perl_install doc_perl_install
+
+install_site :: all pure_site_install doc_site_install
+
+install_ :: install_site
+ @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+
+pure_install :: pure_$(INSTALLDIRS)_install
+
+doc_install :: doc_$(INSTALLDIRS)_install
+ @echo Appending installation info to $(INSTALLARCHLIB)/perllocal.pod
+
+pure__install : pure_site_install
+ @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+
+doc__install : doc_site_install
+ @echo INSTALLDIRS not defined, defaulting to INSTALLDIRS=site
+
+pure_perl_install ::
+ @$(MOD_INSTALL) \
+ read $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist \
+ write $(INSTALLARCHLIB)/auto/$(FULLEXT)/.packlist \
+ $(INST_LIB) $(INSTALLPRIVLIB) \
+ $(INST_ARCHLIB) $(INSTALLARCHLIB) \
+ $(INST_BIN) $(INSTALLBIN) \
+ $(INST_SCRIPT) $(INSTALLSCRIPT) \
+ $(INST_MAN1DIR) $(INSTALLMAN1DIR) \
+ $(INST_MAN3DIR) $(INSTALLMAN3DIR)
+ @$(WARN_IF_OLD_PACKLIST) \
+ $(SITEARCHEXP)/auto/$(FULLEXT)
+
+
+pure_site_install ::
+ @$(MOD_INSTALL) \
+ read $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist \
+ write $(INSTALLSITEARCH)/auto/$(FULLEXT)/.packlist \
+ $(INST_LIB) $(INSTALLSITELIB) \
+ $(INST_ARCHLIB) $(INSTALLSITEARCH) \
+ $(INST_BIN) $(INSTALLBIN) \
+ $(INST_SCRIPT) $(INSTALLSCRIPT) \
+ $(INST_MAN1DIR) $(INSTALLMAN1DIR) \
+ $(INST_MAN3DIR) $(INSTALLMAN3DIR)
+ @$(WARN_IF_OLD_PACKLIST) \
+ $(PERL_ARCHLIB)/auto/$(FULLEXT)
+
+doc_perl_install ::
+ -@$(DOC_INSTALL) \
+ "Module" "$(NAME)" \
+ "installed into" "$(INSTALLPRIVLIB)" \
+ LINKTYPE "$(LINKTYPE)" \
+ VERSION "$(VERSION)" \
+ EXE_FILES "$(EXE_FILES)" \
+ >> $(INSTALLARCHLIB)/perllocal.pod
+
+doc_site_install ::
+ -@$(DOC_INSTALL) \
+ "Module" "$(NAME)" \
+ "installed into" "$(INSTALLSITELIB)" \
+ LINKTYPE "$(LINKTYPE)" \
+ VERSION "$(VERSION)" \
+ EXE_FILES "$(EXE_FILES)" \
+ >> $(INSTALLARCHLIB)/perllocal.pod
+
+
+uninstall :: uninstall_from_$(INSTALLDIRS)dirs
+
+uninstall_from_perldirs ::
+ @$(UNINSTALL) $(PERL_ARCHLIB)/auto/$(FULLEXT)/.packlist
+
+uninstall_from_sitedirs ::
+ @$(UNINSTALL) $(SITEARCHEXP)/auto/$(FULLEXT)/.packlist
+
+
+# --- MakeMaker force section:
+# Phony target to force checking subdirectories.
+FORCE:
+ @$(NOOP)
+
+
+# --- MakeMaker perldepend section:
+
+PERL_HDRS = \
+$(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)
+
+SimpleServer.c : $(XSUBPPDEPS)
+
+
+# --- MakeMaker makefile section:
+
+$(OBJECT) : $(FIRST_MAKEFILE)
+
+# We take a very conservative approach here, but it\'s worth it.
+# We move Makefile to Makefile.old here to avoid gnu make looping.
+Makefile : Makefile.PL $(CONFIGDEP)
+ @echo "Makefile out-of-date with respect to $?"
+ @echo "Cleaning current config before rebuilding Makefile..."
+ -@$(RM_F) Makefile.old
+ -@$(MV) Makefile Makefile.old
+ -$(MAKE) -f Makefile.old clean $(DEV_NULL) || $(NOOP)
+ $(PERL) "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" Makefile.PL
+ @echo "==> Your Makefile has been rebuilt. <=="
+ @echo "==> Please rerun the make command. <=="
+ false
+
+# To change behavior to :: would be nice, but would break Tk b9.02
+# so you find such a warning below the dist target.
+#Makefile :: $(VERSION_FROM)
+# @echo "Warning: Makefile possibly out of date with $(VERSION_FROM)"
+
+
+# --- MakeMaker staticmake section:
+
+# --- MakeMaker makeaperl section ---
+MAP_TARGET = perl
+FULLPERL = /usr/bin/perl
+
+$(MAP_TARGET) :: static $(MAKE_APERL_FILE)
+ $(MAKE) -f $(MAKE_APERL_FILE) $@
+
+$(MAKE_APERL_FILE) : $(FIRST_MAKEFILE)
+ @echo Writing \"$(MAKE_APERL_FILE)\" for this $(MAP_TARGET)
+ @$(PERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) \
+ Makefile.PL DIR= \
+ MAKEFILE=$(MAKE_APERL_FILE) LINKTYPE=static \
+ MAKEAPERL=1 NORECURS=1 CCCDLFLAGS=
+
+
+# --- MakeMaker test section:
+
+TEST_VERBOSE=0
+TEST_TYPE=test_$(LINKTYPE)
+TEST_FILE = test.pl
+TEST_FILES =
+TESTDB_SW = -d
+
+testdb :: testdb_$(LINKTYPE)
+
+test :: $(TEST_TYPE)
+
+test_dynamic :: pure_all
+ PERL_DL_NONLAZY=1 $(FULLPERL) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(TEST_FILE)
+
+testdb_dynamic :: pure_all
+ PERL_DL_NONLAZY=1 $(FULLPERL) $(TESTDB_SW) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(TEST_FILE)
+
+test_ : test_dynamic
+
+test_static :: pure_all $(MAP_TARGET)
+ PERL_DL_NONLAZY=1 ./$(MAP_TARGET) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(TEST_FILE)
+
+testdb_static :: pure_all $(MAP_TARGET)
+ PERL_DL_NONLAZY=1 ./$(MAP_TARGET) $(TESTDB_SW) -I$(INST_ARCHLIB) -I$(INST_LIB) -I$(PERL_ARCHLIB) -I$(PERL_LIB) $(TEST_FILE)
+
+
+
+# --- MakeMaker ppd section:
+# Creates a PPD (Perl Package Description) for a binary distribution.
+ppd:
+ @$(PERL) -e "print qq{<SOFTPKG NAME=\"Net-Z3950-SimpleServer\" VERSION=\"0,02,0,0\">\n}. qq{\t<TITLE>Net-Z3950-SimpleServer</TITLE>\n}. qq{\t<ABSTRACT></ABSTRACT>\n}. qq{\t<AUTHOR></AUTHOR>\n}. qq{\t<IMPLEMENTATION>\n}. qq{\t\t<OS NAME=\"$(OSNAME)\" />\n}. qq{\t\t<ARCHITECTURE NAME=\"i386-linux\" />\n}. qq{\t\t<CODEBASE HREF=\"\" />\n}. qq{\t</IMPLEMENTATION>\n}. qq{</SOFTPKG>\n}" > Net-Z3950-SimpleServer.ppd
+
+# --- MakeMaker pm_to_blib section:
+
+pm_to_blib: $(TO_INST_PM)
+ @$(PERL) "-I$(INST_ARCHLIB)" "-I$(INST_LIB)" \
+ "-I$(PERL_ARCHLIB)" "-I$(PERL_LIB)" -MExtUtils::Install \
+ -e "pm_to_blib({qw{$(PM_TO_BLIB)}},'$(INST_LIB)/auto')"
+ @$(TOUCH) $@
+
+
+# --- MakeMaker selfdocument section:
+
+
+# --- MakeMaker postamble section:
+
+
+# End.
--- /dev/null
+use ExtUtils::MakeMaker;
+# See lib/ExtUtils/MakeMaker.pm for details of how to influence
+# the contents of the Makefile that is written.
+
+my $libs = `yaz-config --libs` || die "ERROR: Unable to call script: yaz-config";
+
+WriteMakefile(
+ 'NAME' => 'Net::Z3950::SimpleServer',
+ 'VERSION_FROM' => 'SimpleServer.pm', # finds $VERSION
+ 'LIBS' => [$libs], # e.g., '-lm'
+ 'DEFINE' => '', # e.g., '-DHAVE_SOMETHING'
+ 'INC' => '', # e.g., '-I/usr/include/other'
+);
--- /dev/null
+package Net::Z3950::OID;
+
+my $prefix = "1.2.840.10003.5.";
+
+sub unimarc { $prefix . '1' }
+sub intermarc { $prefix . '2' }
+sub ccf { $prefix . '3' }
+sub usmarc { $prefix . '10' }
+sub ukmarc { $prefix . '11' }
+sub normarc { $prefix . '12' }
+sub librismarc { $prefix . '13' }
+sub danmarc { $prefix . '14' }
+sub finmarc { $prefix . '15' }
+sub mab { $prefix . '16' }
+sub canmarc { $prefix . '17' }
+sub sbn { $prefix . '18' }
+sub picamarc { $prefix . '19' }
+sub ausmarc { $prefix . '20' }
+sub ibermarc { $prefix . '21' }
+sub carmarc { $prefix . '22' }
+sub malmarc { $prefix . '23' }
+sub jpmarc { $prefix . '24' }
+sub swemarc { $prefix . '25' }
+sub siglemarc { $prefix . '26' }
+sub isdsmarc { $prefix . '27' }
+sub rusmarc { $prefix . '28' }
+sub explain { $prefix . '100' }
+sub sutrs { $prefix . '101' }
+sub opac { $prefix . '102' }
+sub summary { $prefix . '103' }
+sub grs0 { $prefix . '104' }
+sub grs1 { $prefix . '105' }
+sub extended { $prefix . '106' }
+sub fragment { $prefix . '107' }
+sub pdf { $prefix . '109.1' }
+sub postscript { $prefix . '109.2' }
+sub html { $prefix . '109.3' }
+sub tiff { $prefix . '109.4' }
+sub gif { $prefix . '109.5' }
+sub jpeg { $prefix . '109.6' }
+sub png { $prefix . '109.7' }
+sub mpeg { $prefix . '109.8' }
+sub sgml { $prefix . '109.9' }
+sub tiffb { $prefix . '110.1' }
+sub wav { $prefix . '110.2' }
+sub sqlrs { $prefix . '111' }
+sub soif { $prefix . '1000.81.2' }
+sub textxml { $prefix . '109.10' }
+sub xml { $prefix . '109.10' }
+sub appxml { $prefix . '109.11' }
+
+
--- /dev/null
+/*
+ * This file was generated automatically by xsubpp version 1.9507 from the
+ * contents of SimpleServer.xs. Do not edit this file, edit SimpleServer.xs instead.
+ *
+ * ANY CHANGES MADE HERE WILL BE LOST!
+ *
+ */
+
+#line 1 "SimpleServer.xs"
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include <yaz/backend.h>
+#include <yaz/log.h>
+#include <yaz/wrbuf.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <ctype.h>
+#ifdef ASN_COMPILED
+#include <yaz/ill.h>
+#endif
+
+
+typedef struct {
+ SV *handle;
+
+ SV *init_ref;
+ SV *close_ref;
+ SV *sort_ref;
+ SV *search_ref;
+ SV *fetch_ref;
+ SV *present_ref;
+ SV *esrequest_ref;
+ SV *delete_ref;
+ SV *scan_ref;
+} Zfront_handle;
+
+SV *init_ref = NULL;
+SV *close_ref = NULL;
+SV *sort_ref = NULL;
+SV *search_ref = NULL;
+SV *fetch_ref = NULL;
+SV *present_ref = NULL;
+SV *esrequest_ref = NULL;
+SV *delete_ref = NULL;
+SV *scan_ref = NULL;
+int MAX_OID = 15;
+
+static void oid2str(Odr_oid *o, WRBUF buf)
+{
+ for (; *o >= 0; o++) {
+ char ibuf[16];
+ sprintf(ibuf, "%d", *o);
+ wrbuf_puts(buf, ibuf);
+ if (o[1] > 0)
+ wrbuf_putc(buf, '.');
+ }
+}
+
+
+static int rpn2pquery(Z_RPNStructure *s, WRBUF buf)
+{
+ switch (s->which) {
+ case Z_RPNStructure_simple: {
+ Z_Operand *o = s->u.simple;
+
+ switch (o->which) {
+ case Z_Operand_APT: {
+ Z_AttributesPlusTerm *at = o->u.attributesPlusTerm;
+
+ if (at->attributes) {
+ int i;
+ char ibuf[16];
+
+ for (i = 0; i < at->attributes->num_attributes; i++) {
+ wrbuf_puts(buf, "@attr ");
+ if (at->attributes->attributes[i]->attributeSet) {
+ oid2str(at->attributes->attributes[i]->attributeSet, buf);
+ wrbuf_putc(buf, ' ');
+ }
+ sprintf(ibuf, "%d=", *at->attributes->attributes[i]->attributeType);
+ assert(at->attributes->attributes[i]->which == Z_AttributeValue_numeric);
+ wrbuf_puts(buf, ibuf);
+ sprintf(ibuf, "%d ", *at->attributes->attributes[i]->value.numeric);
+ wrbuf_puts(buf, ibuf);
+ }
+ }
+ switch (at->term->which) {
+ case Z_Term_general: {
+ wrbuf_putc(buf, '"');
+ wrbuf_write(buf, (char*) at->term->u.general->buf, at->term->u.general->len);
+ wrbuf_puts(buf, "\" ");
+ break;
+ }
+ default: abort();
+ }
+ break;
+ }
+ default: abort();
+ }
+ break;
+ }
+ case Z_RPNStructure_complex: {
+ Z_Complex *c = s->u.complex;
+
+ switch (c->roperator->which) {
+ case Z_Operator_and: wrbuf_puts(buf, "@and "); break;
+ case Z_Operator_or: wrbuf_puts(buf, "@or "); break;
+ case Z_Operator_and_not: wrbuf_puts(buf, "@not "); break;
+ case Z_Operator_prox: abort();
+ default: abort();
+ }
+ if (!rpn2pquery(c->s1, buf))
+ return 0;
+ if (!rpn2pquery(c->s2, buf))
+ return 0;
+ break;
+ }
+ default: abort();
+ }
+ return 1;
+}
+
+
+WRBUF zquery2pquery(Z_Query *q)
+{
+ WRBUF buf = wrbuf_alloc();
+
+ if (q->which != Z_Query_type_1 && q->which != Z_Query_type_101)
+ return 0;
+ if (q->u.type_1->attributeSetId) {
+ /* Output attribute set ID */
+ wrbuf_puts(buf, "@attrset ");
+ oid2str(q->u.type_1->attributeSetId, buf);
+ wrbuf_putc(buf, ' ');
+ }
+ return rpn2pquery(q->u.type_1->RPNStructure, buf) ? buf : 0;
+}
+
+
+int bend_sort(void *handle, bend_sort_rr *rr)
+{
+ perl_call_sv(sort_ref, G_VOID | G_DISCARD | G_NOARGS);
+ return;
+}
+
+
+int bend_search(void *handle, bend_search_rr *rr)
+{
+ HV *href;
+ AV *aref;
+ SV **temp;
+ SV *hits;
+ SV *err_code;
+ SV *err_str;
+ char *ODR_errstr;
+ STRLEN len;
+ int i;
+ char **basenames;
+ int n;
+ WRBUF query;
+ char *ptr;
+ SV *point;
+ SV *ODR_point;
+ Zfront_handle *zhandle = (Zfront_handle *)handle;
+
+ dSP;
+ ENTER;
+ SAVETMPS;
+
+ aref = newAV();
+ basenames = rr->basenames;
+ for (i = 0; i < rr->num_bases; i++)
+ {
+ av_push(aref, newSVpv(*basenames++, 0));
+ }
+ href = newHV();
+ hv_store(href, "SETNAME", 7, newSVpv(rr->setname, 0), 0);
+ hv_store(href, "REPL_SET", 8, newSViv(rr->replace_set), 0);
+ hv_store(href, "ERR_CODE", 8, newSViv(0), 0);
+ hv_store(href, "ERR_STR", 7, newSVpv("", 0), 0);
+ hv_store(href, "HITS", 4, newSViv(0), 0);
+ hv_store(href, "DATABASES", 9, newRV( (SV*) aref), 0);
+ hv_store(href, "HANDLE", 6, zhandle->handle, 0);
+ query = zquery2pquery(rr->query);
+ if (query)
+ {
+ hv_store(href, "QUERY", 5, newSVpv((char *)query->buf, query->pos), 0);
+ }
+ else
+ {
+ rr->errcode = 108;
+ }
+ PUSHMARK(sp);
+
+ XPUSHs(sv_2mortal(newRV( (SV*) href)));
+
+ PUTBACK;
+
+ n = perl_call_sv(search_ref, G_SCALAR | G_DISCARD);
+
+ SPAGAIN;
+
+ temp = hv_fetch(href, "HITS", 4, 1);
+ hits = newSVsv(*temp);
+
+ 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);
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+
+ hv_undef(href);
+ av_undef(aref);
+ rr->hits = SvIV(hits);
+ rr->errcode = SvIV(err_code);
+ ptr = SvPV(err_str, len);
+ ODR_errstr = (char *)odr_malloc(rr->stream, len + 1);
+ strcpy(ODR_errstr, ptr);
+ rr->errstring = ODR_errstr;
+/* ODR_point = (SV *)odr_malloc(rr->stream, sizeof(*point));
+ memcpy(ODR_point, point, sizeof(*point));
+ zhandle->handle = ODR_point;*/
+ zhandle->handle = point;
+ handle = zhandle;
+ sv_free(hits);
+ sv_free(err_code);
+ sv_free(err_str);
+ sv_free( (SV*) aref);
+ sv_free( (SV*) href);
+ /*sv_free(point);*/
+ wrbuf_free(query, 1);
+ return 0;
+}
+
+
+WRBUF oid2dotted(int *oid)
+{
+
+ WRBUF buf = wrbuf_alloc();
+ int dot = 0;
+
+ for (; *oid != -1 ; oid++)
+ {
+ char ibuf[16];
+ if (dot)
+ {
+ wrbuf_putc(buf, '.');
+ }
+ else
+ {
+ dot = 1;
+ }
+ sprintf(ibuf, "%d", *oid);
+ wrbuf_puts(buf, ibuf);
+ }
+ return buf;
+}
+
+
+int dotted2oid(char *dotted, int *buffer)
+{
+ int *oid;
+ char ibuf[16];
+ char *ptr;
+ int n = 0;
+
+ ptr = ibuf;
+ oid = buffer;
+ while (*dotted)
+ {
+ if (*dotted == '.')
+ {
+ n++;
+ if (n == MAX_OID) /* Terminate if more than MAX_OID entries */
+ {
+ *oid = -1;
+ return -1;
+ }
+ *ptr = 0;
+ sscanf(ibuf, "%d", oid++);
+ ptr = ibuf;
+ dotted++;
+
+ }
+ else
+ {
+ *ptr++ = *dotted++;
+ }
+ }
+ if (n < MAX_OID)
+ {
+ *ptr = 0;
+ sscanf(ibuf, "%d", oid++);
+ }
+ *oid = -1;
+ return 0;
+}
+
+
+int bend_fetch(void *handle, bend_fetch_rr *rr)
+{
+ HV *href;
+ SV **temp;
+ SV *basename;
+ SV *len;
+ SV *record;
+ SV *last;
+ SV *err_code;
+ SV *err_string;
+ SV *sur_flag;
+ SV *point;
+ SV *rep_form;
+ char *ptr;
+ char *ODR_record;
+ char *ODR_basename;
+ char *ODR_errstr;
+ int *ODR_oid_buf;
+ WRBUF oid_dotted;
+ Zfront_handle *zhandle = (Zfront_handle *)handle;
+
+ Z_RecordComposition *composition;
+ Z_ElementSetNames *simple;
+ STRLEN length;
+ int oid;
+
+ dSP;
+ ENTER;
+ SAVETMPS;
+
+ rr->errcode = 0;
+ href = newHV();
+ hv_store(href, "SETNAME", 7, newSVpv(rr->setname, 0), 0);
+ temp = hv_store(href, "OFFSET", 6, newSViv(rr->number), 0);
+ oid_dotted = oid2dotted(rr->request_format_raw);
+ hv_store(href, "REQ_FORM", 8, newSVpv((char *)oid_dotted->buf, oid_dotted->pos), 0);
+ hv_store(href, "REP_FORM", 8, newSVpv((char *)oid_dotted->buf, oid_dotted->pos), 0);
+ hv_store(href, "BASENAME", 8, newSVpv("", 0), 0);
+ hv_store(href, "LEN", 3, newSViv(0), 0);
+ hv_store(href, "RECORD", 6, newSVpv("", 0), 0);
+ hv_store(href, "LAST", 4, newSViv(0), 0);
+ hv_store(href, "ERR_CODE", 8, newSViv(0), 0);
+ hv_store(href, "ERR_STR", 7, newSVpv("", 0), 0);
+ hv_store(href, "SUR_FLAG", 8, newSViv(0), 0);
+ hv_store(href, "HANDLE", 6, zhandle->handle, 0);
+ if (rr->comp)
+ {
+ composition = rr->comp;
+ if (composition->which == 1)
+ {
+ simple = composition->u.simple;
+ if (simple->which == 1)
+ {
+ hv_store(href, "COMP", 4, newSVpv(simple->u.generic, 0), 0);
+ }
+ else
+ {
+ rr->errcode = 26;
+ }
+ }
+ else
+ {
+ rr->errcode = 26;
+ }
+ }
+
+ PUSHMARK(sp);
+
+ XPUSHs(sv_2mortal(newRV( (SV*) href)));
+
+ PUTBACK;
+
+ perl_call_sv(fetch_ref, G_SCALAR | G_DISCARD);
+
+ SPAGAIN;
+
+ temp = hv_fetch(href, "BASENAME", 8, 1);
+ basename = newSVsv(*temp);
+
+ temp = hv_fetch(href, "LEN", 3, 1);
+ len = newSVsv(*temp);
+
+ temp = hv_fetch(href, "RECORD", 6, 1);
+ record = newSVsv(*temp);
+
+ temp = hv_fetch(href, "LAST", 4, 1);
+ last = newSVsv(*temp);
+
+ temp = hv_fetch(href, "ERR_CODE", 8, 1);
+ err_code = newSVsv(*temp);
+
+ temp = hv_fetch(href, "ERR_STR", 7, 1),
+ err_string = newSVsv(*temp);
+
+ temp = hv_fetch(href, "SUR_FLAG", 8, 1);
+ sur_flag = newSVsv(*temp);
+
+ temp = hv_fetch(href, "REP_FORM", 8, 1);
+ rep_form = newSVsv(*temp);
+
+ temp = hv_fetch(href, "HANDLE", 6, 1);
+ point = newSVsv(*temp);
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+
+ hv_undef(href);
+
+ ptr = SvPV(basename, length);
+ ODR_basename = (char *)odr_malloc(rr->stream, length + 1);
+ strcpy(ODR_basename, ptr);
+ rr->basename = ODR_basename;
+
+ ptr = SvPV(rep_form, length);
+ ODR_oid_buf = (int *)odr_malloc(rr->stream, (MAX_OID + 1) * sizeof(int));
+ if (dotted2oid(ptr, ODR_oid_buf) == -1) /* Maximum number of OID elements exceeded */
+ {
+ printf("Net::Z3950::SimpleServer: WARNING: OID structure too long, max length is %d\n", MAX_OID);
+ }
+ rr->output_format_raw = ODR_oid_buf;
+
+ rr->len = SvIV(len);
+
+ ptr = SvPV(record, length);
+ ODR_record = (char *)odr_malloc(rr->stream, length + 1);
+ strcpy(ODR_record, ptr);
+ rr->record = ODR_record;
+
+ zhandle->handle = point;
+ handle = zhandle;
+ rr->last_in_set = SvIV(last);
+
+ if (!(rr->errcode))
+ {
+ rr->errcode = SvIV(err_code);
+ ptr = SvPV(err_string, length);
+ ODR_errstr = (char *)odr_malloc(rr->stream, length + 1);
+ strcpy(ODR_errstr, ptr);
+ rr->errstring = ODR_errstr;
+ }
+ rr->surrogate_flag = SvIV(sur_flag);
+
+ /*sv_free(point);*/
+ wrbuf_free(oid_dotted, 1);
+ sv_free((SV*) href);
+ sv_free(basename);
+ sv_free(len);
+ sv_free(record);
+ sv_free(last);
+ sv_free(err_string);
+ sv_free(err_code),
+ sv_free(sur_flag);
+ sv_free(rep_form);
+
+ return 0;
+}
+
+
+int bend_present(void *handle, bend_present_rr *rr)
+{
+
+ int n;
+ HV *href;
+ SV **temp;
+ SV *err_code;
+ SV *err_string;
+ STRLEN len;
+ Z_RecordComposition *composition;
+ Z_ElementSetNames *simple;
+ char *ODR_errstr;
+ char *ptr;
+
+ dSP;
+ ENTER;
+ SAVETMPS;
+
+ href = newHV();
+ hv_store(href, "ERR_CODE", 8, newSViv(0), 0);
+ hv_store(href, "ERR_STR", 7, newSVpv("", 0), 0);
+ hv_store(href, "START", 5, newSViv(rr->start), 0);
+ hv_store(href, "SETNAME", 7, newSVpv(rr->setname, 0), 0);
+ hv_store(href, "NUMBER", 6, newSViv(rr->number), 0);
+ if (rr->comp)
+ {
+ composition = rr->comp;
+ if (composition->which == 1)
+ {
+ simple = composition->u.simple;
+ if (simple->which == 1)
+ {
+ hv_store(href, "COMP", 4, newSVpv(simple->u.generic, 0), 0);
+ }
+ else
+ {
+ rr->errcode = 26;
+ return 0;
+ }
+ }
+ else
+ {
+ rr->errcode = 26;
+ return 0;
+ }
+ }
+
+ PUSHMARK(sp);
+
+ XPUSHs(sv_2mortal(newRV( (SV*) href)));
+
+ PUTBACK;
+
+ n = perl_call_sv(present_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_string = newSVsv(*temp);
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+
+ hv_undef(href);
+ rr->errcode = SvIV(err_code);
+
+ ptr = SvPV(err_string, len);
+ ODR_errstr = (char *)odr_malloc(rr->stream, len + 1);
+ strcpy(ODR_errstr, ptr);
+ rr->errstring = ODR_errstr;
+
+ sv_free(err_code);
+ sv_free(err_string);
+ sv_free( (SV*) href);
+
+ return 0;
+}
+
+
+int bend_esrequest(void *handle, bend_esrequest_rr *rr)
+{
+ perl_call_sv(esrequest_ref, G_VOID | G_DISCARD | G_NOARGS);
+ return 0;
+}
+
+
+int bend_delete(void *handle, bend_delete_rr *rr)
+{
+ perl_call_sv(delete_ref, G_VOID | G_DISCARD | G_NOARGS);
+ return 0;
+}
+
+
+int bend_scan(void *handle, bend_scan_rr *rr)
+{
+ perl_call_sv(scan_ref, G_VOID | G_DISCARD | G_NOARGS);
+ return 0;
+}
+
+
+bend_initresult *bend_init(bend_initrequest *q)
+{
+ bend_initresult *r = (bend_initresult *) odr_malloc (q->stream, sizeof(*r));
+ HV *href;
+ SV **temp;
+ SV *name;
+ SV *ver;
+ SV *err_str;
+ SV *status;
+ Zfront_handle *zhandle = (Zfront_handle *) xmalloc (sizeof(*zhandle));
+ STRLEN len;
+ int n;
+ SV *handle;
+ /*char *name_ptr;
+ char *ver_ptr;*/
+ char *ptr;
+
+ dSP;
+ ENTER;
+ SAVETMPS;
+
+ /*q->bend_sort = bend_sort;*/
+ if (search_ref)
+ {
+ q->bend_search = bend_search;
+ }
+ /*q->bend_present = present;*/
+ /*q->bend_esrequest = bend_esrequest;*/
+ /*q->bend_delete = bend_delete;*/
+ if (fetch_ref)
+ {
+ q->bend_fetch = bend_fetch;
+ }
+ /*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);
+ hv_store(href, "ERR_CODE", 8, newSViv(0), 0);
+ hv_store(href, "HANDLE", 6, newSVsv(&sv_undef), 0);
+
+ PUSHMARK(sp);
+
+ XPUSHs(sv_2mortal(newRV( (SV*) href)));
+
+ PUTBACK;
+
+ if (init_ref != NULL)
+ {
+ perl_call_sv(init_ref, G_SCALAR | G_DISCARD);
+ }
+
+ SPAGAIN;
+
+ temp = hv_fetch(href, "IMP_NAME", 8, 1);
+ name = newSVsv(*temp);
+
+ temp = hv_fetch(href, "IMP_VER", 7, 1);
+ ver = newSVsv(*temp);
+
+ temp = hv_fetch(href, "ERR_CODE", 8, 1);
+ status = newSVsv(*temp);
+
+ temp = hv_fetch(href, "HANDLE", 6, 1);
+ handle= newSVsv(*temp);
+
+ hv_undef(href);
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+ zhandle->handle = handle;
+ r->errcode = SvIV(status);
+ r->handle = zhandle;
+ ptr = SvPV(name, len);
+ q->implementation_name = (char *)xmalloc(len + 1);
+ strcpy(q->implementation_name, ptr);
+/* q->implementation_name = SvPV(name, len);*/
+ ptr = SvPV(ver, len);
+ q->implementation_version = (char *)xmalloc(len + 1);
+ strcpy(q->implementation_version, ptr);
+
+ return r;
+}
+
+
+void bend_close(void *handle)
+{
+ HV *href;
+ Zfront_handle *zhandle = (Zfront_handle *)handle;
+ SV **temp;
+
+ dSP;
+ ENTER;
+ SAVETMPS;
+
+ if (close_ref == NULL)
+ {
+ return;
+ }
+
+ href = newHV();
+ hv_store(href, "HANDLE", 6, zhandle->handle, 0);
+
+ PUSHMARK(sp);
+
+ XPUSHs(sv_2mortal(newRV((SV *)href)));
+
+ PUTBACK;
+
+ perl_call_sv(close_ref, G_SCALAR | G_DISCARD);
+
+ SPAGAIN;
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+
+ xfree(handle);
+
+ return;
+}
+
+
+#line 694 "SimpleServer.c"
+XS(XS_Net__Z3950__SimpleServer_set_init_handler)
+{
+ dXSARGS;
+ if (items != 1)
+ croak("Usage: Net::Z3950::SimpleServer::set_init_handler(arg)");
+ {
+ SV * arg = ST(0);
+#line 690 "SimpleServer.xs"
+ init_ref = newSVsv(arg);
+#line 704 "SimpleServer.c"
+ }
+ XSRETURN_EMPTY;
+}
+
+XS(XS_Net__Z3950__SimpleServer_set_close_handler)
+{
+ dXSARGS;
+ if (items != 1)
+ croak("Usage: Net::Z3950::SimpleServer::set_close_handler(arg)");
+ {
+ SV * arg = ST(0);
+#line 697 "SimpleServer.xs"
+ close_ref = newSVsv(arg);
+#line 718 "SimpleServer.c"
+ }
+ XSRETURN_EMPTY;
+}
+
+XS(XS_Net__Z3950__SimpleServer_set_sort_handler)
+{
+ dXSARGS;
+ if (items != 1)
+ croak("Usage: Net::Z3950::SimpleServer::set_sort_handler(arg)");
+ {
+ SV * arg = ST(0);
+#line 704 "SimpleServer.xs"
+ sort_ref = newSVsv(arg);
+#line 732 "SimpleServer.c"
+ }
+ XSRETURN_EMPTY;
+}
+
+XS(XS_Net__Z3950__SimpleServer_set_search_handler)
+{
+ dXSARGS;
+ if (items != 1)
+ croak("Usage: Net::Z3950::SimpleServer::set_search_handler(arg)");
+ {
+ SV * arg = ST(0);
+#line 710 "SimpleServer.xs"
+ search_ref = newSVsv(arg);
+#line 746 "SimpleServer.c"
+ }
+ XSRETURN_EMPTY;
+}
+
+XS(XS_Net__Z3950__SimpleServer_set_fetch_handler)
+{
+ dXSARGS;
+ if (items != 1)
+ croak("Usage: Net::Z3950::SimpleServer::set_fetch_handler(arg)");
+ {
+ SV * arg = ST(0);
+#line 717 "SimpleServer.xs"
+ fetch_ref = newSVsv(arg);
+#line 760 "SimpleServer.c"
+ }
+ XSRETURN_EMPTY;
+}
+
+XS(XS_Net__Z3950__SimpleServer_set_present_handler)
+{
+ dXSARGS;
+ if (items != 1)
+ croak("Usage: Net::Z3950::SimpleServer::set_present_handler(arg)");
+ {
+ SV * arg = ST(0);
+#line 724 "SimpleServer.xs"
+ present_ref = newSVsv(arg);
+#line 774 "SimpleServer.c"
+ }
+ XSRETURN_EMPTY;
+}
+
+XS(XS_Net__Z3950__SimpleServer_set_esrequest_handler)
+{
+ dXSARGS;
+ if (items != 1)
+ croak("Usage: Net::Z3950::SimpleServer::set_esrequest_handler(arg)");
+ {
+ SV * arg = ST(0);
+#line 731 "SimpleServer.xs"
+ esrequest_ref = newSVsv(arg);
+#line 788 "SimpleServer.c"
+ }
+ XSRETURN_EMPTY;
+}
+
+XS(XS_Net__Z3950__SimpleServer_set_delete_handler)
+{
+ dXSARGS;
+ if (items != 1)
+ croak("Usage: Net::Z3950::SimpleServer::set_delete_handler(arg)");
+ {
+ SV * arg = ST(0);
+#line 738 "SimpleServer.xs"
+ delete_ref = newSVsv(arg);
+#line 802 "SimpleServer.c"
+ }
+ XSRETURN_EMPTY;
+}
+
+XS(XS_Net__Z3950__SimpleServer_set_scan_handler)
+{
+ dXSARGS;
+ if (items != 1)
+ croak("Usage: Net::Z3950::SimpleServer::set_scan_handler(arg)");
+ {
+ SV * arg = ST(0);
+#line 745 "SimpleServer.xs"
+ scan_ref = newSVsv(arg);
+#line 816 "SimpleServer.c"
+ }
+ XSRETURN_EMPTY;
+}
+
+XS(XS_Net__Z3950__SimpleServer_start_server)
+{
+ dXSARGS;
+ {
+#line 751 "SimpleServer.xs"
+ char **argv;
+ char **argv_buf;
+ char *ptr;
+ int i;
+ STRLEN len;
+#line 831 "SimpleServer.c"
+ int RETVAL;
+#line 757 "SimpleServer.xs"
+ argv_buf = (char **)xmalloc((items + 1) * sizeof(char *));
+ argv = argv_buf;
+ for (i = 0; i < items; i++)
+ {
+ ptr = SvPV(ST(i), len);
+ *argv_buf = (char *)xmalloc(len + 1);
+ strcpy(*argv_buf++, ptr);
+ }
+ *argv_buf = NULL;
+
+ RETVAL = statserv_main(items, argv, bend_init, bend_close);
+#line 845 "SimpleServer.c"
+ ST(0) = sv_newmortal();
+ sv_setiv(ST(0), (IV)RETVAL);
+ }
+ XSRETURN(1);
+}
+
+#ifdef __cplusplus
+extern "C"
+#endif
+XS(boot_Net__Z3950__SimpleServer)
+{
+ dXSARGS;
+ char* file = __FILE__;
+
+ XS_VERSION_BOOTCHECK ;
+
+ newXS("Net::Z3950::SimpleServer::set_init_handler", XS_Net__Z3950__SimpleServer_set_init_handler, file);
+ newXS("Net::Z3950::SimpleServer::set_close_handler", XS_Net__Z3950__SimpleServer_set_close_handler, file);
+ newXS("Net::Z3950::SimpleServer::set_sort_handler", XS_Net__Z3950__SimpleServer_set_sort_handler, file);
+ newXS("Net::Z3950::SimpleServer::set_search_handler", XS_Net__Z3950__SimpleServer_set_search_handler, file);
+ newXS("Net::Z3950::SimpleServer::set_fetch_handler", XS_Net__Z3950__SimpleServer_set_fetch_handler, file);
+ newXS("Net::Z3950::SimpleServer::set_present_handler", XS_Net__Z3950__SimpleServer_set_present_handler, file);
+ newXS("Net::Z3950::SimpleServer::set_esrequest_handler", XS_Net__Z3950__SimpleServer_set_esrequest_handler, file);
+ newXS("Net::Z3950::SimpleServer::set_delete_handler", XS_Net__Z3950__SimpleServer_set_delete_handler, file);
+ newXS("Net::Z3950::SimpleServer::set_scan_handler", XS_Net__Z3950__SimpleServer_set_scan_handler, file);
+ newXS("Net::Z3950::SimpleServer::start_server", XS_Net__Z3950__SimpleServer_start_server, file);
+ XSRETURN_YES;
+}
+
--- /dev/null
+package Net::Z3950::SimpleServer;
+
+use strict;
+use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);
+use Carp;
+
+require Exporter;
+require DynaLoader;
+require AutoLoader;
+
+@ISA = qw(Exporter AutoLoader DynaLoader);
+# Items to export into callers namespace by default. Note: do not export
+# names by default without a very good reason. Use EXPORT_OK instead.
+# Do not simply export all your public functions/methods/constants.
+@EXPORT = qw(
+
+);
+$VERSION = '0.02';
+
+bootstrap Net::Z3950::SimpleServer $VERSION;
+
+# Preloaded methods go here.
+
+my $count = 0;
+
+sub new {
+ my $class = shift;
+ my $args = shift || croak "SimpleServer::new: Usage new(argument hash)";
+ my $self = {};
+
+ 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};
+
+ bless $self, $class;
+ return $self;
+}
+
+
+sub launch_server {
+ my $self = shift;
+ my @args = @_;
+
+ if (defined($self->{INIT})) {
+ set_init_handler($self->{INIT});
+ }
+ set_search_handler($self->{SEARCH});
+ set_fetch_handler($self->{FETCH});
+ if (defined($self->{CLOSE})) {
+ set_close_handler($self->{CLOSE});
+ }
+
+ start_server(@args);
+}
+
+
+# Autoload methods go after =cut, and are processed by the autosplit program.
+
+1;
+__END__
+# Below is the stub of documentation for your module. You better edit it!
+
+=head1 NAME
+
+Zfront - Simple Perl API for building Z39.50 servers.
+
+=head1 SYNOPSIS
+
+ use Zfront;
+
+ sub my_search_handler {
+ my $args = shift;
+
+ my $set_id = $args->{SETNAME};
+ my @database_list = @{ $args->{DATABASES} };
+ my $query = $args->{QUERY};
+
+ ## Perform the query on the specified set of databases
+ ## and return the number of hits:
+
+ $args->{HITS} = $hits;
+ }
+
+ sub my_fetch_handler { # Get a record for the user
+ my $args = shift;
+
+ my $set_id = $args->{SETNAME};
+
+ my $record = fetch_a_record($args->{OFFSET);
+
+ $args->{RECORD} = $record;
+ $args->{LEN} = length($record);
+ if (number_of_hits() == $args->{OFFSET}) { ## Last record in set?
+ $args->{LAST} = 1;
+ } else {
+ $args->{LAST} = 0;
+ }
+ }
+
+
+ ## Register custom event handlers:
+
+ Zfront::set_search_handler(\&my_search_handler);
+ Zfront::set_fetch_handler(\&my_fetch_handler);
+
+ ## Launch server:
+
+ Zfront::start_server("mytestserver", @ARGV);
+
+=head1 DESCRIPTION
+
+The Zfront module is a tool for constructing Z39.50 "Information
+Retrieval" servers in Perl. The module is easy to use, but it
+does help to have an understanding of the Z39.50 query
+structure and the construction of structured retrieval records.
+
+Z39.50 is a network protocol for searching remote databases and
+retrieving the results in the form of structured "records". It is widely
+used in libraries around the world, as well as in the US Federal Government.
+In addition, it is generally useful whenever you wish to integrate a number
+of different database systems around a shared, asbtract data model.
+
+The model of the module is simple: It implements a "generic" Z39.50
+server, which invokes callback functions supplied by you to search
+for content in your database. You can use any tools available in
+Perl to supply the content, including modules like DBI and
+WWW::Search.
+
+The server will take care of managing the network connections for
+you, and it will spawn a new process (or thread, in some
+environments) whenever a new connection is received.
+
+The programmer can specify subroutines to take care of the following type
+of events:
+
+ - Initialize request
+ - Search request
+ - Fetching of records
+ - Closing down connection
+
+Note that only the Search and Fetch handler functions are required.
+The module can supply default responses to the other on its own.
+
+After the launching of the server, all control is given away from
+the Perl script to the server. The server calls the registered
+subroutines to field incoming requests from Z39.50 clients.
+
+A reference to an anonymous hash is passed to each handle. Some of
+the entries of these hashes are to be considered input and others
+output parameters.
+
+The Perl programmer specifies the event handles for the server by
+means of the subroutines
+
+ Zfront::set_init_handler(\&my_init_handler);
+ Zfront::set_search_handler(\&my_search_handler);
+ Zfront::set_fetch_handler(\&my_fetch_handler);
+ Zfront::set_close_handler(\&my_close_handler);
+
+After each handle is declared, the server is launched by means of
+the subroutine
+
+ Zfront::start_server($script_name, @ARGV);
+
+Notice, the first argument should be the name of your server
+script (for logging purposes), while the rest of the arguments
+are documented in the YAZ toolkit manual: The section on
+application invocation: <http://www.indexdata.dk/yaz/yaz-7.php>
+
+=head2 Init handler
+
+The init handler is called whenever a Z39.50 client is attempting
+to logon to the server. The exchange of parameters between the
+server and the handler is carried out via an anonymous hash reached
+by a reference, i.e.
+
+ $args = shift;
+
+The argument hash passed to the init handler has the form
+
+ $args = {
+ ## Response parameters:
+
+ IMP_NAME => "" ## Z39.50 Implementation name
+ IMP_VER => "" ## Z39.50 Implementation version
+ ERR_CODE => 0 ## Error code, cnf. Z39.50 manual
+ HANDLE => undef ## Handler of Perl data structure
+ };
+
+The HANDLE member can be used to store any scalar value which will then
+be provided as input to all subsequent calls (ie. for searching, record
+retrieval, etc.). A common use of the handle is to store a reference to
+a hash which may then be used to store session-specific parameters.
+If you have any session-specific information (such as a list of
+result sets or a handle to a back-end search engine of some sort),
+it is always best to store them in a private session structure -
+rather than leaving them in global variables in your script.
+
+The Implementation name and version are only really used by Z39.50
+client developers to see what kind of server they're dealing with.
+Filling these in is optional.
+
+The ERR_CODE should be left at 0 (the default value) if you wish to
+accept the connection. Any other value is interpreted as a failure
+and the client will be shown the door.
+
+=head2 Search handler
+
+Similarly, the search handler is called with a reference to an anony-
+mous hash. The structure is the following:
+
+ $args = {
+ ## Request parameters:
+
+ HANDLE => ref ## Your session reference.
+ SETNAME => "id" ## ID of the result set
+ REPL_SET => 0 ## Replace set if already existing?
+ DATABASES => ["xxx"] ## Reference to a list of data-
+ ## bases to search
+ QUERY => "query" ## The query expression
+
+ ## Response parameters:
+
+ ERR_CODE => 0 ## Error code (0=Succesful search)
+ ERR_STR => "" ## Error string
+ HITS => 0 ## Number of matches
+ };
+
+Note that a search which finds 0 hits is considered successful in
+Z39.50 terms - you should only set the ERR_CODE to a non-zero value
+if there was a problem processing the request. The Z39.50 standard
+provides a comprehensive list of standard diagnostic codes, and you
+should use these whenever possible.
+
+The QUERY is a tree-structure of terms combined by operators, the
+terms being qualified by lists of attributes. The query is presented
+to the search function in the Prefix Query Format (PQF) which is
+used in many applications based on the YAZ toolkit. The full grammar
+is described in the YAZ manual.
+
+The following are all examples of valid queries in the PQF.
+
+ dylan
+
+ "bob dylan"
+
+ @or "dylan" "zimmerman"
+
+ @set Result-1
+
+ @or @and bob dylan @set Result-1
+
+ @and @attr 1=1 "bob dylan" @attr 1=4 "slow train coming"
+
+ @attrset @attr 4=1 @attr 1=4 "self portrait"
+
+You will need to write a recursive function or something similar to
+parse incoming query expressions, and this is usually where a lot of
+the work in writing a database-backend happens. Fortunately, you don't
+need to support anymore functionality than you want to. For instance,
+it is perfectly legal to not accept boolean operators, but you SHOULD
+try to return good error codes if you run into something you can't or
+won't support.
+
+=head2 Fetch handler
+
+The fetch handler is asked to retrieve a SINGLE record from a given
+result set (the front-end server will automatically call the fetch
+handler as many times as required).
+
+The parameters exchanged between the server and the fetch handler are
+
+ $args = {
+ ## Client/server request:
+
+ HANDLE => ref ## Reference to data structure
+ SETNAME => "id" ## ID of the requested result set
+ OFFSET => nnn ## Record offset number
+ REQ_FORM => "USMARC" ## Client requested record format
+
+ ## Handler response:
+
+ RECORD => "" ## Record string
+ LEN => 0 ## Length of record string
+ BASENAME => "" ## Origin of returned record
+ LAST => 0 ## Last record in set?
+ ERR_CODE => 0 ## Error code
+ ERR_STR => "" ## Error string
+ SUR_FLAG => 0 ## Surrogate diagnostic flag
+ REP_FORM => "USMARC" ## Provided record format
+ };
+
+The REP_FORM value has by default the REQ_FORM value but can be set to
+something different if the handler desires. The BASENAME value should
+contain the name of the database from where the returned record originates.
+The ERR_CODE and ERR_STR works the same way they do in the search
+handler. If there is an error condition, the SUR_FLAG is used to
+indicate whether the error condition pertains to the record currently
+being retrieved, or whether it pertains to the operation as a whole
+(eg. the client has specified a result set which does not exist.)
+
+Record formats are currently carried as strings (eg. USMARC, TEXT_XML,
+SUTRS), but this will probably change to proper OID strings in the
+future (not to worry, though, the module will supply constant values
+for the common OIDs). If you need to return USMARC records, you might
+want to have a look at the MARC module on CPAN, if you don't already
+have a way of generating these.
+
+NOTE: The record offset is 1-indexed - 1 is the offset of the first
+record in the set.
+
+=head2 Close handler
+
+The argument hash recieved by the close handler has one element only:
+
+ $args = {
+ ## Server provides:
+ HANDLE => ref ## Reference to data structure
+ };
+
+What ever data structure the HANDLE value points at goes out of scope
+after this call. If you need to close down a connection to your server
+or something similar, this is the place to do it.
+
+=head1 AUTHORS
+
+Anders Sønderberg (sondberg@indexdata.dk) and Sebastian Hammer
+(quinn@indexdata.dk).
+
+=head1 SEE ALSO
+
+perl(1).
+
+Any Perl module which is useful for accessing the database of your
+choice.
+
+=cut
+
+
--- /dev/null
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+#include <yaz/backend.h>
+#include <yaz/log.h>
+#include <yaz/wrbuf.h>
+#include <stdio.h>
+#include <stdlib.h>
+#include <ctype.h>
+#ifdef ASN_COMPILED
+#include <yaz/ill.h>
+#endif
+
+
+typedef struct {
+ SV *handle;
+
+ SV *init_ref;
+ SV *close_ref;
+ SV *sort_ref;
+ SV *search_ref;
+ SV *fetch_ref;
+ SV *present_ref;
+ SV *esrequest_ref;
+ SV *delete_ref;
+ SV *scan_ref;
+} Zfront_handle;
+
+SV *init_ref = NULL;
+SV *close_ref = NULL;
+SV *sort_ref = NULL;
+SV *search_ref = NULL;
+SV *fetch_ref = NULL;
+SV *present_ref = NULL;
+SV *esrequest_ref = NULL;
+SV *delete_ref = NULL;
+SV *scan_ref = NULL;
+int MAX_OID = 15;
+
+static void oid2str(Odr_oid *o, WRBUF buf)
+{
+ for (; *o >= 0; o++) {
+ char ibuf[16];
+ sprintf(ibuf, "%d", *o);
+ wrbuf_puts(buf, ibuf);
+ if (o[1] > 0)
+ wrbuf_putc(buf, '.');
+ }
+}
+
+
+static int rpn2pquery(Z_RPNStructure *s, WRBUF buf)
+{
+ switch (s->which) {
+ case Z_RPNStructure_simple: {
+ Z_Operand *o = s->u.simple;
+
+ switch (o->which) {
+ case Z_Operand_APT: {
+ Z_AttributesPlusTerm *at = o->u.attributesPlusTerm;
+
+ if (at->attributes) {
+ int i;
+ char ibuf[16];
+
+ for (i = 0; i < at->attributes->num_attributes; i++) {
+ wrbuf_puts(buf, "@attr ");
+ if (at->attributes->attributes[i]->attributeSet) {
+ oid2str(at->attributes->attributes[i]->attributeSet, buf);
+ wrbuf_putc(buf, ' ');
+ }
+ sprintf(ibuf, "%d=", *at->attributes->attributes[i]->attributeType);
+ assert(at->attributes->attributes[i]->which == Z_AttributeValue_numeric);
+ wrbuf_puts(buf, ibuf);
+ sprintf(ibuf, "%d ", *at->attributes->attributes[i]->value.numeric);
+ wrbuf_puts(buf, ibuf);
+ }
+ }
+ switch (at->term->which) {
+ case Z_Term_general: {
+ wrbuf_putc(buf, '"');
+ wrbuf_write(buf, (char*) at->term->u.general->buf, at->term->u.general->len);
+ wrbuf_puts(buf, "\" ");
+ break;
+ }
+ default: abort();
+ }
+ break;
+ }
+ default: abort();
+ }
+ break;
+ }
+ case Z_RPNStructure_complex: {
+ Z_Complex *c = s->u.complex;
+
+ switch (c->roperator->which) {
+ case Z_Operator_and: wrbuf_puts(buf, "@and "); break;
+ case Z_Operator_or: wrbuf_puts(buf, "@or "); break;
+ case Z_Operator_and_not: wrbuf_puts(buf, "@not "); break;
+ case Z_Operator_prox: abort();
+ default: abort();
+ }
+ if (!rpn2pquery(c->s1, buf))
+ return 0;
+ if (!rpn2pquery(c->s2, buf))
+ return 0;
+ break;
+ }
+ default: abort();
+ }
+ return 1;
+}
+
+
+WRBUF zquery2pquery(Z_Query *q)
+{
+ WRBUF buf = wrbuf_alloc();
+
+ if (q->which != Z_Query_type_1 && q->which != Z_Query_type_101)
+ return 0;
+ if (q->u.type_1->attributeSetId) {
+ /* Output attribute set ID */
+ wrbuf_puts(buf, "@attrset ");
+ oid2str(q->u.type_1->attributeSetId, buf);
+ wrbuf_putc(buf, ' ');
+ }
+ return rpn2pquery(q->u.type_1->RPNStructure, buf) ? buf : 0;
+}
+
+
+int bend_sort(void *handle, bend_sort_rr *rr)
+{
+ perl_call_sv(sort_ref, G_VOID | G_DISCARD | G_NOARGS);
+ return;
+}
+
+
+int bend_search(void *handle, bend_search_rr *rr)
+{
+ HV *href;
+ AV *aref;
+ SV **temp;
+ SV *hits;
+ SV *err_code;
+ SV *err_str;
+ char *ODR_errstr;
+ STRLEN len;
+ int i;
+ char **basenames;
+ int n;
+ WRBUF query;
+ char *ptr;
+ SV *point;
+ SV *ODR_point;
+ Zfront_handle *zhandle = (Zfront_handle *)handle;
+
+ dSP;
+ ENTER;
+ SAVETMPS;
+
+ aref = newAV();
+ basenames = rr->basenames;
+ for (i = 0; i < rr->num_bases; i++)
+ {
+ av_push(aref, newSVpv(*basenames++, 0));
+ }
+ href = newHV();
+ hv_store(href, "SETNAME", 7, newSVpv(rr->setname, 0), 0);
+ hv_store(href, "REPL_SET", 8, newSViv(rr->replace_set), 0);
+ hv_store(href, "ERR_CODE", 8, newSViv(0), 0);
+ hv_store(href, "ERR_STR", 7, newSVpv("", 0), 0);
+ hv_store(href, "HITS", 4, newSViv(0), 0);
+ hv_store(href, "DATABASES", 9, newRV( (SV*) aref), 0);
+ hv_store(href, "HANDLE", 6, zhandle->handle, 0);
+ query = zquery2pquery(rr->query);
+ if (query)
+ {
+ hv_store(href, "QUERY", 5, newSVpv((char *)query->buf, query->pos), 0);
+ }
+ else
+ {
+ rr->errcode = 108;
+ }
+ PUSHMARK(sp);
+
+ XPUSHs(sv_2mortal(newRV( (SV*) href)));
+
+ PUTBACK;
+
+ n = perl_call_sv(search_ref, G_SCALAR | G_DISCARD);
+
+ SPAGAIN;
+
+ temp = hv_fetch(href, "HITS", 4, 1);
+ hits = newSVsv(*temp);
+
+ 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);
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+
+ hv_undef(href);
+ av_undef(aref);
+ rr->hits = SvIV(hits);
+ rr->errcode = SvIV(err_code);
+ ptr = SvPV(err_str, len);
+ ODR_errstr = (char *)odr_malloc(rr->stream, len + 1);
+ strcpy(ODR_errstr, ptr);
+ rr->errstring = ODR_errstr;
+/* ODR_point = (SV *)odr_malloc(rr->stream, sizeof(*point));
+ memcpy(ODR_point, point, sizeof(*point));
+ zhandle->handle = ODR_point;*/
+ zhandle->handle = point;
+ handle = zhandle;
+ sv_free(hits);
+ sv_free(err_code);
+ sv_free(err_str);
+ sv_free( (SV*) aref);
+ sv_free( (SV*) href);
+ /*sv_free(point);*/
+ wrbuf_free(query, 1);
+ return 0;
+}
+
+
+WRBUF oid2dotted(int *oid)
+{
+
+ WRBUF buf = wrbuf_alloc();
+ int dot = 0;
+
+ for (; *oid != -1 ; oid++)
+ {
+ char ibuf[16];
+ if (dot)
+ {
+ wrbuf_putc(buf, '.');
+ }
+ else
+ {
+ dot = 1;
+ }
+ sprintf(ibuf, "%d", *oid);
+ wrbuf_puts(buf, ibuf);
+ }
+ return buf;
+}
+
+
+int dotted2oid(char *dotted, int *buffer)
+{
+ int *oid;
+ char ibuf[16];
+ char *ptr;
+ int n = 0;
+
+ ptr = ibuf;
+ oid = buffer;
+ while (*dotted)
+ {
+ if (*dotted == '.')
+ {
+ n++;
+ if (n == MAX_OID) /* Terminate if more than MAX_OID entries */
+ {
+ *oid = -1;
+ return -1;
+ }
+ *ptr = 0;
+ sscanf(ibuf, "%d", oid++);
+ ptr = ibuf;
+ dotted++;
+
+ }
+ else
+ {
+ *ptr++ = *dotted++;
+ }
+ }
+ if (n < MAX_OID)
+ {
+ *ptr = 0;
+ sscanf(ibuf, "%d", oid++);
+ }
+ *oid = -1;
+ return 0;
+}
+
+
+int bend_fetch(void *handle, bend_fetch_rr *rr)
+{
+ HV *href;
+ SV **temp;
+ SV *basename;
+ SV *len;
+ SV *record;
+ SV *last;
+ SV *err_code;
+ SV *err_string;
+ SV *sur_flag;
+ SV *point;
+ SV *rep_form;
+ char *ptr;
+ char *ODR_record;
+ char *ODR_basename;
+ char *ODR_errstr;
+ int *ODR_oid_buf;
+ WRBUF oid_dotted;
+ Zfront_handle *zhandle = (Zfront_handle *)handle;
+
+ Z_RecordComposition *composition;
+ Z_ElementSetNames *simple;
+ STRLEN length;
+ int oid;
+
+ dSP;
+ ENTER;
+ SAVETMPS;
+
+ rr->errcode = 0;
+ href = newHV();
+ hv_store(href, "SETNAME", 7, newSVpv(rr->setname, 0), 0);
+ temp = hv_store(href, "OFFSET", 6, newSViv(rr->number), 0);
+ oid_dotted = oid2dotted(rr->request_format_raw);
+ hv_store(href, "REQ_FORM", 8, newSVpv((char *)oid_dotted->buf, oid_dotted->pos), 0);
+ hv_store(href, "REP_FORM", 8, newSVpv((char *)oid_dotted->buf, oid_dotted->pos), 0);
+ hv_store(href, "BASENAME", 8, newSVpv("", 0), 0);
+ hv_store(href, "LEN", 3, newSViv(0), 0);
+ hv_store(href, "RECORD", 6, newSVpv("", 0), 0);
+ hv_store(href, "LAST", 4, newSViv(0), 0);
+ hv_store(href, "ERR_CODE", 8, newSViv(0), 0);
+ hv_store(href, "ERR_STR", 7, newSVpv("", 0), 0);
+ hv_store(href, "SUR_FLAG", 8, newSViv(0), 0);
+ hv_store(href, "HANDLE", 6, zhandle->handle, 0);
+ if (rr->comp)
+ {
+ composition = rr->comp;
+ if (composition->which == 1)
+ {
+ simple = composition->u.simple;
+ if (simple->which == 1)
+ {
+ hv_store(href, "COMP", 4, newSVpv(simple->u.generic, 0), 0);
+ }
+ else
+ {
+ rr->errcode = 26;
+ }
+ }
+ else
+ {
+ rr->errcode = 26;
+ }
+ }
+
+ PUSHMARK(sp);
+
+ XPUSHs(sv_2mortal(newRV( (SV*) href)));
+
+ PUTBACK;
+
+ perl_call_sv(fetch_ref, G_SCALAR | G_DISCARD);
+
+ SPAGAIN;
+
+ temp = hv_fetch(href, "BASENAME", 8, 1);
+ basename = newSVsv(*temp);
+
+ temp = hv_fetch(href, "LEN", 3, 1);
+ len = newSVsv(*temp);
+
+ temp = hv_fetch(href, "RECORD", 6, 1);
+ record = newSVsv(*temp);
+
+ temp = hv_fetch(href, "LAST", 4, 1);
+ last = newSVsv(*temp);
+
+ temp = hv_fetch(href, "ERR_CODE", 8, 1);
+ err_code = newSVsv(*temp);
+
+ temp = hv_fetch(href, "ERR_STR", 7, 1),
+ err_string = newSVsv(*temp);
+
+ temp = hv_fetch(href, "SUR_FLAG", 8, 1);
+ sur_flag = newSVsv(*temp);
+
+ temp = hv_fetch(href, "REP_FORM", 8, 1);
+ rep_form = newSVsv(*temp);
+
+ temp = hv_fetch(href, "HANDLE", 6, 1);
+ point = newSVsv(*temp);
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+
+ hv_undef(href);
+
+ ptr = SvPV(basename, length);
+ ODR_basename = (char *)odr_malloc(rr->stream, length + 1);
+ strcpy(ODR_basename, ptr);
+ rr->basename = ODR_basename;
+
+ ptr = SvPV(rep_form, length);
+ ODR_oid_buf = (int *)odr_malloc(rr->stream, (MAX_OID + 1) * sizeof(int));
+ if (dotted2oid(ptr, ODR_oid_buf) == -1) /* Maximum number of OID elements exceeded */
+ {
+ printf("Net::Z3950::SimpleServer: WARNING: OID structure too long, max length is %d\n", MAX_OID);
+ }
+ rr->output_format_raw = ODR_oid_buf;
+
+ rr->len = SvIV(len);
+
+ ptr = SvPV(record, length);
+ ODR_record = (char *)odr_malloc(rr->stream, length + 1);
+ strcpy(ODR_record, ptr);
+ rr->record = ODR_record;
+
+ zhandle->handle = point;
+ handle = zhandle;
+ rr->last_in_set = SvIV(last);
+
+ if (!(rr->errcode))
+ {
+ rr->errcode = SvIV(err_code);
+ ptr = SvPV(err_string, length);
+ ODR_errstr = (char *)odr_malloc(rr->stream, length + 1);
+ strcpy(ODR_errstr, ptr);
+ rr->errstring = ODR_errstr;
+ }
+ rr->surrogate_flag = SvIV(sur_flag);
+
+ /*sv_free(point);*/
+ wrbuf_free(oid_dotted, 1);
+ sv_free((SV*) href);
+ sv_free(basename);
+ sv_free(len);
+ sv_free(record);
+ sv_free(last);
+ sv_free(err_string);
+ sv_free(err_code),
+ sv_free(sur_flag);
+ sv_free(rep_form);
+
+ return 0;
+}
+
+
+int bend_present(void *handle, bend_present_rr *rr)
+{
+
+ int n;
+ HV *href;
+ SV **temp;
+ SV *err_code;
+ SV *err_string;
+ STRLEN len;
+ Z_RecordComposition *composition;
+ Z_ElementSetNames *simple;
+ char *ODR_errstr;
+ char *ptr;
+
+ dSP;
+ ENTER;
+ SAVETMPS;
+
+ href = newHV();
+ hv_store(href, "ERR_CODE", 8, newSViv(0), 0);
+ hv_store(href, "ERR_STR", 7, newSVpv("", 0), 0);
+ hv_store(href, "START", 5, newSViv(rr->start), 0);
+ hv_store(href, "SETNAME", 7, newSVpv(rr->setname, 0), 0);
+ hv_store(href, "NUMBER", 6, newSViv(rr->number), 0);
+ if (rr->comp)
+ {
+ composition = rr->comp;
+ if (composition->which == 1)
+ {
+ simple = composition->u.simple;
+ if (simple->which == 1)
+ {
+ hv_store(href, "COMP", 4, newSVpv(simple->u.generic, 0), 0);
+ }
+ else
+ {
+ rr->errcode = 26;
+ return 0;
+ }
+ }
+ else
+ {
+ rr->errcode = 26;
+ return 0;
+ }
+ }
+
+ PUSHMARK(sp);
+
+ XPUSHs(sv_2mortal(newRV( (SV*) href)));
+
+ PUTBACK;
+
+ n = perl_call_sv(present_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_string = newSVsv(*temp);
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+
+ hv_undef(href);
+ rr->errcode = SvIV(err_code);
+
+ ptr = SvPV(err_string, len);
+ ODR_errstr = (char *)odr_malloc(rr->stream, len + 1);
+ strcpy(ODR_errstr, ptr);
+ rr->errstring = ODR_errstr;
+
+ sv_free(err_code);
+ sv_free(err_string);
+ sv_free( (SV*) href);
+
+ return 0;
+}
+
+
+int bend_esrequest(void *handle, bend_esrequest_rr *rr)
+{
+ perl_call_sv(esrequest_ref, G_VOID | G_DISCARD | G_NOARGS);
+ return 0;
+}
+
+
+int bend_delete(void *handle, bend_delete_rr *rr)
+{
+ perl_call_sv(delete_ref, G_VOID | G_DISCARD | G_NOARGS);
+ return 0;
+}
+
+
+int bend_scan(void *handle, bend_scan_rr *rr)
+{
+ perl_call_sv(scan_ref, G_VOID | G_DISCARD | G_NOARGS);
+ return 0;
+}
+
+
+bend_initresult *bend_init(bend_initrequest *q)
+{
+ bend_initresult *r = (bend_initresult *) odr_malloc (q->stream, sizeof(*r));
+ HV *href;
+ SV **temp;
+ SV *name;
+ SV *ver;
+ SV *err_str;
+ SV *status;
+ Zfront_handle *zhandle = (Zfront_handle *) xmalloc (sizeof(*zhandle));
+ STRLEN len;
+ int n;
+ SV *handle;
+ /*char *name_ptr;
+ char *ver_ptr;*/
+ char *ptr;
+
+ dSP;
+ ENTER;
+ SAVETMPS;
+
+ /*q->bend_sort = bend_sort;*/
+ if (search_ref)
+ {
+ q->bend_search = bend_search;
+ }
+ /*q->bend_present = present;*/
+ /*q->bend_esrequest = bend_esrequest;*/
+ /*q->bend_delete = bend_delete;*/
+ if (fetch_ref)
+ {
+ q->bend_fetch = bend_fetch;
+ }
+ /*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);
+ hv_store(href, "ERR_CODE", 8, newSViv(0), 0);
+ hv_store(href, "HANDLE", 6, newSVsv(&sv_undef), 0);
+
+ PUSHMARK(sp);
+
+ XPUSHs(sv_2mortal(newRV( (SV*) href)));
+
+ PUTBACK;
+
+ if (init_ref != NULL)
+ {
+ perl_call_sv(init_ref, G_SCALAR | G_DISCARD);
+ }
+
+ SPAGAIN;
+
+ temp = hv_fetch(href, "IMP_NAME", 8, 1);
+ name = newSVsv(*temp);
+
+ temp = hv_fetch(href, "IMP_VER", 7, 1);
+ ver = newSVsv(*temp);
+
+ temp = hv_fetch(href, "ERR_CODE", 8, 1);
+ status = newSVsv(*temp);
+
+ temp = hv_fetch(href, "HANDLE", 6, 1);
+ handle= newSVsv(*temp);
+
+ hv_undef(href);
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+ zhandle->handle = handle;
+ r->errcode = SvIV(status);
+ r->handle = zhandle;
+ ptr = SvPV(name, len);
+ q->implementation_name = (char *)xmalloc(len + 1);
+ strcpy(q->implementation_name, ptr);
+/* q->implementation_name = SvPV(name, len);*/
+ ptr = SvPV(ver, len);
+ q->implementation_version = (char *)xmalloc(len + 1);
+ strcpy(q->implementation_version, ptr);
+
+ return r;
+}
+
+
+void bend_close(void *handle)
+{
+ HV *href;
+ Zfront_handle *zhandle = (Zfront_handle *)handle;
+ SV **temp;
+
+ dSP;
+ ENTER;
+ SAVETMPS;
+
+ if (close_ref == NULL)
+ {
+ return;
+ }
+
+ href = newHV();
+ hv_store(href, "HANDLE", 6, zhandle->handle, 0);
+
+ PUSHMARK(sp);
+
+ XPUSHs(sv_2mortal(newRV((SV *)href)));
+
+ PUTBACK;
+
+ perl_call_sv(close_ref, G_SCALAR | G_DISCARD);
+
+ SPAGAIN;
+
+ PUTBACK;
+ FREETMPS;
+ LEAVE;
+
+ xfree(handle);
+
+ return;
+}
+
+
+MODULE = Net::Z3950::SimpleServer PACKAGE = Net::Z3950::SimpleServer
+
+void
+set_init_handler(arg)
+ SV *arg
+ CODE:
+ init_ref = newSVsv(arg);
+
+
+void
+set_close_handler(arg)
+ SV *arg
+ CODE:
+ close_ref = newSVsv(arg);
+
+
+void
+set_sort_handler(arg)
+ SV *arg
+ CODE:
+ sort_ref = newSVsv(arg);
+
+void
+set_search_handler(arg)
+ SV *arg
+ CODE:
+ search_ref = newSVsv(arg);
+
+
+void
+set_fetch_handler(arg)
+ SV *arg
+ CODE:
+ fetch_ref = newSVsv(arg);
+
+
+void
+set_present_handler(arg)
+ SV *arg
+ CODE:
+ present_ref = newSVsv(arg);
+
+
+void
+set_esrequest_handler(arg)
+ SV *arg
+ CODE:
+ esrequest_ref = newSVsv(arg);
+
+
+void
+set_delete_handler(arg)
+ SV *arg
+ CODE:
+ delete_ref = newSVsv(arg);
+
+
+void
+set_scan_handler(arg)
+ SV *arg
+ CODE:
+ scan_ref = newSVsv(arg);
+
+
+int
+start_server(...)
+ PREINIT:
+ char **argv;
+ char **argv_buf;
+ char *ptr;
+ int i;
+ STRLEN len;
+ CODE:
+ argv_buf = (char **)xmalloc((items + 1) * sizeof(char *));
+ argv = argv_buf;
+ for (i = 0; i < items; i++)
+ {
+ ptr = SvPV(ST(i), len);
+ *argv_buf = (char *)xmalloc(len + 1);
+ strcpy(*argv_buf++, ptr);
+ }
+ *argv_buf = NULL;
+
+ RETVAL = statserv_main(items, argv, bend_init, bend_close);
+ OUTPUT:
+ RETVAL
--- /dev/null
+Net::Z3950::SimpleServer - TODO list
+------------------------------------
+
+- Include a yaz-config --libs feature in Makefile.PM
+- Documentation
+
--- /dev/null
+# Before `make install' is performed this script should be runnable with
+# `make test'. After `make install' it should work as `perl test.pl'
+
+######################### We start with some black magic to print on failure.
+
+# Change 1..1 below to 1..last_test_to_print .
+# (It may become useful if the test is moved to ./t subdirectory.)
+
+BEGIN { $| = 1; print "1..1\n"; }
+END {print "not ok 1\n" unless $loaded;}
+use Net::Z3950::SimpleServer;
+$loaded = 1;
+print "ok 1\n";
+
+######################### End of black magic.
+
+# Insert your test code below (better if it prints "ok 13"
+# (correspondingly "not ok 13") depending on the success of chunk 13
+# of the test code):
+
+sub my_init_handler {
+ my $href = shift;
+ my %log = ();
+
+ $log{"init"} = "Ok";
+ $href->{HANDLE} = \%log;
+}
+
+sub my_search_handler {
+ my $href = shift;
+ my %log = %{$href->{HANDLE}};
+
+ $log{"search"} = "Ok";
+ $href->{HANDLE} = \%log;
+ $href->{HITS} = 1;
+}
+
+sub my_fetch_handler {
+ my $href = shift;
+ my %log = %{$href->{HANDLE}};
+ my $record = "<xml><head>Headline</head><body>I am a record</body></xml>";
+
+ $log{"fetch"} = "Ok";
+ $href->{HANDLE} = \%log;
+ $href->{RECORD} = $record;
+ $href->{LEN} = length($record);
+ $href->{NUMBER} = 1;
+ $href->{BASENAME} = "Test";
+}
+
+sub my_close_handler {
+ my @services = ("init", "search", "fetch", "close");
+ my $href = shift;
+ my %log = %{$href->{HANDLE}};
+ my $status;
+ my $service;
+ my $error = 0;
+
+ $log{"close"} = "Ok";
+
+ print "\n-----------------------------------------------\n";
+ print "Available Z39.50 services:\n\n";
+
+ foreach $service (@services) {
+ print "Called $service: ";
+ if (defined($status = $log{$service})) {
+ print "$status\n";
+ } else {
+ print "FAILED!!!\n";
+ $error = 1;
+ }
+ }
+ if ($error) {
+ print "make test: Failed due to lack of required Z39.50 service\n";
+ } else {
+ print "\nEverything is ok!\n";
+ }
+ print "-----------------------------------------------\n";
+}
+
+
+if (!defined($pid = fork() )) {
+ die "Cannot fork: $!\n";
+} elsif ($pid) { ## Parent launches server
+ my $handler = Net::Z3950::SimpleServer->new({
+ INIT => \&my_init_handler,
+ CLOSE => \&my_close_handler,
+ SEARCH => \&my_search_handler,
+ FETCH => \&my_fetch_handler });
+
+ $handler->launch_server("test.pl", "-1", @ARGV);
+} else { ## Child starts the client
+ sleep(1);
+ open(CLIENT, "| yaz-client tcp:localhost:9999 > /dev/null")
+ or die "Couldn't fork client: $!\n";
+ print CLIENT "f test\n";
+ print CLIENT "s\n";
+ print CLIENT "close\n";
+ print CLIENT "quit\n";
+ close(CLIENT) or die "Couldn't close: $!\n";
+}
+
--- /dev/null
+#!/usr/bin/perl -w
+use ExtUtils::testlib;
+use Net::Z3950::SimpleServer;
+use Net::Z3950::OID;
+
+
+sub udskriv_hash {
+
+ my $href = shift;
+ my $key;
+ my $item;
+
+ foreach $key (keys %{ $href }) {
+ print "$key = ";
+ if ($key eq "DATABASES") {
+ foreach $item ( @{ $href->{DATABASES} }) {
+ print "$item ";
+ }
+ print "\n";
+ } elsif ($key eq "HANDLE") {
+ foreach $item ( keys %{ $href->{HANDLE} }) {
+ print " $item => ";
+ print ${ $href->{HANDLE}}{$item};
+ print "\n";
+ }
+ } else {
+ print $href->{$key};
+ print "\n";
+ }
+ }
+}
+
+
+
+sub my_init_handler {
+
+ my $href = shift;
+ my $hash = {};
+
+ $hash->{Anders} = "Sønderberg Mortensen";
+ $hash->{Birgit} = "Stenhøj Andersen";
+ $href->{IMP_NAME} = "MyServer";
+ $href->{IMP_VER} = "3.14159";
+ $href->{ERR_CODE} = 0;
+ $href->{HANDLE} = $hash;
+ print "\n";
+ print "---------------------------------------------------------------\n";
+ print "Connection established\n";
+ print "\n";
+ udskriv_hash($href);
+ print "---------------------------------------------------------------\n";
+}
+
+sub my_search_handler {
+
+ my $href = shift;
+ my $key;
+ my $hash = $href->{HANDLE};
+# my $hash = {};
+
+ $href->{HITS} = 1;
+ $href->{ERR_STR} = "A";
+ $hash->{Search} = "Search Handler er besøgt";
+# $href->{HANDLE} = $hash;
+ print "\n";
+ print "---------------------------------------------------------------\n";
+ print "Search handler\n";
+ print "\n";
+ udskriv_hash($href);
+ print "---------------------------------------------------------------\n";
+}
+
+
+sub my_present_handler {
+ my $href = shift;
+
+ $href->{ERR_CODE} = 0;
+
+ $href->{ERR_STR} = "";
+ print "\n";
+ print "--------------------------------------------------------------\n";
+ print "Present handler\n";
+ print "\n";
+ udskriv_hash($href);
+ print "--------------------------------------------------------------\n";
+ return;
+}
+
+sub my_close_handler {
+ my $href = shift;
+
+ print "\n";
+ print "-------------------------------------------------------------\n";
+ print "Connection closed\n";
+ print "\n";
+ udskriv_hash($href);
+ print "-------------------------------------------------------------\n";
+
+}
+
+
+sub my_fetch_handler {
+ my $href = shift;
+ my $hash = $href->{HANDLE};
+
+ $hash->{Fetch} = "Fetch handler er besøgt";
+ ##$href->{RECORD} = "<head>Overskrift</head> <text>Her kommer teksten</text>";
+ $href->{RECORD} = "<xml><head>Overskrift</head><body>Der var engang en mand</body></xml>";
+ $href->{LEN} = 69;
+ $href->{NUMBER} = 1;
+ $href->{BASENAME} = "MS-Gud";
+ $href->{LAST} = 1;
+ ## $href->{HANDLE} = \%hash;
+ print "\n";
+ print "------------------------------------------------------------\n";
+ print "Fetch handler\n";
+ print "\n";
+ udskriv_hash($href);
+ if ($href->{REQ_FORM} eq Net::Z3950::OID::unimarc) {
+ print "Formatet UNIMARC\n";
+ } else {
+ print "Formatet er IKKE unimarc\n";
+ }
+ print "------------------------------------------------------------\n";
+
+}
+
+
+
+my $handler = Net::Z3950::SimpleServer->new({ INIT => \&my_init_handler,
+ CLOSE => \&my_close_handler,
+ SEARCH => \&my_search_handler,
+ FETCH => \&my_fetch_handler
+ });
+
+$handler->launch_server("ztest.pl", @ARGV);
+
projects / simpleserver-moved-to-github.git / commitdiff