From 8aaa9b6ef2b98a5ac710343e826d469d926371d0 Mon Sep 17 00:00:00 2001 From: "Anders S. Mortensen" Date: Fri, 8 Sep 2000 12:31:25 +0000 Subject: [PATCH] Initial revision --- Changes | 5 + MANIFEST | 8 + Makefile | 766 ++++++++++++++++++++++++++++++++++++++++++++++++ Makefile.PL | 13 + OID.pm | 52 ++++ SimpleServer.c | 873 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ SimpleServer.pm | 345 ++++++++++++++++++++++ SimpleServer.xs | 769 ++++++++++++++++++++++++++++++++++++++++++++++++ TODO | 6 + test.pl | 102 +++++++ ztest.pl | 137 +++++++++ 11 files changed, 3076 insertions(+) create mode 100644 Changes create mode 100644 MANIFEST create mode 100644 Makefile create mode 100644 Makefile.PL create mode 100644 OID.pm create mode 100644 SimpleServer.bs create mode 100644 SimpleServer.c create mode 100644 SimpleServer.pm create mode 100644 SimpleServer.xs create mode 100644 TODO create mode 100644 pm_to_blib create mode 100644 test.pl create mode 100755 ztest.pl diff --git a/Changes b/Changes new file mode 100644 index 0000000..77b6625 --- /dev/null +++ b/Changes @@ -0,0 +1,5 @@ +Revision history for Perl extension Net::Z3950::Server. + +0.01 Wed Aug 30 14:54:01 2000 + - original version; created by h2xs 1.19 + diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..726ed40 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,8 @@ +Changes +Makefile.PL +MANIFEST +SimpleServer.pm +SimpleServer.xs +test.pl +ztest.pl +OID.pm diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..a69c411 --- /dev/null +++ b/Makefile @@ -0,0 +1,766 @@ +# 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{\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: + +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. diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..d64c41e --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,13 @@ +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' +); diff --git a/OID.pm b/OID.pm new file mode 100644 index 0000000..9b1797d --- /dev/null +++ b/OID.pm @@ -0,0 +1,52 @@ +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' } + + diff --git a/SimpleServer.bs b/SimpleServer.bs new file mode 100644 index 0000000..e69de29 diff --git a/SimpleServer.c b/SimpleServer.c new file mode 100644 index 0000000..80dd5c7 --- /dev/null +++ b/SimpleServer.c @@ -0,0 +1,873 @@ +/* + * 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 +#include +#include +#include +#include +#include +#ifdef ASN_COMPILED +#include +#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; +} + diff --git a/SimpleServer.pm b/SimpleServer.pm new file mode 100644 index 0000000..d62c45a --- /dev/null +++ b/SimpleServer.pm @@ -0,0 +1,345 @@ +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: + +=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 + + diff --git a/SimpleServer.xs b/SimpleServer.xs new file mode 100644 index 0000000..7280768 --- /dev/null +++ b/SimpleServer.xs @@ -0,0 +1,769 @@ +#include "EXTERN.h" +#include "perl.h" +#include "XSUB.h" +#include +#include +#include +#include +#include +#include +#ifdef ASN_COMPILED +#include +#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 diff --git a/TODO b/TODO new file mode 100644 index 0000000..d3db17e --- /dev/null +++ b/TODO @@ -0,0 +1,6 @@ +Net::Z3950::SimpleServer - TODO list +------------------------------------ + +- Include a yaz-config --libs feature in Makefile.PM +- Documentation + diff --git a/pm_to_blib b/pm_to_blib new file mode 100644 index 0000000..e69de29 diff --git a/test.pl b/test.pl new file mode 100644 index 0000000..b0a03de --- /dev/null +++ b/test.pl @@ -0,0 +1,102 @@ +# 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 = "HeadlineI am a record"; + + $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"; +} + diff --git a/ztest.pl b/ztest.pl new file mode 100755 index 0000000..5640d93 --- /dev/null +++ b/ztest.pl @@ -0,0 +1,137 @@ +#!/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} = "Overskrift Her kommer teksten"; + $href->{RECORD} = "OverskriftDer var engang en mand"; + $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); + -- 1.7.10.4