From: Anders S. Mortensen Date: Fri, 8 Sep 2000 12:31:25 +0000 (+0000) Subject: Initial revision X-Git-Tag: id0~1 X-Git-Url: http://git.indexdata.com/?p=simpleserver-moved-to-github.git;a=commitdiff_plain;h=8aaa9b6ef2b98a5ac710343e826d469d926371d0 Initial revision --- 8aaa9b6ef2b98a5ac710343e826d469d926371d0 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); +