+++ /dev/null
-%module "IDZebra"
-%include typemaps.i // Load the typemaps librayr
-
-
-%{
-#include <idzebra/api.h>
-#include "zebra_perl.h"
-#include <idzebra/data1.h>
-#include "yaz/odr.h"
-#include "yaz/cql.h"
-%}
-
-/* == Typemaps ============================================================= */
-
-%typemap(in) int * {
- int i;
- if (!SvIOK($input))
- croak("Argument $argnum is not an integer.");
- i = SvIV($input);
- $1 = &i;
-}
-
-%typemap(out) int * {
- $result=newSViv($1)
- sv_2mortal($result);
- argvi++;
-}
-
-/* * * * * * Fix for broken swig implementation */
-%typemap(argout) long long *INOUT {
- char temp[256];
- if (argvi >= items) {
- EXTEND(sp,1);
- }
- /* sprintf(temp,"%lld", $1); */
- sprintf(temp,"%lld", *$1);
- $result = sv_newmortal();
- sv_setpv($result,temp);
- argvi++;
-}
-
-
-/* RetrievalRecordBuff is a special construct, to allow to map a char * buf
- to non-null terminated perl string scalar value (SVpv). */
-%typemap(out) RetrievalRecordBuf * {
- if ($1->len) {
- $result = newSVpv($1->buf,$1->len);
- } else {
- $result = newSVpv("",0);
- }
- sv_2mortal($result);
- argvi++;
-}
-
-/* All char ** values are mapped in-out to array of strings. */
-%typemap(in) char ** {
- AV *tempav;
- I32 len;
- int i;
- SV **tv;
- STRLEN na;
- if (!SvROK($input))
- croak("Argument $argnum is not a reference.");
- if (SvTYPE(SvRV($input)) != SVt_PVAV)
- croak("Argument $argnum is not an array.");
- tempav = (AV*)SvRV($input);
- len = av_len(tempav);
- $1 = (char **) malloc((len+2)*sizeof(char *));
- for (i = 0; i <= len; i++) {
- tv = av_fetch(tempav, i, 0);
- $1[i] = (char *) SvPV(*tv,na);
- }
- $1[i] = NULL;
-};
-
-/* This cleans up the char ** array after the function call */
-%typemap(freearg) char ** {
- free($1);
-}
-
-/* Creates a new Perl array and places a NULL-terminated char ** into it */
-%typemap(out) char ** {
- AV *myav;
- SV **svs;
- int i = 0,len = 0;
- /* Figure out how many elements we have */
- while ($1[len])
- len++;
- svs = (SV **) malloc(len*sizeof(SV *));
- for (i = 0; i < len ; i++) {
- svs[i] = sv_newmortal();
- sv_setpv((SV*)svs[i],$1[i]);
- };
- myav = av_make(len,svs);
- free(svs);
- $result = newRV((SV*)myav);
- sv_2mortal($result);
- argvi++;
-}
-
-/* == Structures for shadow classes ======================================= */
-
-
-/*%include "zebra_perl.h" */
-
-typedef struct {
- int noOfRecords;
- ZebraRetrievalRecord *records;
-} RetrievalObj;
-
-typedef struct {
- int errCode; /* non-zero if error when fetching this */
- char *errString; /* error string */
- int position; /* position of record in result set (1,2,..) */
- char *base;
- long long sysno;
- int score;
- char *format; /* record syntax */
- RetrievalRecordBuf *buf;
-} RetrievalRecord;
-
-/* Scan Term Descriptor */
-typedef struct {
- int occurrences; /* scan term occurrences */
- char *term; /* scan term string */
-} scanEntry;
-
-typedef struct {
- int num_entries;
- int position;
- int is_partial;
- scanEntry *entries;
-} ScanObj;
-
-
-typedef struct {
- int processed;
- int inserted;
- int updated;
- int deleted;
- long utime;
- long stime;
-} ZebraTransactionStatus;
-
-/* == Module initialization and cleanup (zebra_perl.c) ===================== */
-
-void init (void);
-void DESTROY (void);
-
-/* == Logging facilities (yaz/log.h) ======================================= */
-
-%name(logLevel)
-void yaz_log_init_level (int level);
-
-%name(logFile)
-void yaz_log_init_file (const char *fname);
-
-%name(logMsg)
-void logMsg (int level, const char *message);
-
-%name(logPrefix)
-void yaz_log_init_prefix (const char *prefix);
-
-%name(logPrefix2)
-void yaz_log_init_prefix2 (const char *prefix);
-
-#define LOG_FATAL 0x0001
-#define LOG_DEBUG 0x0002
-#define LOG_WARN 0x0004
-#define LOG_LOG 0x0008
-#define LOG_ERRNO 0x0010 /* append strerror to message */
-#define LOG_FILE 0x0020
-#define LOG_APP 0x0040 /* For application level events */
-#define LOG_MALLOC 0x0080 /* debugging mallocs */
-#define LOG_ALL 0xff7f
-#define LOG_DEFAULT_LEVEL (LOG_FATAL | LOG_ERRNO | LOG_LOG | LOG_WARN)
-
-/* == ODR stuff (yaz/odr.h) ================================================ */
-
-#define ODR_DECODE 0
-#define ODR_ENCODE 1
-#define ODR_PRINT 2
-ODR odr_createmem(int direction);
-void odr_reset(ODR o);
-void odr_destroy(ODR o);
-void *odr_malloc(ODR o, int size);
-
-
-/* == Zebra session and service (index/zebraapi.c) ========================= */
-
-%name(start)
-ZebraService zebra_start (const char *configName);
-
-%name(open)
-ZebraHandle zebra_open (ZebraService zs);
-
-%name(close)
-void zebra_close (ZebraHandle zh);
-
-%name(stop)
-void zebra_stop (ZebraService zs);
-
-
-/* == Error handling and reporting (index/zebraapi.c) ====================== */
-
-/* last error code */
-%name(errCode)
-int zebra_errCode (ZebraHandle zh);
-
-/* string representatio of above */
-%name(errString)
-const char * zebra_errString (ZebraHandle zh);
-
-/* extra information associated with error */
-%name(errAdd)
-char * zebra_errAdd (ZebraHandle zh);
-
-
-/* == Zebra resources and database selection =============================== */
-
-/* set a resource */
-%name(set_resource)
-void zebra_set_resource(ZebraHandle zh, const char *name, const char *value);
-
-/* get a resource */
-%name(get_resource)
-const char *zebra_set_resource(ZebraHandle zh, const char *name,
- const char *defaultvalue);
-
-/* select database for update purposes (zebraapi.c) */
-%name(select_database)
-int zebra_select_database (ZebraHandle zh, const char *basename);
-
-/* select databases for record retrieval (zebraapi.c) */
-%name(select_databases)
-int zebra_select_databases (ZebraHandle zh, int num_bases,
- const char **basenames);
-
-
-/* == Transactions, locking, shadow register =============================== */
-
-/* begin transaction (add write lock) (zebraapi.c) */
-%name(begin_trans)
-int zebra_begin_trans (ZebraHandle zh, int rw);
-
-/* end transaction (remove write lock) (zebraapi.c) */
-%name(end_trans)
-void zebra_end_transaction (ZebraHandle zh, ZebraTransactionStatus *stat);
-
-%name(trans_no)
-int zebra_trans_no (ZebraHandle zh);
-
-/* commit changes from shadow (zebraapi.c) */
-%name(commit)
-int zebra_commit (ZebraHandle zh);
-
-/* get shadow status (zebra_api_ext.c) */
-%name(get_shadow_enable)
-int zebra_get_shadow_enable (ZebraHandle zh);
-
-/* set shadow status (zebra_api_ext.c) */
-%name(set_shadow_enable)
-void zebra_set_shadow_enable (ZebraHandle zh, int value);
-
-
-/* == Repository actions (zebraapi.c) ====================================== */
-
-%name(init)
-int zebra_init (ZebraHandle zh);
-
-%name(compact)
-int zebra_compact (ZebraHandle zh);
-
-%name(repository_update)
-void zebra_repository_update (ZebraHandle zh, const char *path);
-
-%name(repository_delete)
-void zebra_repository_delete (ZebraHandle zh, const char *path);
-
-%name(repository_show)
-void zebra_repository_show (ZebraHandle zh, const char *path);
-
-
-/* == Record update/delete (zebra_api_ext.c) =============================== */
-
-/* If sysno is provided, then it's used to identify the reocord.
- If not, and match_criteria is provided, then sysno is guessed
- If not, and a record is provided, then sysno is got from there */
-
-%apply long long *INOUT { long long *sysno };
-
-%name(insert_record)
-int zebra_insert_record (ZebraHandle zh,
- const char *recordType,
- long long *sysno,
- const char *match,
- const char *fname,
- const char *buf,
- int buf_size,
- int force_update);
-/* actually, sysno is only output param in insert_record, but kept */
-/* as inout for symmetry in the interface. The session class assures */
-/* that nothing goes in... */
-
-
-%name(update_record)
-int zebra_update_record (ZebraHandle zh,
- const char *recordType,
- long long *sysno,
- const char *match,
- const char *fname,
- const char *buf,
- int buf_size,
- int force_update);
-
-%name(delete_record)
-int zebra_delete_record (ZebraHandle zh,
- const char *recordType,
- long long *sysno,
- const char *match,
- const char *fname,
- const char *buf,
- int buf_size,
- int force_update);
-
-/* == Search (zebraapi.c) ================================================== */
-%include "typemaps.i"
-%apply int *REFERENCE { int *hits };
-%name(search_PQF)
-int zebra_search_PQF (ZebraHandle zh,
- const char *pqf_query,
- const char *setname,
- int *hits);
-
-/* == YAZ - query tools ==================================================== */
-
-
-cql_transform_t cql_transform_open_fname(const char *fname);
-void cql_transform_close(cql_transform_t ct);
-int cql_transform_error(cql_transform_t ct, const char **addinfo);
-
-%name(cql2pqf)
-int zebra_cql2pqf (cql_transform_t ct,
- const char *query, char *res, int len);
-
-/* == Retrieval (zebra_api_ext.c) ========================================== */
-
-/* will get a 'retrieval obj' (simple enough to pass to perl), which can be
- used to get the individual records. Elementset, schema and format strings
- are threated the same way yaz-client does. */
-void records_retrieve(ZebraHandle zh,
- ODR stream,
- const char *setname, // resultset name
- const char *a_eset, // optional elementset
- const char *a_schema, // optional schema
- const char *a_format, // optional record syntax
- int from, // range, 1 based
- int to,
- RetrievalObj *res
- );
-
-/* fetch a record from the retrieval object. pos is 1 based */
-void record_retrieve(RetrievalObj *ro,
- ODR stream,
- RetrievalRecord *res,
- int pos);
-
-/* Delete Result Set(s) (zebraapi.c) */
-%name(deleteResultSet)
-int zebra_deleleResultSet(ZebraHandle zh, int function,
- int num_setnames, char **setnames,
- int *statuses);
-
-
-/* Resultset terms */
-/* disabled
-%name(resultSetTerms)
-int zebra_resultSetTerms (ZebraHandle zh, const char *setname,
- int no, int *REFERENCE,
- int *REFERENCE, char *out, int *REFERENCE);
-*/
-
-/* == Sort ================================================================= */
-%name(sort)
-int zebra_sort_by_specstr (ZebraHandle zh,
- ODR stream,
- const char *sort_spec,
- const char *output_setname,
- const char **input_setnames
- );
-
-/* == Scan ================================================================= */
-%name(scan_PQF)
-void zebra_scan_PQF (ZebraHandle zh,
- ScanObj *so,
- ODR stream,
- const char *pqf_query);
-
-scanEntry *getScanEntry(ScanObj *so, int pos);
-
-%typemap(in) int * (int dvalue);
-%typemap(argout) int *;
-
-
-/* Admin functionality */
-/*
-%name(admin_start) void zebra_admin_start (ZebraHandle zh);
-%name(admin_shutdown) void zebra_admin_shutdown (ZebraHandle zh);
-*/
-
-
-
-/* do authentication */
-/*
-int zebra_auth (ZebraHandle zh, const char *user, const char *pass);
-
-*/
-
-
-/*
-
-void zebra_result (ZebraHandle zh, int *code, char **addinfo);
-int zebra_resultSetTerms (ZebraHandle zh, const char *setname,
- int no, int *count,
- int *type, char *out, size_t *len);
-*/
-
-/*
-YAZ_EXPORT void zebra_admin_create (ZebraHandle zh, const char *db);
-
-YAZ_EXPORT void zebra_admin_import_begin (ZebraHandle zh, const char *database);
-
-YAZ_EXPORT void zebra_admin_import_segment (ZebraHandle zh,
- Z_Segment *segment);
-
-void zebra_admin_shutdown (ZebraHandle zh);
-void zebra_admin_start (ZebraHandle zh);
-void zebra_admin_import_end (ZebraHandle zh);
-
-
-*/
-
-
-/* =========================================================================
- * NMEM stuff
- * =========================================================================
-*/
-
-NMEM nmem_create (void);
-void nmem_destroy (NMEM handle);
-
-/* =========================================================================
- * Data1 stuff
- * =========================================================================
-*/
-
-typedef enum data1_datatype
-{
- DATA1K_unknown,
- DATA1K_structured,
- DATA1K_string,
- DATA1K_numeric,
- DATA1K_bool,
- DATA1K_oid,
- DATA1K_generalizedtime,
- DATA1K_intunit,
- DATA1K_int,
- DATA1K_octetstring,
- DATA1K_null
-} data1_datatype;
-
-#define DATA1T_numeric 1
-#define DATA1T_string 2
-#define DATA1N_root 1
-#define DATA1N_tag 2
-#define DATA1N_data 3
-#define DATA1N_variant 4
-#define DATA1N_comment 5
-#define DATA1N_preprocess 6
-#define DATA1I_inctxt 1
-#define DATA1I_incbin 2
-#define DATA1I_text 3
-#define DATA1I_num 4
-#define DATA1I_oid 5
-#define DATA1_LOCALDATA 12
-#define DATA1_FLAG_XML 1
-
-data1_handle data1_create (void);
-data1_handle data1_createx (int flags);
-void data1_destroy(data1_handle dh);
-
-/* Data1 node */
-data1_node *get_parent_tag(data1_handle dh, data1_node *n);
-data1_node *data1_read_node(data1_handle dh, const char **buf,NMEM m);
-data1_node *data1_read_nodex (data1_handle dh, NMEM m, int (*get_byte)(void *fh), void *fh, WRBUF wrbuf);
-data1_node *data1_read_record(data1_handle dh, int (*rf)(void *, char *, size_t), void *fh, NMEM m);
-data1_absyn *data1_read_absyn(data1_handle dh, const char *file, int file_must_exist);
-data1_tag *data1_gettagbynum(data1_handle dh, data1_tagset *s, int type, int value);
-
-data1_tagset *data1_empty_tagset (data1_handle dh);
-data1_tagset *data1_read_tagset(data1_handle dh, const char *file, int type);
-data1_element *data1_getelementbytagname(data1_handle dh,
- data1_absyn *abs,
- data1_element *parent,
- const char *tagname);
-
-Z_GenericRecord *data1_nodetogr(data1_handle dh, data1_node *n,
- int select, ODR o,
- int *len);
-
-data1_tag *data1_gettagbyname(data1_handle dh, data1_tagset *s,
- const char *name);
-
-void data1_free_tree(data1_handle dh, data1_node *t);
-
-char *data1_nodetobuf(data1_handle dh, data1_node *n,
- int select, int *len);
-
-data1_node *data1_mk_tag_data_wd(data1_handle dh,
- data1_node *at,
- const char *tagname, NMEM m);
-data1_node *data1_mk_tag_data(data1_handle dh, data1_node *at,
- const char *tagname, NMEM m);
-data1_datatype data1_maptype(data1_handle dh, char *t);
-data1_varset *data1_read_varset(data1_handle dh, const char *file);
-data1_vartype *data1_getvartypebyct(data1_handle dh,
- data1_varset *set,
- char *zclass, char *type);
-Z_Espec1 *data1_read_espec1(data1_handle dh, const char *file);
-int data1_doespec1(data1_handle dh, data1_node *n, Z_Espec1 *e);
-
-data1_esetname *data1_getesetbyname(data1_handle dh,
- data1_absyn *a,
- const char *name);
-data1_element *data1_getelementbyname(data1_handle dh,
- data1_absyn *absyn,
- const char *name);
-data1_node *data1_mk_node2(data1_handle dh, NMEM m,
- int type, data1_node *parent);
-
-data1_node *data1_mk_tag (data1_handle dh, NMEM nmem,
- const char *tag, const char **attr,
- data1_node *at);
-data1_node *data1_mk_tag_n (data1_handle dh, NMEM nmem,
- const char *tag, size_t len,
- const char **attr,
- data1_node *at);
-void data1_tag_add_attr (data1_handle dh, NMEM nmem,
- data1_node *res, const char **attr);
-
-data1_node *data1_mk_text_n (data1_handle dh, NMEM mem,
- const char *buf, size_t len,
- data1_node *parent);
-data1_node *data1_mk_text_nf (data1_handle dh, NMEM mem,
- const char *buf, size_t len,
- data1_node *parent);
-data1_node *data1_mk_text (data1_handle dh, NMEM mem,
- const char *buf, data1_node *parent);
-
-data1_node *data1_mk_comment_n (data1_handle dh, NMEM mem,
- const char *buf, size_t len,
- data1_node *parent);
-
-data1_node *data1_mk_comment (data1_handle dh, NMEM mem,
- const char *buf, data1_node *parent);
-
-data1_node *data1_mk_preprocess (data1_handle dh, NMEM nmem,
- const char *target,
- const char **attr,
- data1_node *at);
-
-data1_node *data1_mk_root (data1_handle dh, NMEM nmem,
- const char *name);
-void data1_set_root(data1_handle dh, data1_node *res,
- NMEM nmem, const char *name);
-
-data1_node *data1_mk_tag_data_int (data1_handle dh, data1_node *at,
- const char *tag, int num,
- NMEM nmem);
-data1_node *data1_mk_tag_data_oid (data1_handle dh, data1_node *at,
- const char *tag, Odr_oid *oid,
- NMEM nmem);
-data1_node *data1_mk_tag_data_text (data1_handle dh, data1_node *at,
- const char *tag,
- const char *str,
- NMEM nmem);
-data1_node *data1_mk_tag_data_text_uni (data1_handle dh,
- data1_node *at,
- const char *tag,
- const char *str,
- NMEM nmem);
-
-data1_absyn *data1_get_absyn (data1_handle dh, const char *name);
-
-data1_node *data1_search_tag (data1_handle dh, data1_node *n,
- const char *tag);
-data1_node *data1_mk_tag_uni (data1_handle dh, NMEM nmem,
- const char *tag, data1_node *at);
-data1_attset *data1_get_attset (data1_handle dh, const char *name);
-data1_maptab *data1_read_maptab(data1_handle dh, const char *file);
-data1_node *data1_map_record(data1_handle dh, data1_node *n,
- data1_maptab *map, NMEM m);
-data1_marctab *data1_read_marctab (data1_handle dh,
- const char *file);
-char *data1_nodetomarc(data1_handle dh, data1_marctab *p,
- data1_node *n, int selected, int *len);
-char *data1_nodetoidsgml(data1_handle dh, data1_node *n,
- int select, int *len);
-Z_ExplainRecord *data1_nodetoexplain(data1_handle dh,
- data1_node *n, int select,
- ODR o);
-Z_BriefBib *data1_nodetosummary(data1_handle dh,
- data1_node *n, int select,
- ODR o);
-char *data1_nodetosoif(data1_handle dh, data1_node *n, int select,
- int *len);
-WRBUF data1_get_wrbuf (data1_handle dp);
-char **data1_get_read_buf (data1_handle dp, int **lenp);
-char **data1_get_map_buf (data1_handle dp, int **lenp);
-data1_absyn_cache *data1_absyn_cache_get (data1_handle dh);
-data1_attset_cache *data1_attset_cache_get (data1_handle dh);
-NMEM data1_nmem_get (data1_handle dh);
-
-void data1_pr_tree (data1_handle dh, data1_node *n, FILE *out);
-void data1_print_tree (data1_handle dh, data1_node *n);
-
-
-char *data1_insert_string (data1_handle dh, data1_node *res,
- NMEM m, const char *str);
-char *data1_insert_string_n (data1_handle dh, data1_node *res,
- NMEM m, const char *str, size_t len);
-data1_node *data1_read_sgml (data1_handle dh, NMEM m,
- const char *buf);
-/*
-data1_node *data1_read_xml (data1_handle dh,
- int (*rf)(void *, char *, size_t),
- void *fh, NMEM m);
-*/
-void data1_absyn_trav (data1_handle dh, void *handle,
- void (*fh)(data1_handle dh,
- void *h, data1_absyn *a));
-
-data1_attset *data1_attset_search_id (data1_handle dh, int id);
-
-char *data1_getNodeValue(data1_node* node, char* pTagPath);
-data1_node *data1_LookupNode(data1_node* node, char* pTagPath);
-int data1_CountOccurences(data1_node* node, char* pTagPath);
-
-
-FILE *data1_path_fopen (data1_handle dh, const char *file,
- const char *mode);
-void data1_set_tabpath(data1_handle dh, const char *path);
-void data1_set_tabroot (data1_handle dp, const char *p);
-const char *data1_get_tabpath(data1_handle dh);
-const char *data1_get_tabroot(data1_handle dh);
-
-
-
-/* =========================================================================
- * Filter stuff
- * =========================================================================
- */
-int grs_perl_readf(struct perl_context *context, size_t len);
-int grs_perl_readline(struct perl_context *context);
-char grs_perl_getc(struct perl_context *context);
-off_t grs_perl_seekf(struct perl_context *context, off_t offset);
-off_t grs_perl_tellf(struct perl_context *context);
-void grs_perl_endf(struct perl_context *context, off_t offset);
-
-data1_handle *grs_perl_get_dh(struct perl_context *context);
-NMEM *grs_perl_get_mem(struct perl_context *context);
-void grs_perl_set_res(struct perl_context *context, data1_node *n);
-
+++ /dev/null
-IDZebra_wrap.c
-MANIFEST
-Makefile.PL
-Makefile.PL.in
-README
-demo/cql.map
-demo/filter_test.pl
-demo/index.sh
-demo/pod.abs
-demo/pod.pm
-demo/zebra.cfg
-lib/IDZebra.pm
-lib/IDZebra/Data1.pm
-lib/IDZebra/Filter.pm
-lib/IDZebra/Logger.pm
-lib/IDZebra/Resultset.pm
-lib/IDZebra/RetrievalRecord.pm
-lib/IDZebra/ScanEntry.pm
-lib/IDZebra/ScanList.pm
-lib/IDZebra/Session.pm
-t/01_base.t
-t/02_directory_update.t
-t/03_record_update.t
-t/04_cql.t
-t/05_search.t
-t/06_retrieval.t
-t/07_sort.t
-t/08_scan.t
-zebra_perl.c
-zebra_perl.h
-IDZebra.i
-doswig
+++ /dev/null
-use ExtUtils::MakeMaker;
-
-my $libs = `../idzebra-config --libs`;
-my $flags = `../idzebra-config --cflags`;
-WriteMakefile(
- 'NAME' => 'IDZebra',
- 'OBJECT' => 'IDZebra_wrap.o zebra_perl.o' ,
- 'INC' => $flags,
- 'LIBS' => [$libs],
- 'OPTIMIZE' => '-g',
-# 'PREREQ_FATAL' => 1,
- 'PREREQ_PM' => {
- 'Scalar::Util' => '1.0',
- 'Test::More' => '0.40',
- }
-
- );
-
-sub MY::postamble {
-'IDZebra_wrap.c: IDZebra.i
- ./doswig'
- ;
-}
-
-
+++ /dev/null
-IDZebra - Perl API for IndexData Zebra database server
-
-IDZebra package is distributed as a module, but also included in Zebra
-source distribution.
-
-To compile this extension, run:
-
- perl Makefile.PL
- make
-
-To test:
-
- make test
-
-or
-
- make test TEST_VERBOSE=1
-
-If the tests were successfull, you may want to:
-
- make install
-
-There is an embeded POD manual page in lib/IDZebra/Session.pm.
-
-The original author of the module is Peter Popovics <pop@technomat.hu>.
-The maintenance is done by IndexData. (http://www.indexdata.dk), you may
-subscribe to zebralist@indexdata.dk.
-
+++ /dev/null
-set.cql = info:srw/cql-context-set/1/cql-v1.1
-set.dc = info:srw/cql-context-set/1/dc-v1.1
-set = info:srw/cql-context-set/1/dc-v1.1
-
-
-index.cql.serverChoice = 1=1016
-index.dc.title = 1=4
-index.dc.subject = 1=21
-
-relation.< = 2=1
-relation.le = 2=2
-relation.eq = 2=3
-relation.ge = 2=4
-relation.> = 2=5
-relation.scr = 2=3
-
-position.any = 3=3 6=1
-
-structure.* = 4=1
-
-truncation.right = 5=1
-truncation.left = 5=2
-truncation.both = 5=3
-truncation.none = 5=100
-truncation.z3958 = 5=104
-
+++ /dev/null
-#!/usr/bin/perl
-
-BEGIN {
- push (@INC,'../blib/lib','../blib/arch','../blib/lib');
-}
-
-use pod;
-
-$res =pod->test($ARGV[0],
- (tabPath=>'../blib/lib:../blib/arch:../blib/lib:.:../../tab:../../../yaz/tab'));
+++ /dev/null
-#!/bin/sh
-if test ! -f demo/zebra.cfg; then
- echo "Expected to find demo/zebra.cfg"
- exit 1
-fi
-test -d demo/register || mkdir demo/register
-test -d demo/lock || mkdir demo/lock
-test -d demo/tmp || mkdir demo/tmp
-test -d demo/shadow || mkdir demo/shadow
-
-../index/zebraidx -c demo/zebra.cfg init
-../index/zebraidx -c demo/zebra.cfg -g demo1 -n update /usr/lib/perl5
+++ /dev/null
-# A sample abstract syntax file for the perl filter
-
-name pod
-attset bib1.att
-tagset meta.tag
-varset var1.var
-
-esetname F @
-esetname B meta-b.est
-
-maptab meta-usmarc.map
-
-# These tags are required by Zebra for GRS-1 generation
-elm (1,10) rank -
-elm (1,14) localControlNumber Local-number
-elm name NAME Title:p,Title:w,Any,Title:s
-elm description description Any
+++ /dev/null
-#!/usr/bin/perl
-use strict;
-# ----------------------------------------------------------------------------
-# A dummy example to demonstrate perl filters for zebra. This is going to
-# extract information from the .pm perl module files.
-# ----------------------------------------------------------------------------
-package pod;
-
-use IDZebra::Filter;
-use IDZebra::Data1;
-use Pod::Text;
-use Symbol qw(gensym);
-our @ISA=qw(IDZebra::Filter);
-1;
-
-
-sub init {
- # Initialization code may come here
-}
-
-sub process {
- my ($self, $d1) = @_;
-
- my $tempfile_in = "/tmp/strucc.in";
- my $tempfile_out = "/tmp/strucc.out";
- my $parser = Pod::Text->new (sentence => 0, width => 78);
-
- my $r1=$d1->mk_root('pod');
- my $root=$d1->mk_tag($r1,'pod');
-
- # Get the input "file handle"
- my $inf = $self->get_fh;
-
- # Create a funny output "file handle"
- my $outf = gensym;
- tie (*$outf,'MemFile');
-
- $parser->parse_from_filehandle ($inf, $outf);
-
- my $section;
- my $data;
- while(<$outf>) {
- chomp;
- if (/^([A-Z]+)\s*$/) {
- my $ss = $1;
- if ($section) {
- my $tag = $d1->mk_tag($root,$section);
- $d1->mk_text($tag,$data) if ($data);
- }
- $section = $ss;
- $data = "";
- next;
- }
- s/^\s+|\s+$//g;
- $data.="$_\n";
- }
-
- if ($section) {
- my $tag = $d1->mk_tag($root,$section);
- $d1->mk_text($tag,$data) if ($data);
- }
- return ($r1);
-}
-
-# ----------------------------------------------------------------------------
-# Package to collect data as an output file from stupid modules, who can only
-# write to files...
-# ----------------------------------------------------------------------------
-package MemFile;
-
-sub TIEHANDLE {
- my $class = shift;
- my $self = {};
- bless ($self,$class);
- $self->{buff} = "";
- return ($self);
-}
-
-sub PRINT {
- my $self = shift;
- for (@_) {
- $self->{buff} .= $_;
- }
-}
-
-sub READLINE {
- my $self = shift;
- my $res;
- return (undef) unless ($self->{buff});
- ($res,$self->{buff}) = split (/\n/,$self->{buff},2);
- return ($res."\n");
-}
+++ /dev/null
-# Simple zebra configuration file to demonstate the usage of the perl filters
-
-profilePath: blib/lib:blib/arch:blib/lib:demo/:../tab:../../yaz/tab
-
-modulePath: /home/adam/proj/zebra/recctrl/.libs
-
-# Files that describe the attribute sets supported.
-attset: bib1.att
-attset: explain.att
-
-register: demo/register:100M
-#shadow: demo/shadow:100M
-
-lockDir: demo/lock
-setTmpDir: demo/tmp
-keyTmpDir: demo/tmp
-memMax: 1
-
-
-demo1.recordType.pm: grs.perl.pod
-demo1.recordId: $database (bib1,Title)
-demo1.database: demo1
-demo1.storeKeys: 1
-demo1.storeData: 1
-
-demo2.recordType.pm: grs.perl.pod
-demo2.recordId: (bib1,Title)
-demo2.database: demo2
-demo2.storeKeys: 1
-demo2.storeData: 1
-
-isam:b
+++ /dev/null
-#!/bin/sh
-rm *~*
-rm *wrap*
+++ /dev/null
-#!/bin/sh
-swig -I../include -v -Wall -perl5 -proxy ./IDZebra.i
-mv IDZebra.pm lib/
+++ /dev/null
-# This file was automatically generated by SWIG
-package IDZebra;
-require Exporter;
-require DynaLoader;
-@ISA = qw(Exporter DynaLoader);
-package IDZebrac;
-bootstrap IDZebra;
-package IDZebra;
-@EXPORT = qw( );
-
-# ---------- BASE METHODS -------------
-
-package IDZebra;
-
-sub TIEHASH {
- my ($classname,$obj) = @_;
- return bless $obj, $classname;
-}
-
-sub CLEAR { }
-
-sub FIRSTKEY { }
-
-sub NEXTKEY { }
-
-sub FETCH {
- my ($self,$field) = @_;
- my $member_func = "swig_${field}_get";
- $self->$member_func();
-}
-
-sub STORE {
- my ($self,$field,$newval) = @_;
- my $member_func = "swig_${field}_set";
- $self->$member_func($newval);
-}
-
-sub this {
- my $ptr = shift;
- return tied(%$ptr);
-}
-
-
-# ------- FUNCTION WRAPPERS --------
-
-package IDZebra;
-
-*DESTROY = *IDZebrac::DESTROY;
-*logLevel = *IDZebrac::logLevel;
-*logFile = *IDZebrac::logFile;
-*logMsg = *IDZebrac::logMsg;
-*logPrefix = *IDZebrac::logPrefix;
-*logPrefix2 = *IDZebrac::logPrefix2;
-*odr_createmem = *IDZebrac::odr_createmem;
-*odr_reset = *IDZebrac::odr_reset;
-*odr_destroy = *IDZebrac::odr_destroy;
-*odr_malloc = *IDZebrac::odr_malloc;
-*start = *IDZebrac::start;
-*open = *IDZebrac::open;
-*close = *IDZebrac::close;
-*stop = *IDZebrac::stop;
-*errCode = *IDZebrac::errCode;
-*errString = *IDZebrac::errString;
-*errAdd = *IDZebrac::errAdd;
-*set_resource = *IDZebrac::set_resource;
-*get_resource = *IDZebrac::get_resource;
-*select_database = *IDZebrac::select_database;
-*select_databases = *IDZebrac::select_databases;
-*begin_trans = *IDZebrac::begin_trans;
-*end_trans = *IDZebrac::end_trans;
-*trans_no = *IDZebrac::trans_no;
-*commit = *IDZebrac::commit;
-*get_shadow_enable = *IDZebrac::get_shadow_enable;
-*set_shadow_enable = *IDZebrac::set_shadow_enable;
-*init = *IDZebrac::init;
-*compact = *IDZebrac::compact;
-*repository_update = *IDZebrac::repository_update;
-*repository_delete = *IDZebrac::repository_delete;
-*repository_show = *IDZebrac::repository_show;
-*insert_record = *IDZebrac::insert_record;
-*update_record = *IDZebrac::update_record;
-*delete_record = *IDZebrac::delete_record;
-*search_PQF = *IDZebrac::search_PQF;
-*cql_transform_open_fname = *IDZebrac::cql_transform_open_fname;
-*cql_transform_close = *IDZebrac::cql_transform_close;
-*cql_transform_error = *IDZebrac::cql_transform_error;
-*cql2pqf = *IDZebrac::cql2pqf;
-*records_retrieve = *IDZebrac::records_retrieve;
-*record_retrieve = *IDZebrac::record_retrieve;
-*deleteResultSet = *IDZebrac::deleteResultSet;
-*sort = *IDZebrac::sort;
-*scan_PQF = *IDZebrac::scan_PQF;
-*getScanEntry = *IDZebrac::getScanEntry;
-*nmem_create = *IDZebrac::nmem_create;
-*nmem_destroy = *IDZebrac::nmem_destroy;
-*data1_create = *IDZebrac::data1_create;
-*data1_createx = *IDZebrac::data1_createx;
-*data1_destroy = *IDZebrac::data1_destroy;
-*get_parent_tag = *IDZebrac::get_parent_tag;
-*data1_read_node = *IDZebrac::data1_read_node;
-*data1_read_nodex = *IDZebrac::data1_read_nodex;
-*data1_read_record = *IDZebrac::data1_read_record;
-*data1_read_absyn = *IDZebrac::data1_read_absyn;
-*data1_gettagbynum = *IDZebrac::data1_gettagbynum;
-*data1_empty_tagset = *IDZebrac::data1_empty_tagset;
-*data1_read_tagset = *IDZebrac::data1_read_tagset;
-*data1_getelementbytagname = *IDZebrac::data1_getelementbytagname;
-*data1_nodetogr = *IDZebrac::data1_nodetogr;
-*data1_gettagbyname = *IDZebrac::data1_gettagbyname;
-*data1_free_tree = *IDZebrac::data1_free_tree;
-*data1_nodetobuf = *IDZebrac::data1_nodetobuf;
-*data1_mk_tag_data_wd = *IDZebrac::data1_mk_tag_data_wd;
-*data1_mk_tag_data = *IDZebrac::data1_mk_tag_data;
-*data1_maptype = *IDZebrac::data1_maptype;
-*data1_read_varset = *IDZebrac::data1_read_varset;
-*data1_getvartypebyct = *IDZebrac::data1_getvartypebyct;
-*data1_read_espec1 = *IDZebrac::data1_read_espec1;
-*data1_doespec1 = *IDZebrac::data1_doespec1;
-*data1_getesetbyname = *IDZebrac::data1_getesetbyname;
-*data1_getelementbyname = *IDZebrac::data1_getelementbyname;
-*data1_mk_node2 = *IDZebrac::data1_mk_node2;
-*data1_mk_tag = *IDZebrac::data1_mk_tag;
-*data1_mk_tag_n = *IDZebrac::data1_mk_tag_n;
-*data1_tag_add_attr = *IDZebrac::data1_tag_add_attr;
-*data1_mk_text_n = *IDZebrac::data1_mk_text_n;
-*data1_mk_text_nf = *IDZebrac::data1_mk_text_nf;
-*data1_mk_text = *IDZebrac::data1_mk_text;
-*data1_mk_comment_n = *IDZebrac::data1_mk_comment_n;
-*data1_mk_comment = *IDZebrac::data1_mk_comment;
-*data1_mk_preprocess = *IDZebrac::data1_mk_preprocess;
-*data1_mk_root = *IDZebrac::data1_mk_root;
-*data1_set_root = *IDZebrac::data1_set_root;
-*data1_mk_tag_data_int = *IDZebrac::data1_mk_tag_data_int;
-*data1_mk_tag_data_oid = *IDZebrac::data1_mk_tag_data_oid;
-*data1_mk_tag_data_text = *IDZebrac::data1_mk_tag_data_text;
-*data1_mk_tag_data_text_uni = *IDZebrac::data1_mk_tag_data_text_uni;
-*data1_get_absyn = *IDZebrac::data1_get_absyn;
-*data1_search_tag = *IDZebrac::data1_search_tag;
-*data1_mk_tag_uni = *IDZebrac::data1_mk_tag_uni;
-*data1_get_attset = *IDZebrac::data1_get_attset;
-*data1_read_maptab = *IDZebrac::data1_read_maptab;
-*data1_map_record = *IDZebrac::data1_map_record;
-*data1_read_marctab = *IDZebrac::data1_read_marctab;
-*data1_nodetomarc = *IDZebrac::data1_nodetomarc;
-*data1_nodetoidsgml = *IDZebrac::data1_nodetoidsgml;
-*data1_nodetoexplain = *IDZebrac::data1_nodetoexplain;
-*data1_nodetosummary = *IDZebrac::data1_nodetosummary;
-*data1_nodetosoif = *IDZebrac::data1_nodetosoif;
-*data1_get_wrbuf = *IDZebrac::data1_get_wrbuf;
-*data1_get_read_buf = *IDZebrac::data1_get_read_buf;
-*data1_get_map_buf = *IDZebrac::data1_get_map_buf;
-*data1_absyn_cache_get = *IDZebrac::data1_absyn_cache_get;
-*data1_attset_cache_get = *IDZebrac::data1_attset_cache_get;
-*data1_nmem_get = *IDZebrac::data1_nmem_get;
-*data1_pr_tree = *IDZebrac::data1_pr_tree;
-*data1_print_tree = *IDZebrac::data1_print_tree;
-*data1_insert_string = *IDZebrac::data1_insert_string;
-*data1_insert_string_n = *IDZebrac::data1_insert_string_n;
-*data1_read_sgml = *IDZebrac::data1_read_sgml;
-*data1_absyn_trav = *IDZebrac::data1_absyn_trav;
-*data1_attset_search_id = *IDZebrac::data1_attset_search_id;
-*data1_getNodeValue = *IDZebrac::data1_getNodeValue;
-*data1_LookupNode = *IDZebrac::data1_LookupNode;
-*data1_CountOccurences = *IDZebrac::data1_CountOccurences;
-*data1_path_fopen = *IDZebrac::data1_path_fopen;
-*data1_set_tabpath = *IDZebrac::data1_set_tabpath;
-*data1_set_tabroot = *IDZebrac::data1_set_tabroot;
-*data1_get_tabpath = *IDZebrac::data1_get_tabpath;
-*data1_get_tabroot = *IDZebrac::data1_get_tabroot;
-*grs_perl_readf = *IDZebrac::grs_perl_readf;
-*grs_perl_readline = *IDZebrac::grs_perl_readline;
-*grs_perl_getc = *IDZebrac::grs_perl_getc;
-*grs_perl_seekf = *IDZebrac::grs_perl_seekf;
-*grs_perl_tellf = *IDZebrac::grs_perl_tellf;
-*grs_perl_endf = *IDZebrac::grs_perl_endf;
-*grs_perl_get_dh = *IDZebrac::grs_perl_get_dh;
-*grs_perl_get_mem = *IDZebrac::grs_perl_get_mem;
-*grs_perl_set_res = *IDZebrac::grs_perl_set_res;
-
-############# Class : IDZebra::RetrievalObj ##############
-
-package IDZebra::RetrievalObj;
-@ISA = qw( IDZebra );
-%OWNER = ();
-%ITERATORS = ();
-*swig_noOfRecords_get = *IDZebrac::RetrievalObj_noOfRecords_get;
-*swig_noOfRecords_set = *IDZebrac::RetrievalObj_noOfRecords_set;
-*swig_records_get = *IDZebrac::RetrievalObj_records_get;
-*swig_records_set = *IDZebrac::RetrievalObj_records_set;
-sub new {
- my $pkg = shift;
- my $self = IDZebrac::new_RetrievalObj(@_);
- bless $self, $pkg if defined($self);
-}
-
-sub DESTROY {
- return unless $_[0]->isa('HASH');
- my $self = tied(%{$_[0]});
- return unless defined $self;
- delete $ITERATORS{$self};
- if (exists $OWNER{$self}) {
- IDZebrac::delete_RetrievalObj($self);
- delete $OWNER{$self};
- }
-}
-
-sub DISOWN {
- my $self = shift;
- my $ptr = tied(%$self);
- delete $OWNER{$ptr};
-}
-
-sub ACQUIRE {
- my $self = shift;
- my $ptr = tied(%$self);
- $OWNER{$ptr} = 1;
-}
-
-
-############# Class : IDZebra::RetrievalRecord ##############
-
-package IDZebra::RetrievalRecord;
-@ISA = qw( IDZebra );
-%OWNER = ();
-%ITERATORS = ();
-*swig_errCode_get = *IDZebrac::RetrievalRecord_errCode_get;
-*swig_errCode_set = *IDZebrac::RetrievalRecord_errCode_set;
-*swig_errString_get = *IDZebrac::RetrievalRecord_errString_get;
-*swig_errString_set = *IDZebrac::RetrievalRecord_errString_set;
-*swig_position_get = *IDZebrac::RetrievalRecord_position_get;
-*swig_position_set = *IDZebrac::RetrievalRecord_position_set;
-*swig_base_get = *IDZebrac::RetrievalRecord_base_get;
-*swig_base_set = *IDZebrac::RetrievalRecord_base_set;
-*swig_sysno_get = *IDZebrac::RetrievalRecord_sysno_get;
-*swig_sysno_set = *IDZebrac::RetrievalRecord_sysno_set;
-*swig_score_get = *IDZebrac::RetrievalRecord_score_get;
-*swig_score_set = *IDZebrac::RetrievalRecord_score_set;
-*swig_format_get = *IDZebrac::RetrievalRecord_format_get;
-*swig_format_set = *IDZebrac::RetrievalRecord_format_set;
-*swig_buf_get = *IDZebrac::RetrievalRecord_buf_get;
-*swig_buf_set = *IDZebrac::RetrievalRecord_buf_set;
-sub new {
- my $pkg = shift;
- my $self = IDZebrac::new_RetrievalRecord(@_);
- bless $self, $pkg if defined($self);
-}
-
-sub DESTROY {
- return unless $_[0]->isa('HASH');
- my $self = tied(%{$_[0]});
- return unless defined $self;
- delete $ITERATORS{$self};
- if (exists $OWNER{$self}) {
- IDZebrac::delete_RetrievalRecord($self);
- delete $OWNER{$self};
- }
-}
-
-sub DISOWN {
- my $self = shift;
- my $ptr = tied(%$self);
- delete $OWNER{$ptr};
-}
-
-sub ACQUIRE {
- my $self = shift;
- my $ptr = tied(%$self);
- $OWNER{$ptr} = 1;
-}
-
-
-############# Class : IDZebra::scanEntry ##############
-
-package IDZebra::scanEntry;
-@ISA = qw( IDZebra );
-%OWNER = ();
-%ITERATORS = ();
-*swig_occurrences_get = *IDZebrac::scanEntry_occurrences_get;
-*swig_occurrences_set = *IDZebrac::scanEntry_occurrences_set;
-*swig_term_get = *IDZebrac::scanEntry_term_get;
-*swig_term_set = *IDZebrac::scanEntry_term_set;
-sub new {
- my $pkg = shift;
- my $self = IDZebrac::new_scanEntry(@_);
- bless $self, $pkg if defined($self);
-}
-
-sub DESTROY {
- return unless $_[0]->isa('HASH');
- my $self = tied(%{$_[0]});
- return unless defined $self;
- delete $ITERATORS{$self};
- if (exists $OWNER{$self}) {
- IDZebrac::delete_scanEntry($self);
- delete $OWNER{$self};
- }
-}
-
-sub DISOWN {
- my $self = shift;
- my $ptr = tied(%$self);
- delete $OWNER{$ptr};
-}
-
-sub ACQUIRE {
- my $self = shift;
- my $ptr = tied(%$self);
- $OWNER{$ptr} = 1;
-}
-
-
-############# Class : IDZebra::ScanObj ##############
-
-package IDZebra::ScanObj;
-@ISA = qw( IDZebra );
-%OWNER = ();
-%ITERATORS = ();
-*swig_num_entries_get = *IDZebrac::ScanObj_num_entries_get;
-*swig_num_entries_set = *IDZebrac::ScanObj_num_entries_set;
-*swig_position_get = *IDZebrac::ScanObj_position_get;
-*swig_position_set = *IDZebrac::ScanObj_position_set;
-*swig_is_partial_get = *IDZebrac::ScanObj_is_partial_get;
-*swig_is_partial_set = *IDZebrac::ScanObj_is_partial_set;
-*swig_entries_get = *IDZebrac::ScanObj_entries_get;
-*swig_entries_set = *IDZebrac::ScanObj_entries_set;
-sub new {
- my $pkg = shift;
- my $self = IDZebrac::new_ScanObj(@_);
- bless $self, $pkg if defined($self);
-}
-
-sub DESTROY {
- return unless $_[0]->isa('HASH');
- my $self = tied(%{$_[0]});
- return unless defined $self;
- delete $ITERATORS{$self};
- if (exists $OWNER{$self}) {
- IDZebrac::delete_ScanObj($self);
- delete $OWNER{$self};
- }
-}
-
-sub DISOWN {
- my $self = shift;
- my $ptr = tied(%$self);
- delete $OWNER{$ptr};
-}
-
-sub ACQUIRE {
- my $self = shift;
- my $ptr = tied(%$self);
- $OWNER{$ptr} = 1;
-}
-
-
-############# Class : IDZebra::ZebraTransactionStatus ##############
-
-package IDZebra::ZebraTransactionStatus;
-@ISA = qw( IDZebra );
-%OWNER = ();
-%ITERATORS = ();
-*swig_processed_get = *IDZebrac::ZebraTransactionStatus_processed_get;
-*swig_processed_set = *IDZebrac::ZebraTransactionStatus_processed_set;
-*swig_inserted_get = *IDZebrac::ZebraTransactionStatus_inserted_get;
-*swig_inserted_set = *IDZebrac::ZebraTransactionStatus_inserted_set;
-*swig_updated_get = *IDZebrac::ZebraTransactionStatus_updated_get;
-*swig_updated_set = *IDZebrac::ZebraTransactionStatus_updated_set;
-*swig_deleted_get = *IDZebrac::ZebraTransactionStatus_deleted_get;
-*swig_deleted_set = *IDZebrac::ZebraTransactionStatus_deleted_set;
-*swig_utime_get = *IDZebrac::ZebraTransactionStatus_utime_get;
-*swig_utime_set = *IDZebrac::ZebraTransactionStatus_utime_set;
-*swig_stime_get = *IDZebrac::ZebraTransactionStatus_stime_get;
-*swig_stime_set = *IDZebrac::ZebraTransactionStatus_stime_set;
-sub new {
- my $pkg = shift;
- my $self = IDZebrac::new_ZebraTransactionStatus(@_);
- bless $self, $pkg if defined($self);
-}
-
-sub DESTROY {
- return unless $_[0]->isa('HASH');
- my $self = tied(%{$_[0]});
- return unless defined $self;
- delete $ITERATORS{$self};
- if (exists $OWNER{$self}) {
- IDZebrac::delete_ZebraTransactionStatus($self);
- delete $OWNER{$self};
- }
-}
-
-sub DISOWN {
- my $self = shift;
- my $ptr = tied(%$self);
- delete $OWNER{$ptr};
-}
-
-sub ACQUIRE {
- my $self = shift;
- my $ptr = tied(%$self);
- $OWNER{$ptr} = 1;
-}
-
-
-# ------- VARIABLE STUBS --------
-
-package IDZebra;
-
-*LOG_FATAL = *IDZebrac::LOG_FATAL;
-*LOG_DEBUG = *IDZebrac::LOG_DEBUG;
-*LOG_WARN = *IDZebrac::LOG_WARN;
-*LOG_LOG = *IDZebrac::LOG_LOG;
-*LOG_ERRNO = *IDZebrac::LOG_ERRNO;
-*LOG_FILE = *IDZebrac::LOG_FILE;
-*LOG_APP = *IDZebrac::LOG_APP;
-*LOG_MALLOC = *IDZebrac::LOG_MALLOC;
-*LOG_ALL = *IDZebrac::LOG_ALL;
-*LOG_DEFAULT_LEVEL = *IDZebrac::LOG_DEFAULT_LEVEL;
-*ODR_DECODE = *IDZebrac::ODR_DECODE;
-*ODR_ENCODE = *IDZebrac::ODR_ENCODE;
-*ODR_PRINT = *IDZebrac::ODR_PRINT;
-*DATA1K_unknown = *IDZebrac::DATA1K_unknown;
-*DATA1K_structured = *IDZebrac::DATA1K_structured;
-*DATA1K_string = *IDZebrac::DATA1K_string;
-*DATA1K_numeric = *IDZebrac::DATA1K_numeric;
-*DATA1K_bool = *IDZebrac::DATA1K_bool;
-*DATA1K_oid = *IDZebrac::DATA1K_oid;
-*DATA1K_generalizedtime = *IDZebrac::DATA1K_generalizedtime;
-*DATA1K_intunit = *IDZebrac::DATA1K_intunit;
-*DATA1K_int = *IDZebrac::DATA1K_int;
-*DATA1K_octetstring = *IDZebrac::DATA1K_octetstring;
-*DATA1K_null = *IDZebrac::DATA1K_null;
-*DATA1T_numeric = *IDZebrac::DATA1T_numeric;
-*DATA1T_string = *IDZebrac::DATA1T_string;
-*DATA1N_root = *IDZebrac::DATA1N_root;
-*DATA1N_tag = *IDZebrac::DATA1N_tag;
-*DATA1N_data = *IDZebrac::DATA1N_data;
-*DATA1N_variant = *IDZebrac::DATA1N_variant;
-*DATA1N_comment = *IDZebrac::DATA1N_comment;
-*DATA1N_preprocess = *IDZebrac::DATA1N_preprocess;
-*DATA1I_inctxt = *IDZebrac::DATA1I_inctxt;
-*DATA1I_incbin = *IDZebrac::DATA1I_incbin;
-*DATA1I_text = *IDZebrac::DATA1I_text;
-*DATA1I_num = *IDZebrac::DATA1I_num;
-*DATA1I_oid = *IDZebrac::DATA1I_oid;
-*DATA1_LOCALDATA = *IDZebrac::DATA1_LOCALDATA;
-*DATA1_FLAG_XML = *IDZebrac::DATA1_FLAG_XML;
-1;
+++ /dev/null
-#!/usr/bin/perl
-# ============================================================================
-# Zebra perl API header
-# =============================================================================
-use strict;
-use Carp;
-# =============================================================================
-package IDZebra::Data1;
-use IDZebra;
-1;
-
-# -----------------------------------------------------------------------------
-# Class constructors and destructor
-# -----------------------------------------------------------------------------
-sub get {
- my ($proto, $handle, $mem) = @_;
- my $class = ref($proto) || $proto;
- my $self = {};
- bless ($self,$class);
-
- $self->{dh} = $handle;
- $self->{mem} = $mem;
- # data1_destroy is not going to be called, when object is released
- $self->{dflag} = 0;
-
- return ($self);
-}
-
-sub new {
- my ($proto, $mem, $flag) = @_;
- my $class = ref($proto) || $proto;
- my $self = {};
-
- bless ($self,$class);
-
- unless ($self->{dh} = IDZebra::data1_createx($flag)) {
- croak ("Cannot create data1 handle");
- }
-
- # data1_destroy going to be called, when object is released
- $self->{dflag} = 1;
-
- unless ($self->{mem} = $mem) {
- croak ("Missing NMEM handle");
- }
-
- return ($self);
-}
-
-sub DESTROY {
- my $self = shift;
- if ($self->{dh}) {
- if ($self->{dflag}) { IDZebra::data1_destroy($self->{dh}) }
- $self->{dh} = undef;
- }
-}
-
-# -----------------------------------------------------------------------------
-# Profile information
-# -----------------------------------------------------------------------------
-# Not usable...
-sub path_fopen {
- my ($self, $file, $mode) = @_;
- return (IDZebra::data1_path_fopen ($self->{dh}, $file, $mode));
-}
-
-sub tabpath {
- my ($self, $path) = @_;
- if (defined($path)) { IDZebra::data1_set_tabpath($self->{dh}, $path); }
- return (IDZebra::data1_get_tabpath($self->{dh}));
-}
-
-sub tabroot {
- my ($self, $path) = @_;
- if (defined($path)) { IDZebra::data1_set_tabroot($self->{dh}, $path); }
- return (IDZebra::data1_get_tabroot($self->{dh}));
-}
-
-# -----------------------------------------------------------------------------
-# D1 Structure manipulation
-# -----------------------------------------------------------------------------
-sub mk_root {
- my ($self, $name) = @_;
- return (IDZebra::data1_mk_root($self->{dh}, $self->{mem}, $name));
-}
-
-sub set_root {
- my ($self, $node, $name) = @_;
- IDZebra::data1_set_root($self->{dh}, $node, $self->{mem}, $name);
-}
-
-sub mk_tag {
- my ($self, $parent, $tag, @attributes) = @_;
- return (IDZebra::data1_mk_tag($self->{dh}, $self->{mem},
- $tag, \@attributes, $parent));
-}
-
-sub tag_add_attr {
- my ($self, $node, @attributes) = @_;
- IDZebra::data1_tag_add_attr ($self->{dh}, $self->{mem},
- $node, \@attributes);
-}
-
-sub mk_text {
- my ($self, $parent, $text) = @_;
- $text = "" unless defined ($text);
- return (IDZebra::data1_mk_text($self->{dh}, $self->{mem},
- $text, $parent));
-}
-
-sub mk_comment {
- my ($self, $parent, $text) = @_;
- return (IDZebra::data1_mk_comment($self->{dh}, $self->{mem},
- $text, $parent));
-}
-
-sub mk_preprocess {
- my ($self, $parent, $target, @attributes) = @_;
- return (IDZebra::data1_mk_preprocess($self->{dh}, $self->{mem},
- $target, \@attributes, $parent));
-}
-
-
-sub pr_tree {
- my ($self, $node) = @_;
- IDZebra::data1_print_tree($self->{dh}, $node);
-}
-
-sub free_tree {
- my ($self, $node) = @_;
- IDZebra::data1_free_tree($self->{dh}, $node);
-}
-
-# =============================================================================
-
-__END__
-
-=head1 NAME
-
-IDZebra::Data1 - OO Aproach interface for data1 structures
-
-=head1 SYNOPSIS
-
- use IDZebra::Data1;
-
- my $m = IDZebra::nmem_create();
- my $d1=IDZebra::Data1->new($m,$IDZebra::DATA1_FLAG_XML);
- my $root = $d1->mk_root('ostriches');
- my $tag = $d1->mk_tag($root,'emu',('speed' => 120,
- 'height' => 110));
- $d1->pr_tree($root);
-
-=head1 DESCRIPTION
-
-I never managed to understand data1 entirely. Probably Adam, or someone else from IndexData could write a more deep introduction here. However here are some ideas:
-
-Data1 structures are used in zebra to represent structured data. You can map an xml structure, a marc record, or anything in D1. These structures are built by different filters - this is called "extraction" in zebra's code.
-
-When zebra asks a filter to extract a file, it provides a data1 handle, which can be used to
-
- - reach profile information, provided in zebra.cfg, and other refered
- configuration files, (like tab path).
-
- - build data1 structures
-
-In one word, a data1 handle is a kind of context in the d1 API. This handle is represented here as a IDZebra::Data1 object. When you implement a filter, you'll get this object ready for use, otherwise, you'll have to prepare an NMEM handle, and call the constructor:
-
- my $m = IDZebra::nmem_create();
- my $dh = IDZebra::Data1->new($m,$IDZebra::DATA1_FLAG_XML);
-
-What is FLAG_XML? I don't know exactly. You don't have to worry about it, it's already set, if you implement a filter.
-
-=head1 PROFILE INFORMATION
-
-=item $d1->tabpath([$path])
-
-Set and/or get the tab path. This is a colon separated list of directories, where different configuration files can be found.
-
-=item $d1->tabroot([$path])
-
-Set and/or get the tab root.
-
-=head1 BUILDING DATA STRUCTURES
-
-It's obvious, that first of all you have to create a root node:
-
- my $r1 = $d1->mk_root('pod');
-
-This is going to initialize the abstract syntax "pod" (trying to open and parse pod.abs). I don't know why exactly, but then, you'll have to create a root tag as well, under the same name.
-
- my $root=$d1->mk_tag($r1,'pod');
-
-Then just continue, to add child nodes, as tags, text nodes... to your structure.
-
-=item $d1->mk_root($name)
-
-Create a root node, with the given name. (name is type in d1 terminology?)
-
-=item $d1->set_root($node, $name)
-
-Makes an existing node into root node, under the given name
-
-=item $d1->mk_tag($parent, $name, [@attributes])
-
-Add a tag to the parent node, with the given name and attributes. For example:
-
- my $tag = $d1->mk_tag($root,'emu',('speed' => 120,
- 'height' => 110));
-
-=item $d1->tag_add_attr($node, @attributes)
-
-Add attributes to an existing node
-
-=item $d1->mk_text($parent, $text)
-
-Add a text node to the given parent
-
-=item $d1->mk_comment($parent, $text)
-
-Add a comment node to the given parent
-
-=item $d1->mk_preprocess($parent, $target, $attributes)
-
-???
-
-=item $d1->pr_tree($node)
-
-Prints data1 tree on STDOUT;
-
-=item $d1->free_tree($node)
-
-Destroys a data1 node structure;
-
-=head1 COPYRIGHT
-
-Fill in
-
-=head1 AUTHOR
-
-Peter Popovics, pop@technomat.hu
-
-=head1 SEE ALSO
-
-IDZebra, Zebra documentation
-
-=cut
+++ /dev/null
-#!/usr/bin/perl
-# ============================================================================
-# Zebra perl API header
-# =============================================================================
-use strict;
-use Carp;
-# ============================================================================
-package IDZebra::Filter;
-use IDZebra;
-use IDZebra::Data1;
-use IDZebra::Logger qw(:flags :calls);
-use Symbol qw(gensym);
-#use Devel::Leak;
-
-our $SAFE_MODE = 1;
-
-BEGIN {
- IDZebra::init(); # ??? Do we need that at all (this is jus nmem init...)
-}
-
-1;
-# -----------------------------------------------------------------------------
-# Class constructor
-# -----------------------------------------------------------------------------
-sub new {
- my ($proto,$context) = @_;
- my $class = ref($proto) || $proto;
- my $self = {};
- $self->{context} = $context;
- bless ($self, $class);
- return ($self);
-}
-
-# -----------------------------------------------------------------------------
-# Callbacks
-# -----------------------------------------------------------------------------
-sub _process {
- my ($self) = @_;
-
-# if ($self->{dl}) {
-# print STDERR "LEAK",Devel::Leak::CheckSV($self->{dl}),"\n";
-# }
-
-# print STDERR "LEAK",Devel::Leak::NoteSV($self->{dl}),"\n";
-
- # This is ugly... could be passed as parameters... but didn't work.
- # I don't know why...
- my $dh = IDZebra::grs_perl_get_dh($self->{context});
- my $mem = IDZebra::grs_perl_get_mem($self->{context});
- my $d1 = IDZebra::Data1->get($dh,$mem);
-
- my $rootnode;
- if ($SAFE_MODE) {
- eval {$rootnode = $self->process($d1)};
- if ($@) {
- logf(LOG_WARN,"Error processing perl filter:%s\n",$@);
- }
- } else {
- $rootnode = $self->process($d1);
- }
- IDZebra::grs_perl_set_res($self->{context},$rootnode);
- return (0);
-}
-
-sub _store_buff {
- my ($self, $buff) = @_;
- $self->{_buff} = $buff;
-}
-
-# -----------------------------------------------------------------------------
-# API Template - These methods should be overriden by the implementing class.
-# -----------------------------------------------------------------------------
-sub init {
- # This one is called once, when the module is loaded. Not in
- # object context yet!!!
-}
-
-sub process {
- my ($self, $d1) = @_;
- # Just going to return a root node.
- return ($d1->mk_root('empty'));
-}
-
-# -----------------------------------------------------------------------------
-# Testing
-# -----------------------------------------------------------------------------
-sub test {
- my ($proto, $file, %args) = @_;
-
- my $class = ref($proto) || $proto;
- my $self = {};
- bless ($self, $class);
-
- my $th;
- open ($th, $file) || croak ("Cannot open $file");
-
- $self->{testh} = $th;
-
- my $m = IDZebra::nmem_create();
- my $d1=IDZebra::Data1->new($m,$IDZebra::DATA1_FLAG_XML);
- if ($args{tabPath}) { $d1->tabpath($args{tabPath}); }
- if ($args{tabRoot}) { $d1->tabroot($args{tabRoot}); }
-
- my $rootnode = $self->process($d1);
- $d1->pr_tree($rootnode);
- $d1->free_tree($rootnode);
- $d1 = undef;
-
- close ($th);
- $self->{testh} = undef;
-
-}
-
-# -----------------------------------------------------------------------------
-# Utility calls
-# -----------------------------------------------------------------------------
-sub readf {
- my ($self, $buff, $len, $offset) = @_;
- $buff = "";
- if ($self->{testh}) {
- return (read($self->{testh},$_[1],$len,$offset));
- } else {
- my $r = IDZebra::grs_perl_readf($self->{context},$len);
- if ($r > 0) {
- $buff = $self->{_buff};
- $self->{_buff} = undef;
- }
- return ($r);
- }
-}
-
-sub readline {
- my ($self) = @_;
-
- my $r = IDZebra::grs_perl_readline($self->{context});
- if ($r > 0) {
- my $buff = $self->{_buff};
- $self->{_buff} = undef;
- return ($buff);
- }
- return (undef);
-}
-
-sub getc {
- my ($self) = @_;
- return(IDZebra::grs_perl_getc($self->{context}));
-}
-
-sub get_fh {
- my ($self) = @_;
- if ($self->{testh}) {
- return ($self->{testh});
- } else {
- my $fh = gensym;
- tie (*$fh,'IDZebra::FilterFile', $self);
- return ($fh);
- }
-}
-
-sub readall {
- my ($self, $buffsize) = @_;
- my $r;
- my $res = "";
-
- do {
- if ($self->{testh}) {
- $r = read($self->{testh}, $self->{_buff}, $buffsize);
- } else {
- $r = IDZebra::grs_perl_readf($self->{context},$buffsize);
- }
- if ($r > 0) {
- $res .= $self->{_buff};
- $self->{_buff} = undef;
- }
- } until ($r <= 0);
-
- return ($res);
-}
-
-sub seekf {
- my ($self, $offset) = @_;
- if ($self->{testh}) {
- # I'm not sure if offset is absolute or relative here...
- return (seek ($self->{testh}, $offset, $0));
- } else {
- return (IDZebra::grs_perl_seekf($self->{context},$offset)) ;
- }
-}
-
-sub tellf {
- my ($self) = @_;
- if ($self->{testh}) {
- # Not implemented
- } else {
- return (IDZebra::grs_perl_seekf($self->{context}));
- }
-}
-
-sub endf {
- my ($self, $offset) = @_;
- if ($self->{testh}) {
- # Not implemented
- } else {
- IDZebra::grs_perl_endf($self->{context},$offset);
- }
-}
-# ----------------------------------------------------------------------------
-# The 'virtual' filehandle for zebra extract calls
-# ----------------------------------------------------------------------------
-package IDZebra::FilterFile;
-require Tie::Handle;
-
-our @ISA = qw(Tie::Handle);
-
-sub TIEHANDLE {
- my $class = shift;
- my $self = {};
- bless ($self, $class);
- $self->{filter} = shift;
- return ($self);
-}
-
-sub READ {
- my $self = shift;
- return ($self->{filter}->readf(@_));
-}
-
-sub READLINE {
- my $self = shift;
- return ($self->{filter}->readline());
-}
-
-sub GETC {
- my $self = shift;
- return ($self->{filter}->getc());
-}
-
-sub EOF {
- croak ("EOF not implemented");
-}
-
-sub TELL {
- croak ("TELL not implemented");
-}
-
-sub SEEK {
- croak ("SEEK not implemented");
-}
-
-sub CLOSE {
- my $self = shift;
-}
-
-
-__END__
-
-=head1 NAME
-
-IDZebra::Filter - A superclass of perl filters for Zebra
-
-=head1 SYNOPSIS
-
- package MyFilter;
-
- use IDZebra::Filter;
- our @ISA=qw(IDZebra::Filter);
-
- ...
-
- sub init {
-
- }
-
- sub process {
- my ($self,$d1) = @_;
- my $rootnode=$d1->mk_root('meta');
- ...
- return ($rootnode)
- }
-
-=head1 DESCRIPTION
-
-When Zebra is trying to index/present a record, needs to extract information from it's source. For some types of input, "hardcoded" procedures are defined, but you have the opportunity to write your own filter code in Tcl or in perl.
-
-The perl implementation is nothing but a package, deployed in some available location for Zebra (in I<profilePath>, or in PERL_INCLUDE (@INC)). This package is interpreted once needed, a filter object is created, armored with knowledge enough, to read data from the source, and to generate data1 structures as result. For each individual source "files" the process method is called.
-
-This class is supposed to be inherited in all perl filter classes, as it is providing a way of communication between the filter code and the indexing/retrieval process.
-
-=head1 IMPLEMENTING FILTERS IN PERL
-
-All you have to do is to create a perl package, using and inheriting this one (IDZebra::Filter), and implement the "process" method. The parameter of this call is an IDZebra::Data1 object, representing a data1 handle. You can use this, to reach the configuration information and to build your data structure. What you have to return is a data1 root node. To create it:
-
- my $rootnode=$d1->mk_root('meta');
-
-where 'meta' is the abstract syntax identifier (in this case Zebra will try to locate meta.abs, and apply it). Then just continue to build the structure. See i<IDZebra::Data1> for details.
-
-In order to get the input stream, you can use "virtual" file operators (as the source is not necessairly a file):
-
-=over 4
-
-=item B<readf($buf,$len,$offset)>
-
-Going to read $len bytes of data from offset $offset into $buff
-
-=item B<readline()>
-
-Read one line
-
-=item B<getc()>
-
-Get one character (byte)
-
-=item B<readall($bufflen)>
-
-Read the entire stream, by reading $bufflen bytes at once
-
-=item B<seekf($offset)>
-
-Position to $offset
-
-=item B<tellf()>
-
-Tells the current offset (?)
-
-=item B<endf($offset)>
-
-???
-
-=back
-
-You can optionally get a virtual perl filehandle as well:
-
- my $fh = $self->get_fh();
- while (<$fh>) {
- # ...
- }
-
-Note, that the virtual filehandle implementation is not finished yet, so some applications may have problems using that. See TODO.
-
-You can implement an init call for your class. This call is not going to be called in object, but in class context. Stupid, eh?
-
-=head1 TEST YOUR PERL FILTER
-
-You can check the functionality of your filter code, by writing a small test program like
-
-
- use pod;
- $res =pod->test($ARGV[0],
- (tabPath=>'.:../../tab:../../../yaz/tab'));
-
-This will try to apply the filter on the file provided as argument, and display the generated data1 structure. However, there are some differences, when running a filter in test mode:
- - The include path is not applied from tabPath
- - the tellf, and endf functions are not implemented (just ignored)
-
-=head1 CONFIGURE ZEBRA TO USE A PERL FILTER
-
-This is quite simple. Read the Zebra manual, and follow the instructions to create your zebra.cfg. For your I<recordType> choose 'grs.perl.<YourFilterClass>'.
-Copy your filter module (YourFilterClass.pm) to a directory listed in I<profilePath>. i<profilePath> is added to @INC, when interpreting your package: so if you need to load modules from different locations than the default perl include path, just add these directories.
-
-=head1 MISC OPTIONS
-
-By default, filter code (process method) is executed within an eval {} block, and only a warning is sent to the log, if there is an error. To turn this option off, set B<$IDZebra::Filter::SAFE_MODE> to B<0>;
-
-=head1 TODO
-
-Finish virtual (tied) filehandle methods (SEEK, EOF, TELL);
-
-=head1 COPYRIGHT
-
-Fill in
-
-=head1 AUTHOR
-
-Peter Popovics, pop@technomat.hu
-
-=head1 SEE ALSO
-
-IDZebra, IDZebra::Data1, Zebra documentation
-
-=cut
+++ /dev/null
-#!/usr/bin/perl
-# ============================================================================
-# Zebra perl API header
-# =============================================================================
-use strict;
-use Carp;
-# ============================================================================
-package IDZebra::Logger;
-use IDZebra;
-require Exporter;
-our @ISA = qw(Exporter);
-
-our @EXPORT_OK = qw
- (LOG_FATAL
- LOG_DEBUG
- LOG_WARN
- LOG_LOG
- LOG_ERRNO
- LOG_FILE
- LOG_APP
- LOG_MALLOC
- LOG_ALL
-
- logf
- logm
- );
-
-our %EXPORT_TAGS = ('flags' => [qw
- (LOG_FATAL
- LOG_DEBUG
- LOG_WARN
- LOG_LOG
- LOG_ERRNO
- LOG_FILE
- LOG_APP
- LOG_MALLOC
- LOG_ALL) ],
- 'calls' => [qw(logf logm)]
- );
-
-use constant LOG_FATAL => $IDZebra::LOG_FATAL;
-use constant LOG_DEBUG => $IDZebra::LOG_DEBUG;
-use constant LOG_WARN => $IDZebra::LOG_WARN;
-use constant LOG_LOG => $IDZebra::LOG_LOG;
-use constant LOG_ERRNO => $IDZebra::LOG_ERRNO;
-use constant LOG_FILE => $IDZebra::LOG_FILE;
-use constant LOG_APP => $IDZebra::LOG_APP;
-use constant LOG_MALLOC => $IDZebra::LOG_MALLOC;
-use constant LOG_ALL => $IDZebra::LOG_ALL;
-
-1;
-
-sub logm {
- if (ref ($_[0])) {
- &_log($_[1],"%s",$_[2]);
- }
- elsif ($_[0] =~ /^IDZebra::/) {
- &_log($_[1],"%s",$_[2]);
- } else {
- &_log($_[0],"%s",$_[1]);
- }
-}
-
-sub logf {
- if (ref ($_[0])) {
- shift(@_);
- &_log(@_);
- }
- elsif ($_[0] =~ /^IDZebra::/) {
- shift(@_);
- &_log(@_);
- } else {
- &_log(@_);
- }
-}
-
-sub _log {
- my ($level, $format, @args) = @_;
- IDZebra::logMsg($level, sprintf($format, @args));
-}
-
-__END__
-
-=head1 NAME
-
-IDZebra::Logger -
-
-=head1 SYNOPSIS
-
-=head1 DESCRIPTION
-
-=head1 COPYRIGHT
-
-Fill in
-
-=head1 AUTHOR
-
-Peter Popovics, pop@technomat.hu
-
-=head1 SEE ALSO
-
-IDZebra, IDZebra::Data1, Zebra documentation
-
-=cut
+++ /dev/null
-# $Id: Resultset.pm,v 1.13 2004-09-16 14:58:47 heikki Exp $
-#
-# Zebra perl API header
-# =============================================================================
-package IDZebra::Resultset;
-
-use strict;
-use warnings;
-
-BEGIN {
- use IDZebra;
- use IDZebra::Logger qw(:flags :calls);
- use Scalar::Util qw(weaken);
- use Carp;
- our $VERSION = do { my @r = (q$Revision: 1.13 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
- our @ISA = qw(IDZebra::Logger);
-}
-
-1;
-# -----------------------------------------------------------------------------
-# Class constructors, destructor
-# -----------------------------------------------------------------------------
-sub new {
- my ($proto,$session, %args) = @_;
- my $class = ref($proto) || $proto;
- my $self = {};
- bless ($self, $class);
- logf(LOG_DEBUG,"creating a Resultset ".$args{name});
-
- $self->{session} = $session;
- weaken ($self->{session});
-
- $self->{odr_stream} = IDZebra::odr_createmem($IDZebra::ODR_DECODE);
-
- $self->{name} = $args{name};
- $self->{query} = $args{query};
- $self->{recordCount} = $args{recordCount};
- $self->{errCode} = $args{errCode};
- $self->{errString} = $args{errString};
-
- logf(LOG_DEBUG,"created a Resultset ".$self->{name});
- return ($self);
-}
-
-sub recordCount {
- my ($self) = @_;
- return ($self->{recordCount});
-}
-sub count {
- my ($self) = @_;
- return ($self->{recordCount});
-}
-
-sub errCode {
- my ($self) = @_;
- return ($self->{errCode});
-}
-
-sub errString {
- my ($self) = @_;
- return ($self->{errCode});
-}
-
-######################
-# this is disabled, while the term counts are broken by the work done to
-# rsets. To be reinstantiated some day real soon now...
-#sub terms {
-# use Data::Dumper;
-# my ($self) = @_;
-# my $count = 0; my $type = 0; my $len = 0;
-# my $tc = IDZebra::resultSetTerms($self->{session}{zh},$self->{name},
-# 0, \$count, \$type, "\0", \$len);
-#
-# logf (LOG_LOG,"Got $tc terms");
-#
-#
-# my @res = ();
-# for (my $i=0; $i<$tc; $i++) {
-# my $len = 1024;
-# my $t = {term => "\0" x $len, count => 0, type => 0};
-# my $stat = IDZebra::resultSetTerms($self->{session}{zh},$self->{name},
-# $i, \$t->{count}, \$t->{type},
-# $t->{term}, \$len);
-# $t->{term} = substr($t->{term}, 0, $len);
-# logf (LOG_LOG,
-# "term $i: type $t->{type}, '$t->{term}' ($t->{count})");
-# push (@res, $t);
-# }
-# return (@res);
-#}
-
-# =============================================================================
-sub DESTROY {
- my $self = shift;
-
-# print STDERR "Destroy RS\n";
- # Deleteresultset?
-
- my $stats = 0;
- logf(LOG_DEBUG, "Destroying a Resultset ". $self->{name});
- if ($self->{session}{zh}) {
- my $r = IDZebra::deleteResultSet($self->{session}{zh},
- 0, #Z_DeleteRequest_list,
- 1,[$self->{name}],
- $stats);
- }
-
- if ($self->{odr_stream}) {
- IDZebra::odr_reset($self->{odr_stream});
- IDZebra::odr_destroy($self->{odr_stream});
- $self->{odr_stream} = undef;
- }
-
- delete($self->{session});
- logf(LOG_DEBUG, "Destroyed a Resultset ". $self->{name});
-}
-# -----------------------------------------------------------------------------
-sub records {
- my ($self, %args) = @_;
-
- unless ($self->{session}{zh}) {
- croak ("Session is closed or out of scope");
- }
- my $from = $args{from} ? $args{from} : 1;
- my $to = $args{to} ? $args{to} : $self->{recordCount};
-
- if (($to-$from) >= 1000) {
- if ($args{to}) {
- croak ("Cannot fetch more than 1000 records at a time");
- } else {
- $to = $from + 999;
- }
- }
-
- my $elementSet = $args{elementSet} ? $args{elementSet} : 'R';
- my $schema = $args{schema} ? $args{schema} : '';
- my $recordSyntax = $args{recordSyntax} ? $args{recordSyntax} : '';
-
- my $class = $args{class} ? $args{class} : '';
-
- # ADAM: Reset before we use it (not after)
- IDZebra::odr_reset($self->{odr_stream});
-
- my $ro = IDZebra::RetrievalObj->new();
- IDZebra::records_retrieve($self->{session}{zh},
- $self->{odr_stream},
- $self->{name},
- $elementSet,
- $schema,
- $recordSyntax,
- $from,
- $to,
- $ro);
-
- my @res = ();
-
- for (my $i=$from; $i<=$to; $i++) {
- my $rec = IDZebra::RetrievalRecord->new();
- IDZebra::record_retrieve($ro, $self->{odr_stream}, $rec, $i-$from+1);
- if ($class) {
-
- } else {
- push (@res, $rec);
- }
- }
-
- return (@res);
-}
-
-# ============================================================================
-sub sort {
- my ($self, $sortspec, $setname) = @_;
-
- unless ($self->{session}{zh}) {
- croak ("Session is closed or out of scope");
- }
-
- if (!$setname) {
- $setname=$self->{session}->_new_setname();
- }
- return ($self->{session}->sortResultsets($sortspec,
- $setname, ($self)));
-# unless ($setname) {
-# return ($_[0] = $self->{session}->sortResultsets($sortspec,
-# $self->{session}->_new_setname, ($self)));
-# return ($_[0]);
-# } else {
-# return ($self->{session}->sortResultsets($sortspec,
-# $setname, ($self)));
-# }
-}
-
-# ============================================================================
-__END__
-
-=head1 NAME
-
-IDZebra::Resultset - Representation of Zebra search results
-
-=head1 SYNOPSIS
-
- $count = $rs->count;
-
- printf ("RS Status is %d (%s)\n", $rs->errCode, $rs->errString);
-
- my @recs = $rs->records(from => 1,
- to => 10);
-
-=head1 DESCRIPTION
-
-The I<Resultset> object represents results of a Zebra search. Contains number of hits, search status, and can be used to sort and retrieve the records.
-
-=head1 PROPERTIES
-
-The folowing properties are available, trough object methods and the object hash reference:
-
-=over 4
-
-=item B<errCode>
-
-The error code returned from search, resulting the Resultset object.
-
-=item B<errString>
-
-The optional error string
-
-=item B<recordCount>
-
-The number of hits (records available) in the resultset
-
-=item B<count>
-
-Just the synonym for I<recordCount>
-
-=back
-
-=head1 RETRIEVING RECORDS
-
-In order to retrieve records, use the I<records> method:
-
- my @recs = $rs->records();
-
-By default this is going to return an array of IDZebra::RetrievalRecord objects. The possible arguments are:
-
-=over 4
-
-=item B<from>
-
-Retrieve records from the given position. The first record corresponds to position 1. If not specified, retrieval starts from the first record.
-
-=item B<to>
-
-The last record position to be fetched. If not specified, all records are going to be fetched, starting from position I<from>.
-
-=item B<elementSet>
-
-The element set used for retrieval. If not specified 'I<R>' is used, which will return the "record" in the original format (ie.: without extraction, just as the original file, or data buffer in the update call).
-
-=item B<schema>
-
-The schema used for retrieval. The default is "".
-
-=item B<recordSyntax>
-
-The record syntax for retrieval. The default is SUTRS.
-
-=back
-
-=head1 SORTING
-
-You can sort resultsets by calling:
-
- $rs1->sort($sort_expr);
-
-or create a new sorted resultset:
-
- $rs2 = $rs1->sort($sort_expr);
-
-The sort expression has the same format as described in the I<yaz_client> documentation. For example:
-
- $rs1->sort('1=4 id');
-
-will sort thr results by title, in a case insensitive way, in descending order, while
-
- $rs1->sort('1=4 a');
-
-will sort ascending by titles.
-
-=head1 COPYRIGHT
-
-Fill in
-
-=head1 AUTHOR
-
-Peter Popovics, pop@technomat.hu
-
-=head1 SEE ALSO
-
-Zebra documentation, IDZebra::ResultSet, IDZebra::RetrievalRecord manpages.
-
-=cut
+++ /dev/null
-# $Id: RetrievalRecord.pm,v 1.3 2003-03-05 13:55:22 pop Exp $
-#
-# Zebra perl API header
-# =============================================================================
-package IDZebra::RetrievalRecord;
-
-use strict;
-use warnings;
-
-BEGIN {
- use IDZebra;
- our $VERSION = do { my @r = (q$Revision: 1.3 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
-}
-
-1;
-# =============================================================================
-# THIS IS Just the documentation, and some access methods...
-# The real code is autogenerated by SWIG in IDZebra.pm
-# =============================================================================
-
-sub errCode { $_[0]->{errCode} }
-sub errString { $_[0]->{errString} }
-sub position { $_[0]->{position} }
-sub base { $_[0]->{base} }
-sub sysno { $_[0]->{sysno} }
-sub score { $_[0]->{score} }
-sub format { $_[0]->{format} }
-sub buf { $_[0]->{buf} }
-
-# =============================================================================
-
-__END__
-
-=head1 NAME
-
-IDZebra::RetrievalRecord - Structure representing a retrieval record
-
-=head1 SYNOPSIS
-
- foreach my $rec ($rs1->records()) {
- unless ($rec->errCode) {
- printf ("Pos:%d, Base: %s, sysno: %d, score %d format: %s\n%s\n\n",
- $rec->position,
- $rec->base,
- $rec->sysno,
- $rec->score,
- $rec->format,
- $rec->buf
- );
- }
- }
-
-
-=head1 DESCRIPTION
-
-The object represents a Zebra retrieval record, as a "member" of a resultset. It's a read-only object. Beeing a tied reference, access to undefined members ("properties") may hurt.
-
-=head1 PROPERTIES
-
-The following properties are available trough both methods ($rec->errCode) and hash members ($rec->{errCode}):
-
-=over 4
-
-=item B<errCode>
-
-The error code received when fetching this record. 0, if everything went OK.
-
-=item B<errString>
-
-Supplemental error information if applicable.
-
-=item B<position>
-
-Position of record in the resultset.
-
-=item B<base>
-
-The database the record belongs to
-
-=item B<sysno>
-
-System number (unique identifier provided by Zebra for each record)
-
-=item B<score>
-
-The score of the resulting record
-
-=item B<format>
-
-Record format, (Z39.50)
-
-=item B<buf>
-
-The record data itself
-
-=back
-
-=head1 COPYRIGHT
-
-Fill in
-
-=head1 AUTHOR
-
-Peter Popovics, pop@technomat.hu
-
-=head1 SEE ALSO
-
-Zebra documentation, IDZebra::Session, IDZebra::ResultSet manpages.
-
-=cut
-
+++ /dev/null
-# $Id: ScanEntry.pm,v 1.3 2003-03-12 17:08:53 pop Exp $
-#
-# Zebra perl API header
-# =============================================================================
-package IDZebra::ScanEntry;
-
-use strict;
-use warnings;
-
-BEGIN {
- use IDZebra;
- use IDZebra::Logger qw(:flags :calls);
- use Scalar::Util qw(weaken);
- use Carp;
- our $VERSION = do { my @r = (q$Revision: 1.3 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
-}
-
-use constant _term => 0;
-use constant _occurrences => 1;
-use constant _position => 2;
-use constant _list => 3;
-1;
-
-# -----------------------------------------------------------------------------
-# Class constructors, destructor
-# -----------------------------------------------------------------------------
-
-
-sub new {
- my ($proto,@args) = @_;
- my $class = ref($proto) || $proto;
- my $self = \@args;
- bless ($self, $class);
- weaken ($self->[_list]);
- return ($self);
-}
-
-# =============================================================================
-sub DESTROY {
- my $self = shift;
-# logf(LOG_LOG,"DESTROY: IDZebra::ScanEntry");
-}
-
-# -----------------------------------------------------------------------------
-sub term {
- my $self = shift;
- return ($self->[_term]);
-}
-
-sub occurrences {
- my $self = shift;
- return ($self->[_occurrences]);
-}
-
-sub position {
- my $self = shift;
- return ($self->[_position]);
-}
-
-
-
-# -----------------------------------------------------------------------------
-__END__
-
-=head1 NAME
-
-IDZebra::ScanEntry - An entry of the scan results
-
-=head1 SYNOPSIS
-
- foreach my $se ($sl->entries()) {
- print STDERR ($se->position ,": ",
- $se->term() . " (",
- $se->occurrences() . "\n");
- }
-
-=head1 DESCRIPTION
-
-A scan entry describes occurrence of a term in the scanned index.
-
-=head1 PROPERTIES
-
-=over 4
-
-=item B<term>
-
-The term itself.
-
-=item B<position>
-
-Position of term in the list. 1 based.
-
-=item B<occurrences>
-
-The occurrence count of the term in the selected database(s).
-
-=back
-
-=head1 TODO
-
-A I<resultSet> and maybe a I<records> method, to reach the records, where the term occurred.
-
-=head1 COPYRIGHT
-
-Fill in
-
-=head1 AUTHOR
-
-Peter Popovics, pop@technomat.hu
-
-=head1 SEE ALSO
-
-IDZebra, IDZebra::ScanList, Zebra documentation
-
-=cut
+++ /dev/null
-# $Id: ScanList.pm,v 1.3 2003-03-12 17:08:53 pop Exp $
-#
-# Zebra perl API header
-# =============================================================================
-package IDZebra::ScanList;
-
-use strict;
-use warnings;
-
-BEGIN {
- use IDZebra;
- use IDZebra::Logger qw(:flags :calls);
- use IDZebra::ScanEntry;
- use Scalar::Util qw(weaken);
- use Carp;
- our $VERSION = do { my @r = (q$Revision: 1.3 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
- our @ISA = qw(IDZebra::Logger);
-}
-
-1;
-# -----------------------------------------------------------------------------
-# Class constructors, destructor
-# -----------------------------------------------------------------------------
-sub new {
- my ($proto,$session, %args) = @_;
- my $class = ref($proto) || $proto;
- my $self = {};
- bless ($self, $class);
-
- $self->{session} = $session;
- weaken ($self->{session});
-
- $self->{expression} = $args{expression};
- $self->{databases} = $args{databases};
-
- $self->{so} = IDZebra::ScanObj->new();
-
- $self->{odr_stream} = IDZebra::odr_createmem($IDZebra::ODR_DECODE);
-
- $self->entries(num_entries => 0);
-
- return ($self);
-}
-
-sub DESTROY {
- my $self = shift;
-
-# logf(LOG_LOG,"DESTROY: IDZebra::ScanList");
-
- if ($self->{odr_stream}) {
- IDZebra::odr_reset($self->{odr_stream});
- IDZebra::odr_destroy($self->{odr_stream});
- $self->{odr_stream} = undef;
- }
-
- delete($self->{so});
- delete($self->{session});
-}
-
-# =============================================================================
-sub is_partial {
- my ($self) = @_;
- return ($self->{so}{is_partial});
-}
-
-sub position {
- my ($self) = @_;
- return ($self->{so}{position});
-}
-
-sub num_entries {
- my ($self) = @_;
- return ($self->{so}{num_entries});
-}
-
-sub errCode {
- my ($self) = @_;
- return ($self->{session}->errCode);
-}
-
-sub errString {
- my ($self) = @_;
- return ($self->{session}->errString);
-}
-
-# -----------------------------------------------------------------------------
-sub entries {
- my ($self, %args) = @_;
-
- unless ($self->{session}{zh}) {
- croak ("Session is closed or out of scope");
- }
-
- my $so=$self->{so};
-
- $so->{position} = defined($args{position}) ? $args{position} : 1;
- $so->{num_entries} = defined($args{num_entries}) ? $args{num_entries} : 20;
-
- my @origdbs;
- if ($self->{databases}) {
- @origdbs = $self->{session}->databases;
- $self->{session}->databases(@{$self->{databases}});
- }
-
- $so->{is_partial} = 0;
-
- my $r = IDZebra::scan_PQF($self->{session}{zh}, $so,
- $self->{odr_stream},
- $self->{expression});
-
- if ($self->{session}->errCode) {
- croak ("Error in scan, code: ".$self->{session}->errCode .
- ", message: ".$self->{session}->errString);
- }
-
- my @res;
- for (my $i=1; $i<=$so->{num_entries}; $i++) {
- my $se = IDZebra::getScanEntry($so, $i);
- push (@res,
- IDZebra::ScanEntry->new($se->{term},
- $se->{occurrences},
- $i,
- $self));
- }
-
- if ($self->{databases}) {
- $self->{session}->databases(@origdbs);
- }
-
- IDZebra::odr_reset($self->{odr_stream});
-
- $self->{so} = $so;
-
- return (@res);
-}
-
-
-# ============================================================================
-__END__
-
-=head1 NAME
-
-IDZebra::ScanList - Scan results
-
-=head1 SYNOPSIS
-
- $sl = $sess->scan(expression => "\@attr 1=4 \@attr 6=2 a",
- databases => [qw(demo1 demo2)]);
-
- @entries = $sl->entries(position => 5,
- num_entries => 10);
-
- print STDERR
- $sl->num_entries,','
- $sl->is_partail,',',
- $sl->position;
-
-
-=head1 DESCRIPTION
-
-The scan list object is the result of a scan call, and can be used to retrieve entries from the list. To do this, use the B<entries> method,
-
- @entries = $sl->entries(position => 5,
- num_entries => 10);
-
-returning an array of I<IDZebra::ScanEntry> objects.
-The possible arguments are:
-
-=over 4
-
-=item B<position>
-
-The requested position of the scanned term in the returned list. For example, if position 5 is given, and the scan term is "a", then the entry corresponding to term "a" will be on the position 5 of the list (4th. elment of the array). It may happen, that due to the position of term in the whole index, it's not possible to put the entry on the requested position (for example, the term is on the 2nd position of the index), this case I<$sl-E<gt>position> will contain a different value, presenting the actual position. The default value is 1.
-
-=item B<num_entries>
-
-The requested number of entries in the list. See I<$sl-E<gt>num_entries> for the actual number of fetched entries. The dafault value is 20.
-
-=back
-
-=head1 PROPERTIES
-
-You can reach the following properties as function calls on the IDZebra::ScanList object:
-
-=over 4
-
-=item B<position>
-
-After calling I<entries>, the actual position of the requested term.
-
-=item B<num_entries>
-
-After calling I<entries>, the actual number of entries returned.
-
-=item B<is_partial>
-
-Only partial list is returned by I<entries>.
-
-=back
-
-=head1 COPYRIGHT
-
-Fill in
-
-=head1 AUTHOR
-
-Peter Popovics, pop@technomat.hu
-
-=head1 SEE ALSO
-
-Zebra documentation, IDZebra::Session manpage.
-
-=cut
+++ /dev/null
-# $Id: Session.pm,v 1.23 2004-09-15 14:11:06 heikki Exp $
-#
-# Zebra perl API header
-# =============================================================================
-package IDZebra::Session;
-
-use strict;
-use warnings;
-use Carp;
-
-BEGIN {
- use IDZebra;
- use Scalar::Util;
- use IDZebra::Logger qw(:flags :calls);
- use IDZebra::Resultset;
- use IDZebra::ScanList;
- use IDZebra::RetrievalRecord;
- require Exporter;
- our $VERSION = do { my @r = (q$Revision: 1.23 $ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
- our @ISA = qw(IDZebra::Logger Exporter);
- our @EXPORT = qw (TRANS_RW TRANS_RO);
-}
-
-use constant TRANS_RW => 1;
-use constant TRANS_RO => 0;
-
-1;
-# -----------------------------------------------------------------------------
-# Class constructors, destructor
-# -----------------------------------------------------------------------------
-sub new {
- my ($proto, %args) = @_;
- my $class = ref($proto) || $proto;
- my $self = {};
- $self->{args} = \%args;
-
- bless ($self, $class);
- $self->{cql_ct} = undef;
- $self->{cql_mapfile} = "";
- return ($self);
-
- $self->{databases} = {};
-}
-
-sub start_service {
- my ($self, %args) = @_;
-
- my $zs;
- unless (defined($self->{zs})) {
- if (defined($args{'configFile'})) {
- $self->{zs} = IDZebra::start($args{'configFile'});
- } else {
- $self->{zs} = IDZebra::start("zebra.cfg");
- }
- }
-}
-
-sub stop_service {
- my ($self) = @_;
- if (defined($self->{zs})) {
- IDZebra::stop($self->{zs}) if ($self->{zs});
- $self->{zs} = undef;
- }
-}
-
-
-sub open {
- my ($proto,%args) = @_;
- my $self = {};
-
- if (ref($proto)) { $self = $proto; } else {
- $self = $proto->new(%args);
- }
-
- unless (%args) {
- %args = %{$self->{args}};
- }
-
- $self->start_service(%args);
-
- unless (defined($self->{zs})) {
- croak ("Falied to open zebra service");
- }
-
- unless (defined($self->{zh})) {
- $self->{zh}=IDZebra::open($self->{zs});
- }
-
- # Reset result set counter
- $self->{rscount} = 0;
-
- # This is needed in order to somehow initialize the service
- $self->databases("Default");
-
- # ADAM: group call deleted
- # Load the default configuration
- # $self->group(%args);
-
- # ADAM: Set group resource instead
- if (defined($args{groupName})) {
- IDZebra::set_resource($self->{zh}, "group", $args{groupName});
- }
-
- # Set shadow usage
- my $shadow = defined($args{shadow}) ? $args{shadow} : 0;
- $self->shadow($shadow);
-
- $self->{odr_input} = IDZebra::odr_createmem($IDZebra::ODR_DECODE);
- $self->{odr_output} = IDZebra::odr_createmem($IDZebra::ODR_ENCODE);
-
- return ($self);
-}
-
-sub checkzh {
- my ($self) = @_;
- unless (defined($self->{zh})) {
- croak ("Zebra session is not opened");
- }
-}
-
-sub close {
- my ($self) = @_;
-
- if ($self->{zh}) {
-
- my $stats = 0;
- # Delete all resulsets
- my $r = IDZebra::deleteResultSet($self->{zh},
- 1, #Z_DeleteRequest_all,
- 0,[],
- $stats);
-
- while (IDZebra::trans_no($self->{zh}) > 0) {
- logf (LOG_WARN,"Explicitly closing transaction with session");
- $self->end_trans;
- }
-
- IDZebra::close($self->{zh});
- $self->{zh} = undef;
- }
-
- if ($self->{odr_input}) {
- IDZebra::odr_reset($self->{odr_input});
- IDZebra::odr_destroy($self->{odr_input});
- $self->{odr_input} = undef;
- }
-
- if ($self->{odr_output}) {
- IDZebra::odr_reset($self->{odr_output});
- IDZebra::odr_destroy($self->{odr_output});
- $self->{odr_output} = undef;
- }
-
- $self->stop_service;
-}
-
-sub DESTROY {
- my ($self) = @_;
- logf (LOG_LOG,"DESTROY $self");
- $self->close;
-
- if (defined ($self->{cql_ct})) {
- IDZebra::cql_transform_close($self->{cql_ct});
- }
-
-}
-# -----------------------------------------------------------------------------
-# Record group selection This is a bit nasty... but used at many places
-# -----------------------------------------------------------------------------
-
-# ADAM: All these group functions have been disabled.
-sub group_deleted {
- my ($self,%args) = @_;
- $self->checkzh;
- if ($#_ > 0) {
- $self->{rg} = $self->_makeRecordGroup(%args);
- $self->_selectRecordGroup($self->{rg});
- }
- return($self->{rg});
-}
-
-sub selectRecordGroup_deleted {
- my ($self, $groupName) = @_;
- $self->checkzh;
- $self->{rg} = $self->_getRecordGroup($groupName);
- $self->_selectRecordGroup($self->{rg});
-}
-
-sub _displayRecordGroup_deleted {
- my ($self, $rg) = @_;
- print STDERR "-----\n";
- foreach my $key qw (groupName
- databaseName
- path recordId
- recordType
- flagStoreData
- flagStoreKeys
- flagRw
- fileVerboseLimit
- databaseNamePath
- explainDatabase
- followLinks) {
- print STDERR "$key:",$rg->{$key},"\n";
- }
-}
-
-sub _cloneRecordGroup_deleted {
- my ($self, $orig) = @_;
- my $rg = IDZebra::recordGroup->new();
- my $r = IDZebra::init_recordGroup($rg);
- foreach my $key qw (groupName
- databaseName
- path
- recordId
- recordType
- flagStoreData
- flagStoreKeys
- flagRw
- fileVerboseLimit
- databaseNamePath
- explainDatabase
- followLinks) {
- $rg->{$key} = $orig->{$key} if ($orig->{$key});
- }
- return ($rg);
-}
-
-sub _getRecordGroup_deleted {
- my ($self, $groupName, $ext) = @_;
- my $rg = IDZebra::recordGroup->new();
- my $r = IDZebra::init_recordGroup($rg);
- $rg->{groupName} = $groupName if ($groupName ne "");
- $ext = "" unless ($ext);
- $r = IDZebra::res_get_recordGroup($self->{zh}, $rg, $ext);
- return ($rg);
-}
-
-sub _makeRecordGroup_deleted {
- my ($self, %args) = @_;
- my $rg;
-
- my @keys = keys(%args);
- unless ($#keys >= 0) {
- return ($self->{rg});
- }
-
- if ($args{groupName}) {
- $rg = $self->_getRecordGroup($args{groupName});
- } else {
- $rg = $self->_cloneRecordGroup($self->{rg});
- }
- $self->_setRecordGroupOptions($rg, %args);
- return ($rg);
-}
-
-sub _setRecordGroupOptions_deleted {
- my ($self, $rg, %args) = @_;
-
- foreach my $key qw (databaseName
- path
- recordId
- recordType
- flagStoreData
- flagStoreKeys
- flagRw
- fileVerboseLimit
- databaseNamePath
- explainDatabase
- followLinks) {
- if (defined ($args{$key})) {
- $rg->{$key} = $args{$key};
- }
- }
-}
-sub _selectRecordGroup_deleted {
- my ($self, $rg) = @_;
-
- my $r = IDZebra::set_group($self->{zh}, $rg);
- my $dbName;
- unless ($dbName = $rg->{databaseName}) {
- $dbName = 'Default';
- }
- unless ($self->databases($dbName)) {
- croak("Fatal error selecting database $dbName");
- }
-}
-# -----------------------------------------------------------------------------
-# Selecting databases for search (and also for updating - internally)
-# -----------------------------------------------------------------------------
-sub databases {
- my ($self, @databases) = @_;
-
- $self->checkzh;
-
- unless ($#_ >0) {
- return (keys(%{$self->{databases}}));
- }
-
- my %tmp;
- my $changed = 0;
- foreach my $db (@databases) {
- $tmp{$db}++;
- next if ($self->{databases}{$db});
- $changed++;
- }
-
- foreach my $db (keys (%{$self->{databases}})) {
- $changed++ unless ($tmp{$db});
- }
-
- if ($changed) {
-
- delete ($self->{databases});
- foreach my $db (@databases) {
- $self->{databases}{$db}++;
- }
-
- if (IDZebra::select_databases($self->{zh},
- ($#databases + 1),
- \@databases)) {
- logf(LOG_FATAL,
- "Could not select database(s) %s errCode=%d",
- join(",",@databases),
- $self->errCode());
- return (0);
- } else {
- logf(LOG_LOG,"Database(s) selected: %s",join(",",@databases));
- }
- }
- return (keys(%{$self->{databases}}));
-}
-
-# -----------------------------------------------------------------------------
-# Error handling
-# -----------------------------------------------------------------------------
-sub errCode {
- my ($self) = @_;
- return(IDZebra::errCode($self->{zh}));
-}
-
-sub errString {
- my ($self) = @_;
- return(IDZebra::errString($self->{zh}));
-}
-
-sub errAdd {
- my ($self) = @_;
- return(IDZebra::errAdd($self->{zh}));
-}
-
-# -----------------------------------------------------------------------------
-# Transaction stuff
-# -----------------------------------------------------------------------------
-sub begin_trans {
- my ($self, $m) = @_;
- $m = TRANS_RW unless (defined ($m));
- if (my $err = IDZebra::begin_trans($self->{zh},$m)) {
- if ($self->errCode == 2) {
- croak ("TRANS_RW not allowed within TRANS_RO");
- } else {
- croak("Error starting transaction; code:".
- $self->errCode . " message: " . $self->errString);
- }
- }
-}
-
-sub end_trans {
- my ($self) = @_;
- $self->checkzh;
- my $stat = IDZebra::ZebraTransactionStatus->new();
- IDZebra::end_trans($self->{zh}, $stat);
- return ($stat);
-}
-
-sub shadow {
- my ($self, $value) = @_;
- $self->checkzh;
- if ($#_ > 0) {
- $value = 0 unless (defined($value));
- my $r =IDZebra::set_shadow_enable($self->{zh},$value);
- }
- return (IDZebra::get_shadow_enable($self->{zh}));
-}
-
-sub commit {
- my ($self) = @_;
- $self->checkzh;
- if ($self->shadow) {
- return(IDZebra::commit($self->{zh}));
- }
-}
-
-# -----------------------------------------------------------------------------
-# We don't really need that...
-# -----------------------------------------------------------------------------
-sub odr_reset {
- my ($self, $name) = @_;
- if ($name !~/^(input|output)$/) {
- croak("Undefined ODR '$name'");
- }
- IDZebra::odr_reset($self->{"odr_$name"});
-}
-
-# -----------------------------------------------------------------------------
-# Init/compact
-# -----------------------------------------------------------------------------
-sub init {
- my ($self) = @_;
- $self->checkzh;
- return(IDZebra::init($self->{zh}));
-}
-
-sub compact {
- my ($self) = @_;
- $self->checkzh;
- return(IDZebra::compact($self->{zh}));
-}
-
-sub update {
- my ($self, %args) = @_;
- $self->checkzh;
- # ADAM: Set group resource
- if (defined($args{groupName})) {
- IDZebra::set_resource($self->{zh}, "group", $args{groupName});
- }
- # ADAM: disabled
-# my $rg = $self->_update_args(%args); deleted
-# $self->_selectRecordGroup($rg); deleted
- $self->begin_trans;
- IDZebra::repository_update($self->{zh}, $args{path});
-# $self->_selectRecordGroup($self->{rg}); deleted
- $self->end_trans;
-}
-
-sub delete {
- my ($self, %args) = @_;
- $self->checkzh;
- # ADAM: Set group resource
- if (defined($args{groupName})) {
- IDZebra::set_resource($self->{zh}, "group", $args{groupName});
- }
- # ADAM: disabled
-# my $rg = $self->_update_args(%args); deleted
-# $self->_selectRecordGroup($rg); deleted
- $self->begin_trans;
- IDZebra::repository_delete($self->{zh}, $args{path});
- # ADAM: disabled
-# $self->_selectRecordGroup($self->{rg});
- $self->end_trans;
-}
-
-sub show {
- my ($self, %args) = @_;
- $self->checkzh;
- # ADAM: Set group resource
- if (defined($args{groupName})) {
- IDZebra::set_resource($self->{zh}, "group", $args{groupName});
- }
- # ADAM: disabled
-# my $rg = $self->_update_args(%args);
-# $self->_selectRecordGroup($rg);
-
- $self->begin_trans;
- IDZebra::repository_show($self->{zh});
- $self->_selectRecordGroup($self->{rg});
- $self->end_trans;
-}
-
-sub _update_args_deleted {
- my ($self, %args) = @_;
- my $rg = $self->_makeRecordGroup(%args);
- $self->_selectRecordGroup($rg);
- return ($rg);
-}
-
-# -----------------------------------------------------------------------------
-# Per record update
-# -----------------------------------------------------------------------------
-sub _get_data_buff {
- my %args=@_;
- my $buff;
- if ($args{data}) {
- $buff = $args{data};
- }
- elsif ($args{file}) {
- CORE::open (F, $args{file}) || warn ("Cannot open $args{file}");
- $buff = join('',(<F>));
- CORE::close (F);
- }
- return $buff;
-}
-
-sub insert_record {
- my ($self, %args) = @_;
- $self->checkzh;
- my $rectype = $args{recordType} ? $args{recordType} : "";
- my $fname = $args{file} ? $args{file} : "<no file>";
- my $force = $args{force} ? $args{force} : 0;
- my $buff =_get_data_buff(%args);
- if (!$buff) { die ("insert_record needs a {data} or a {file}");}
- my $len = length($buff);
- my @args = ($rectype, 0, "", $fname, $buff, $len, $force);
- my @ret = IDZebra::insert_record($self->{zh}, @args);
- return @ret; # returns ($status, $sysno)
-}
-
-sub update_record {
- my ($self, %args) = @_;
- $self->checkzh;
- my $sysno = $args{sysno} ? $args{sysno} : 0;
- my $match = $args{match} ? $args{match} : "";
- my $rectype = $args{recordType} ? $args{recordType} : "";
- my $fname = $args{file} ? $args{file} : "<no file>";
- my $force = $args{force} ? $args{force} : 0;
- my $buff =_get_data_buff(%args);
- if (!$buff) { die ("update_record needs a {data} or a {file}");}
- my $len = length($buff);
- my @args = ($rectype, $sysno, $match, $fname, $buff, $len, $force);
- my @ret = IDZebra::update_record($self->{zh}, @args);
- return @ret; # ($status, $sysno)
-}
-
-sub delete_record {
-# can delete by sysno, or by given match string, or by extracting keys
-# from the record itself...
- my ($self, %args) = @_;
- $self->checkzh;
- my $sysno = $args{sysno} ? $args{sysno} : 0;
- my $match = $args{match} ? $args{match} : "";
- my $rectype = $args{recordType} ? $args{recordType} : "";
- my $fname = $args{file} ? $args{file} : "<no file>";
- my $force = $args{force} ? $args{force} : 0;
- my $buff =_get_data_buff(%args);
- my $len=0;
- if ($buff) {$len= length($buff)};
- my @args = ($rectype, $sysno, $match, $fname, $buff, $len, $force);
- my @ret = IDZebra::delete_record($self->{zh}, @args);
- return @ret;
-}
-
-sub _record_update_args {
- my ($self, %args) = @_;
- my $sysno = $args{sysno} ? $args{sysno} : 0;
- my $match = $args{match} ? $args{match} : "";
- my $rectype = $args{recordType} ? $args{recordType} : "";
- my $fname = $args{file} ? $args{file} : "<no file>";
- my $force = $args{force} ? $args{force} : 0;
-
- my $buff;
-
- if ($args{data}) {
- $buff = $args{data};
- }
- elsif ($args{file}) {
- CORE::open (F, $args{file}) || warn ("Cannot open $args{file}");
- $buff = join('',(<F>));
- CORE::close (F);
- }
- my $len = length($buff);
-
- delete ($args{sysno});
- delete ($args{match});
- delete ($args{recordType});
- delete ($args{file});
- delete ($args{data});
- delete ($args{force});
-
-# ADAM: recordGroup removed ...
-# my $rg = $self->_makeRecordGroup(%args);
-
- # If no record type is given, then try to find it out from the
- # file extension; deleted
- #unless ($rectype) {
-# if (my ($ext) = $fname =~ /\.(\w+)$/) {
-# my $rg2 = $self->_getRecordGroup($rg->{groupName},$ext);
-# $rectype = $rg2->{recordType};
-# }
-# }
-
-# $rg->{databaseName} = "Default" unless ($rg->{databaseName});
-
- unless ($rectype) {
- $rectype="";
- }
- # ADAM: set group resource
- if (defined($args{groupName})) {
- IDZebra::set_resource($self->{zh}, "group", $args{groupName});
- }
-
- # ADAM: rg no longer part of vector..
- return ($rectype, $sysno, $match, $fname, $buff, $len, $force);
-}
-
-# -----------------------------------------------------------------------------
-# CQL stuff
-sub cqlmap {
- my ($self,$mapfile) = @_;
- if ($#_ > 0) {
- if ($self->{cql_mapfile} ne $mapfile) {
- unless (-f $mapfile) {
- croak("Cannot find $mapfile");
- }
- if (defined ($self->{cql_ct})) {
- IDZebra::cql_transform_close($self->{cql_ct});
- }
- $self->{cql_ct} = IDZebra::cql_transform_open_fname($mapfile);
- $self->{cql_mapfile} = $mapfile;
- }
- }
- return ($self->{cql_mapfile});
-}
-
-sub cql2pqf {
- my ($self, $cqlquery) = @_;
- unless (defined($self->{cql_ct})) {
- croak("CQL map file is not specified yet.");
- }
- my $res = "\0" x 2048;
- my $r = IDZebra::cql2pqf($self->{cql_ct}, $cqlquery, $res, 2048);
- if ($r) {
-# carp ("Error transforming CQL query: '$cqlquery', status:$r");
- }
- $res=~s/\0.+$//g;
- return ($res,$r);
-}
-
-
-# -----------------------------------------------------------------------------
-# Search
-# -----------------------------------------------------------------------------
-sub search {
- my ($self, %args) = @_;
-
- $self->checkzh;
-
- if ($args{cqlmap}) { $self->cqlmap($args{cqlmap}); }
-
- my $query;
- if ($args{pqf}) {
- $query = $args{pqf};
- }
- elsif ($args{cql}) {
- my $cqlstat;
- ($query, $cqlstat) = $self->cql2pqf($args{cql});
- unless ($query) {
- croak ("Failed to transform query: '$args{cql}', ".
- "status: ($cqlstat)");
- }
- }
- unless ($query) {
- croak ("No query given to search");
- }
-
- my @origdbs;
-
- if ($args{databases}) {
- @origdbs = $self->databases;
- $self->databases(@{$args{databases}});
- }
-
-
- my $rsname = $args{rsname} ? $args{rsname} : $self->_new_setname;
-
- my $rs = $self->_search_pqf($query, $rsname);
-
- if ($args{databases}) {
- $self->databases(@origdbs);
- }
-
- if ($args{sort}) {
- if ($rs->errCode) {
- carp("Sort skipped due to search error: ".
- $rs->errCode);
- } else {
- $rs->sort($args{sort});
- }
- }
-
- return ($rs);
-}
-
-sub _new_setname {
- my ($self) = @_;
- return ("set_".$self->{rscount}++);
-}
-
-sub _search_pqf {
- my ($self, $query, $setname) = @_;
-
-
- my $hits = 0;
-
- my $res = IDZebra::search_PQF($self->{zh},
- $query,
- $setname,
- \$hits);
-
- my $rs = IDZebra::Resultset->new($self,
- name => $setname,
- query => $query,
- recordCount => $hits,
- errCode => $self->errCode,
- errString => $self->errString);
- return($rs);
-}
-
-# -----------------------------------------------------------------------------
-# Sort
-#
-# Sorting of multiple result sets is not supported by zebra...
-# -----------------------------------------------------------------------------
-
-sub sortResultsets {
- my ($self, $sortspec, $setname, @sets) = @_;
-
- $self->checkzh;
-
- if ($#sets > 0) {
- croak ("Sorting/merging of multiple resultsets is not supported now");
- }
-
- my @setnames;
- my $count = 0;
- foreach my $rs (@sets) {
- push (@setnames, $rs->{name});
- $count += $rs->{recordCount}; # is this really sure ??? It doesn't
- # matter now...
- }
-
- my $status = IDZebra::sort($self->{zh},
- $self->{odr_output},
- $sortspec,
- $setname,
- \@setnames);
-
-
- my $errCode = $self->errCode;
- my $errString = $self->errString;
-
- logf (LOG_LOG, "Sort status $setname: %d, errCode: %d, errString: %s",
- $status, $errCode, $errString);
-
- if ($status || $errCode) {$count = 0;}
-
- my $rs = IDZebra::Resultset->new($self,
- name => $setname,
- recordCount => $count,
- errCode => $errCode,
- errString => $errString);
-
- return ($rs);
-}
-# -----------------------------------------------------------------------------
-# Scan
-# -----------------------------------------------------------------------------
-sub scan {
- my ($self, %args) = @_;
-
- $self->checkzh;
-
- unless ($args{expression}) {
- croak ("No scan expression given");
- }
-
- my $sl = IDZebra::ScanList->new($self,%args);
-
- return ($sl);
-}
-
-# ============================================================================
-
-__END__
-
-=head1 NAME
-
-IDZebra::Session - A Zebra database server session for update and retrieval
-
-=head1 SYNOPSIS
-
- $sess = IDZebra::Session->new(configFile => 'demo/zebra.cfg');
- $sess->open();
-
- $sess = IDZebra::Session->open(configFile => 'demo/zebra.cfg',
- groupName => 'demo1');
-
- $sess->group(groupName => 'demo2');
-
- $sess->init();
-
- $sess->begin_trans;
-
- $sess->update(path => 'lib');
-
- my $s1=$sess->update_record(data => $rec1,
- recordType => 'grs.perl.pod'
- );
-
- my $stat = $sess->end_trans;
-
- $sess->databases('demo1','demo2');
-
- my $rs1 = $sess->search(cqlmap => 'demo/cql.map',
- cql => 'dc.title=IDZebra',
- databases => [qw(demo1 demo2)]);
- $sess->close;
-
-=head1 DESCRIPTION
-
-Zebra is a high-performance, general-purpose structured text indexing and retrieval engine. It reads structured records in a variety of input formats (eg. email, XML, MARC) and allows access to them through exact boolean search expressions and relevance-ranked free-text queries.
-
-Zebra supports large databases (more than ten gigabytes of data, tens of millions of records). It supports incremental, safe database updates on live systems. You can access data stored in Zebra using a variety of Index Data tools (eg. YAZ and PHP/YAZ) as well as commercial and freeware Z39.50 clients and toolkits.
-
-=head1 OPENING AND CLOSING A ZEBRA SESSIONS
-
-For the time beeing only local database services are supported, the same way as calling zebraidx or zebrasrv from the command shell. In order to open a local Zebra database, with a specific configuration file, use
-
- $sess = IDZebra::Session->new(configFile => 'demo/zebra.cfg');
- $sess->open();
-
-or
-
- $sess = IDZebra::Session->open(configFile => 'demo/zebra.cfg');
-
-where $sess is going to be the object representing a Zebra Session. Whenever this variable gets out of scope, the session is closed, together with all active transactions, etc... Anyway, if you'd like to close the session, just say:
-
- $sess->close();
-
-This will
- - close all transactions
- - destroy all result sets and scan lists
- - close the session
-
-Note, that if I<shadow registers> are enabled, the changes will not be committed automatically.
-
-In the future different database access methods are going to be available,
-like:
-
- $sess = IDZebra::Session->open(server => 'ostrich.technomat.hu:9999');
-
-You can also use the B<record group> arguments described below directly when calling the constructor, or the open method:
-
- $sess = IDZebra::Session->open(configFile => 'demo/zebra.cfg',
- groupName => 'demo');
-
-
-=head1 RECORD GROUPS
-
-If you manage different sets of records that share common characteristics, you can organize the configuration settings for each type into "groups". See the Zebra manual on the configuration file (zebra.cfg).
-
-For each open session a default record group is assigned. You can configure it in the constructor, or by the B<group> method:
-
- $sess->group(groupName => ..., ...)
-
-The following options are available:
-
-=over 4
-
-=item B<groupName>
-
-This will select the named record group, and load the corresponding settings from the configuration file. All subsequent values will overwrite those...
-
-=item B<databaseName>
-
-The name of the (logical) database the updated records will belong to.
-
-=item B<path>
-
-This path is used for directory updates (B<update>, B<delete> methods);
-
-=item B<recordId>
-
-This option determines how to identify your records. See I<Zebra manual: Locating Records>
-
-=item B<recordType>
-
-The record type used for indexing.
-
-=item B<flagStoreData>
-
-Specifies whether the records should be stored internally in the Zebra system files. If you want to maintain the raw records yourself, this option should be false (0). If you want Zebra to take care of the records for you, it should be true(1).
-
-=item B<flagStoreKeys>
-
-Specifies whether key information should be saved for a given group of records. If you plan to update/delete this type of records later this should be specified as 1; otherwise it should be 0 (default), to save register space.
-
-=item B<flagRw>
-
-?
-
-=item B<fileVerboseLimit>
-
-Skip log messages, when doing a directory update, and the specified number of files are processed...
-
-=item B<databaseNamePath>
-
-?
-
-=item B<explainDatabase>
-
-The name of the explain database to be used
-
-=item B<followLinks>
-
-Follow links when doing directory update.
-
-=back
-
-You can use the same parameters calling all update methods.
-
-=head1 TRANSACTIONS (READ / WRITE LOCKS)
-
-A transaction is a block of record update (insert / modify / delete) or retrieval procedures. So, all call to such function will implicitly start a transaction, unless one is already started by
-
- $sess->begin_trans;
-
-or
-
- $sess->begin_trans(TRANS_RW)
-
-(these two are equivalents). The effect of this call is a kind of lock: if you call is a write lock is put on the registers, so other processes trying to update the database will be blocked. If there is already an RW (Read-Write) transaction opened by another process, the I<begin_trans> call will be blocked.
-
-You can also use
-
- $sess->begin_trans(TRANS_RO),
-
-if you would like to put on a "read lock". This one is B<deprecated>, as while you have explicitly opened a transaction for read, you can't open another one for update. For example:
-
- $sess->begin_trans(TRANS_RO);
- $sess->begin_tran(TRANS_RW); # invalid, die here
- $sess->end_trans;
- $sess->end_trans;
-
-is invalid, but
-
- $sess->begin_tran(TRANS_RW);
- $sess->begin_trans(TRANS_RO);
- $sess->end_trans;
- $sess->end_trans;
-
-is valid, but probably useless. Note again, that for each retrieval call, an RO transaction is opened. I<TRANS_RW> and I<TRANS_RO> are exported by default by IDZebra::Session.pm.
-
-For multiple per-record I<updates> it's efficient to start transactions explicitly: otherwise registers (system files, vocabularies, etc..) are updated one by one. After finishing all requested updates, use
-
- $stat = $sess->end_trans;
-
-The return value is a ZebraTransactionStatus object, containing the following members as a hash reference:
-
- $stat->{processed} # Number of records processed
- $stat->{updated} # Number of records processed
- $stat->{deleted} # Number of records processed
- $stat->{inserted} # Number of records processed
- $stat->{stime} # System time used
- $stat->{utime} # User time used
-
-Normally, if the perl code dies due to some runtime error, or the session is closed, then the API attempts to close all pending transactions.
-
-=head1 THE SHADOW REGISTERS
-
-The Zebra server supports updating of the index structures. That is, you can add, modify, or remove records from databases managed by Zebra without rebuilding the entire index. Since this process involves modifying structured files with various references between blocks of data in the files, the update process is inherently sensitive to system crashes, or to process interruptions: Anything but a successfully completed update process will leave the register files in an unknown state, and you will essentially have no recourse but to re-index everything, or to restore the register files from a backup medium. Further, while the update process is active, users cannot be allowed to access the system, as the contents of the register files may change unpredictably.
-
-You can solve these problems by enabling the shadow register system in Zebra. During the updating procedure, zebraidx will temporarily write changes to the involved files in a set of "shadow files", without modifying the files that are accessed by the active server processes. If the update procedure is interrupted by a system crash or a signal, you simply repeat the procedure - the register files have not been changed or damaged, and the partially written shadow files are automatically deleted before the new updating procedure commences.
-
-At the end of the updating procedure (or in a separate operation, if you so desire), the system enters a "commit mode". First, any active server processes are forced to access those blocks that have been changed from the shadow files rather than from the main register files; the unmodified blocks are still accessed at their normal location (the shadow files are not a complete copy of the register files - they only contain those parts that have actually been modified). If the commit process is interrupted at any point during the commit process, the server processes will continue to access the shadow files until you can repeat the commit procedure and complete the writing of data to the main register files. You can perform multiple update operations to the registers before you commit the changes to the system files, or you can execute the commit operation at the end of each update operation. When the commit phase has completed successfully, any running server processes are instructed to switch their operations to the new, operational register, and the temporary shadow files are deleted.
-
-By default, (in the API !) the use of shadow registers is disabled. If zebra is configured that way (there is a "shadow" entry in zebra.cfg), then the shadow system can be enabled by calling:
-
- $sess->shadow(1);
-
-or disabled by
-
- $sess->shadow(0);
-
-If shadow system is enabled, then you have to commit changes you did, by calling:
-
- $sess->commit;
-
-Note, that you can also determine shadow usage in the session constructor:
-
- $sess = IDZebra::Session->open(configFile => 'demo/zebra.cfg',
- shadow => 1);
-
-Changes to I<shadow> will not have effect, within a I<transaction> (ie.: a transaction is started either with shadow enabled or disabled). For more details, read Zebra documentation: I<Safe Updating - Using Shadow Registers>.
-
-=head1 UPDATING DATA
-
-There are two ways to update data in a Zebra database using the perl API. You can update an entire directory structure just the way it's done by zebraidx:
-
- $sess->update(path => 'lib');
-
-This will update the database with the files in directory "lib", according to the current record group settings.
-
- $sess->update();
-
-This will update the database with the files, specified by the default record group setting. I<path> has to be specified there...
-
- $sess->update(groupName => 'demo1',
- path => 'lib');
-
-Update the database with files in "lib" according to the settings of group "demo1"
-
- $sess->delete(groupName => 'demo1',
- path => 'lib');
-
-Delete the records derived from the files in directory "lib", according to the "demo1" group settings. Sounds complex? Read zebra documentation about identifying records.
-
-You can also update records one by one, even directly from the memory:
-
- $sysno = $sess->update_record(data => $rec1,
- recordType => 'grs.perl.pod',
- groupName => "demo1");
-
-This will update the database with the given record buffer. Note, that in this case recordType is explicitly specified, as there is no filename given, and for the demo1 group, no default record type is specified. The return value is the system assigned id of the record.
-
-You can also index a single file:
-
- $sysno = $sess->update_record(file => "lib/IDZebra/Data1.pm");
-
-Or, provide a buffer, and a filename (where filename will only be used to identify the record, if configured that way, and possibly to find out it's record type):
-
- $sysno = $sess->update_record(data => $rec1,
- file => "lib/IDZebra/Data1.pm");
-
-And some crazy stuff:
-
- $sysno = $sess->delete_record(sysno => $sysno);
-
-where sysno in itself is sufficient to identify the record
-
- $sysno = $sess->delete_record(data => $rec1,
- recordType => 'grs.perl.pod',
- groupName => "demo1");
-
-This case the record is extracted, and if already exists, located in the database, then deleted...
-
- $sysno = $sess->update_record(data => $rec1,
- match => $myid,
- recordType => 'grs.perl.pod',
- groupName => "demo1");
-
-Don't try this at home! This case, the record identifier string (which is normally generated according to the rules set in I<recordId> member of the record group, or in the I<recordId> parameter) is provided directly.... Looks much better this way:
-
- $sysno = $sess->update_record(data => $rec1,
- databaseName => 'books',
- recordId => '(bib1,ISBN)',
- recordType => 'grs.perl.pod',
- flagStoreData => 1,
- flagStoreKeys => 1);
-
-You can notice, that it's not necessary to define a record group in zebra.cfg: you can do it "on the fly" in your code.
-
-B<Important:> Note, that one record can be updated only once within a transaction - all subsequent updates are skipped. If you'd like to override this feature, use the I<force=E<gt>1> flag:
-
- $sysno = $sess->update_record(data => $rec1,
- recordType => 'grs.perl.pod',
- groupName => "demo1",
- force => 1);
-
-If you don't like to update the record, if it alerady exists, use the I<insert_record> method:
-
- $sysno = $sess->insert_record(data => $rec1,
- recordType => 'grs.perl.pod',
- groupName => "demo1");
-
-In this case, sysno will be -1, if the record could not be added, because there was already one in the database, with the same record identifier (generated according to the I<recordId> setting).
-
-=head1 DATABASE SELECTION
-
-Within a zebra repository you can define logical databases. You can either do this by record groups, or by providing the databaseName argument for update methods. For each record the database name it belongs to is stored.
-
-For searching, you can select databases by calling:
-
- $sess->databases('db1','db2');
-
-This will not do anything if the given and only the given databases are already selected. You can get the list of the actually selected databases, by calling:
-
- @dblist = $sess->databases();
-
-=head1 SEARCHING
-
-It's nice to be able to store data in your repository... But it's useful to reach it as well. So this is how to do searching:
-
- $rs = $sess->search(databases => [qw(demo1,demo2)], # optional
- pqf => '@attr 1=4 computer');
-
-This is going to execute a search in databases demo1 and demo2, for title 'com,puter'. This is a PQF (Prefix Query Format) search, see YAZ documentation for details. The database selection is optional: if it's provided, the given list of databases is selected for this particular search, then the original selection is restored.
-
-=head2 CCL searching
-
-Not all users enjoy typing in prefix query structures and numerical attribute values, even in a minimalistic test client. In the library world, the more intuitive Common Command Language (or ISO 8777) has enjoyed some popularity - especially before the widespread availability of graphical interfaces. It is still useful in applications where you for some reason or other need to provide a symbolic language for expressing boolean query structures.
-
-The CCL searching is not currently supported by this API.
-
-=head2 CQL searching
-
-CQL - Common Query Language - was defined for the SRW protocol. In many ways CQL has a similar syntax to CCL. The objective of CQL is different. Where CCL aims to be an end-user language, CQL is the protocol query language for SRW.
-
-In order to map CQL queries to Zebra internal search structures, you have to define a mapping, the way it is described in YAZ documentation: I<Specification of CQL to RPN mapping>. The mapping is interpreted by the method:
-
- $sess->cqlmap($mapfile);
-
-Or, you can directly provide the I<mapfile> parameter for the search:
-
- $rs = $sess->search(cqlmap => 'demo/cql.map',
- cql => 'dc.title=IDZebra');
-
-As you see, CQL searching is so simple: just give the query in the I<cql> parameter.
-
-=head2 Sorting
-
-If you'd like the search results to be sorted, use the I<sort> parameter:
-
- $rs = $sess->search(cql => 'IDZebra',
- sort => '1=4 ia');
-
-Note, that B<currently> this is (almost) equivalent to
-
- $rs = $sess->search(cql => 'IDZebra');
- $rs->sort('1=4 ia');
-
-but in the further versions of Zebra and this API a single phase search and sort will take place, optimizing performance. For more details on sorting, see I<IDZebra::ResultSet> manpage.
-
-=head1 RESULTSETS
-
-As you have seen, the result of the search request is a I<Resultset> object.
-It contains number of hits, and search status, and can be used to sort and retrieve the resulting records.
-
- $count = $rs->count;
-
- printf ("RS Status is %d (%s)\n", $rs->errCode, $rs->errString);
-
-I<$rs-E<gt>errCode> is 0, if there were no errors during search. Read the I<IDZebra::Resultset> manpage for more details.
-
-=head1 SCANNING
-
-Zebra supports scanning index values. The result of the
-
- $sl = $sess->scan(expression => "a");
-
-call is an I<IDZebra::ScanList> object, what you can use to list the values. The scan expression has to be provided in a PQF like format. Examples:
-
-B< a> (scan trough words of "default", "Any" indexes)
-
-
-B< @attr 1=1016 a> (same effect)
-
-
-B< @attr 1=4 @attr 6=2 a> (scan trough titles as phrases)
-
-An illegal scan expression will cause your code to die. If you'd like to select databases just for the scan call, you can optionally use the I<databases> parameter:
-
- $sl = $sess->scan(expression => "a",
- databases => [qw(demo1 demo2)]);
-
-You can use the I<IDZebra::ScanList> object returned by the i<scan> method, to reach the result. Check I<IDZebra::ScanList> manpage for more details.
-
-=head1 SESSION STATUS AND ERRORS
-
-Most of the API calls causes die, if an error occures. You avoid this, by using eval {} blocks. The following methods are available to get the status of Zebra service:
-
-=over 4
-
-=item B<errCode>
-
-The Zebra provided error code... (for the result of the last call);
-
-=item B<errString>
-
-Error string corresponding to the message
-
-=item B<errAdd>
-
-Additional information for the status
-
-=back
-
-This functionality may change, see TODO.
-
-=head1 LOGGING AND MISC. FUNCTIONS
-
-Zebra provides logging facility for the internal events, and also for application developers trough the API. See manpage I<IDZebra::Logger> for details.
-
-=over 4
-
-=item B<IDZebra::LogFile($filename)>
-
-Will set the output file for logging. By default it's STDERR;
-
-=item B<IDZebra::LogLevel(15)>
-
-Set log level. 0 for no logs. See IDZebra::Logger for usable flags.
-
-=back
-
-Some other functions
-
-=over 4
-
-=item B<$sess-E<gt>init>
-
-Initialize, and clean registers. This will remove all data!
-
-=item B<$sess-E<gt>compact>
-
-Compact the registers (? does this work)
-
-=item B<$sess-E<gt>show>
-
-Doesn't have too much meaning. Don't try :)
-
-=back
-
-=head1 TODO
-
-=over 4
-
-=item B<Clean up error handling>
-
-By default all zebra errors should cause die. (such situations could be avoided by using eval {}), and then check for errCode, errString... An optional flag or package variable should be introduced to override this, and skip zebra errors, to let the user decide what to do.
-
-=item B<Make the package self-distributable>
-
-Build and link with installed header and library files
-
-=item B<Testing>
-
-Test shadow system, unicode...
-
-=item B<C API>
-
-Cleanup, arrange, remove redundancy
-
-=back
-
-=head1 COPYRIGHT
-
-Fill in
-
-=head1 AUTHOR
-
-Peter Popovics, pop@technomat.hu
-
-=head1 SEE ALSO
-
-Zebra documentation, Zebra::ResultSet, Zebra::ScanList, Zebra::Logger manpages
-
-=cut
+++ /dev/null
-#!/bin/sh
-PERL_DL_NONLAZY=1 /usr/bin/perl "-MExtUtils::Command::MM" "-e" "test_harness(0,'blib/lib', 'blib/arch')" $*
+++ /dev/null
-#!perl -Tw
-# =============================================================================
-# $Id: 01_base.t,v 1.6 2004-07-28 08:15:47 adam Exp $
-#
-# Perl API header
-# =============================================================================
-BEGIN {
- if ($ENV{PERL_CORE}) {
- chdir 't' if -d 't';
- }
- push (@INC,'demo','blib/lib','blib/arch');
-}
-
-use strict;
-use warnings;
-
-use Test::More tests=>8;
-
-# ----------------------------------------------------------------------------
-# Session opening and closing
-BEGIN {
- use_ok('IDZebra');
- unlink("test01.log");
- IDZebra::logFile("test01.log");
- use_ok('IDZebra::Session');
-}
-
-use pod;
-# ----------------------------------------------------------------------------
-# Just to be sure...
-mkdir ("demo/tmp", 0750);
-mkdir ("demo/lock", 0750);
-mkdir ("demo/register", 0750);
-mkdir ("demo/shadow", 0750);
-
-# ----------------------------------------------------------------------------
-# Session opening and closing
-my $sess = IDZebra::Session->new(configFile => 'demo/zebra.cfg');
-isa_ok($sess,"IDZebra::Session");
-
-$sess->open();
-ok(defined($sess->{zh}), "Zebra handle opened");
-
-$sess->close();
-ok(!defined($sess->{zh}), "Zebra handle closed");
-
-$sess = IDZebra::Session->open(configFile => 'demo/zebra.cfg',
- groupName => 'demo1');
-isa_ok($sess,"IDZebra::Session");
-ok(defined($sess->{zh}), "Zebra handle opened");
-
-# ----------------------------------------------------------------------------
-# Record group tests deleted
-# ADAM: we cant do this anymore!
-#ok(($sess->group->{databaseName} eq "demo1"),"Record group is selected");
-
-#$sess->group(groupName => 'demo2');
-
-#ok(($sess->group->{databaseName} eq "demo2"),"Record group is selected");
-
-# ---------------------------------------------------------------------------
-# Transactions
-$sess->begin_trans(TRANS_RO);
-eval {$sess->begin_trans(TRANS_RW);};
-ok (($@ ne ""), $@);
-$sess->end_trans;
-$sess->end_trans;
-
-
-# ----------------------------------------------------------------------------
-# Close session
-
-
-$sess->close;
-
+++ /dev/null
-#!perl
-# =============================================================================
-# $Id: 02_directory_update.t,v 1.4 2004-07-28 08:15:47 adam Exp $
-#
-# Perl API header
-# =============================================================================
-BEGIN {
- if ($ENV{PERL_CORE}) {
- chdir 't' if -d 't';
- }
- push (@INC,'demo','blib/lib','blib/arch');
-}
-
-use strict;
-use warnings;
-
-use Test::More tests => 8;
-
-# ----------------------------------------------------------------------------
-# Session opening and closing
-BEGIN {
- use_ok('IDZebra');
- unlink("test02.log");
- IDZebra::logFile("test02.log");
- use_ok('IDZebra::Session');
- use_ok('pod');
-}
-
-
-# ----------------------------------------------------------------------------
-# Session opening and closing
-my $sess = IDZebra::Session->open(configFile => 'demo/zebra.cfg',
- groupName => 'demo2');
-isa_ok($sess,"IDZebra::Session");
-
-SKIP: {
- skip "Takes a while", 5 if (0);
-
-# ----------------------------------------------------------------------------
-# init repository
-$sess->init();
-# ----------------------------------------------------------------------------
-# repository upadte
-
-# ADAM: we must set database separately (can't be used from group)
-$sess->databases('demo2');
-
-our $filecount = 8;
-$sess->begin_trans;
-$sess->update(path => 'lib');
-my $stat = $sess->end_trans;
-
-ok(($stat->{inserted} == $filecount),
- "Inserted $stat->{inserted}/$filecount records");
-
-# ADAM: we must set database separately (can't be used from group)
-$sess->databases('demo1');
-
-$sess->begin_trans;
-$sess->update(groupName => 'demo1',
- path => 'lib');
-
-$stat = $sess->end_trans;
-ok(($stat->{inserted} == $filecount),
- "Inserted $stat->{inserted}/$filecount records");
-
-$sess->begin_trans;
-$sess->delete(groupName => 'demo1',
- path => 'lib');
-$stat = $sess->end_trans;
-ok(($stat->{deleted} == $filecount),
- "Deleted $stat->{deleted}/$filecount records");
-
-$sess->begin_trans;
-$sess->update(groupName => 'demo1',
- path => 'lib');
-
-$stat = $sess->end_trans;
-ok(($stat->{inserted} == $filecount),
- "Inserted $stat->{inserted}/$filecount records with shadow");
-
-# ok(($sess->group->{databaseName} eq "demo2"),"Original group is selected"); deleted
-
-# ----------------------------------------------------------------------------
-# Close session
-}
-$sess->close;
+++ /dev/null
-#!perl
-# =============================================================================
-# $Id: 03_record_update.t,v 1.10 2004-09-15 14:11:06 heikki Exp $
-#
-# Perl API header
-# =============================================================================
-BEGIN {
- if ($ENV{PERL_CORE}) {
- chdir 't' if -d 't';
- }
- unshift (@INC,'demo','blib/lib','blib/arch');
-}
-
-use strict;
-use warnings;
-
-use Test::More tests => 15;
-
-# ----------------------------------------------------------------------------
-# Session opening and closing
-BEGIN {
- use_ok('IDZebra');
- unlink("test03.log");
- IDZebra::logFile("test03.log");
- use_ok('IDZebra::Session');
- use_ok('pod');
-}
-
-
-# ----------------------------------------------------------------------------
-# Session opening and closing
-my $sess = IDZebra::Session->open(configFile => 'demo/zebra.cfg',
- groupName => 'demo2',
- shadow => 1);
-isa_ok($sess,"IDZebra::Session");
-
-# ----------------------------------------------------------------------------
-# per record update
-my $rec1=`cat lib/IDZebra/Data1.pm`;
-my $rec2=`cat lib/IDZebra/Filter.pm`;
-my $rec3=`cat lib/IDZebra/Session.pm`;
-
-my ($sysno, $stat, $ret);
-
-$sess->init;
-$sess->databases('demo1');
-
-$sess->begin_trans;
-
-($ret,$sysno) = $sess->insert_record(data => $rec1,
- recordType => 'grs.perl.pod',
- );
-
-ok(($ret == 0),"Must return ret=0 (OK)");
-
-$stat = $sess->end_trans;
-ok(($stat->{inserted} == 1), "Inserted 1 records");
-
-$sess->begin_trans;
-($ret,$sysno) = $sess->insert_record(data => $rec2,
- recordType => 'grs.perl.pod',
- );
-ok(($ret == 0),"Insert record ok");
-
-$stat = $sess->end_trans;
-ok(($stat->{inserted} == 1), "Inserted 1 records");
-
-
-$sess->begin_trans;
-($ret,$sysno) = $sess->update_record(data => $rec3,
- recordType => 'grs.perl.pod',
- sysno => $sysno,
- );
-
-ok(($ret == 0),"update record ok");
-
-
-$stat = $sess->end_trans;
-ok(($stat->{inserted} == 0), "not inserted");
-ok(($stat->{updated} == 1), "updated ok");
-$sess->commit;
-
-$sess->begin_trans;
-#print STDERR "\nAbout to call delete. sysno=$sysno \n"; #!!!
-($ret,$sysno) = $sess->delete_record( data => $rec3,
- sysno => $sysno,
- recordType => 'grs.perl.pod',
- );
-ok(($ret == 0),"delete record ok");
-
-#print STDERR "\nafter delete ret=$ret sysno=$sysno \n"; #!!!
-
-$stat = $sess->end_trans;
-ok(($stat->{inserted} == 0), "not inserted");
-ok(($stat->{updated} == 0), "updated ok");
-ok(($stat->{deleted} == 1), "deleted ok");
-$sess->commit;
-
-
-
-$sess->close;
+++ /dev/null
-#!perl
-# =============================================================================
-# $Id: 04_cql.t,v 1.3 2004-07-28 08:15:47 adam Exp $
-#
-# Perl API header
-# =============================================================================
-BEGIN {
- if ($ENV{PERL_CORE}) {
- chdir 't' if -d 't';
- }
- push (@INC,'demo','blib/lib','blib/arch');
-}
-
-use strict;
-use warnings;
-
-use Test::More tests => 7;
-
-# ----------------------------------------------------------------------------
-# Session opening and closing
-BEGIN {
- use IDZebra;
- unlink("test04.log");
- IDZebra::logFile("test04.log");
- use_ok('IDZebra::Session');
-}
-
-
-# ----------------------------------------------------------------------------
-# Session opening and closing
-my $sess = IDZebra::Session->new();
-
-# ----------------------------------------------------------------------------
-# CQL stuff
-$sess->cqlmap('demo/cql.map');
-
-$SIG{__WARN__} = \&catch_warn;
-
-&check_cql($sess, "IDZebra", 0);
-&check_cql($sess, "dc.title=IDZebra", 0);
-&check_cql($sess, "dc.title=(IDZebra and Session)", 0);
-&check_cql($sess, "dc.title=IDZebra and Session)", -1);
-&check_cql($sess, "dc.title='IDZebra::Session'", 0);
-&check_cql($sess, "anything=IDZebra", 16);
-
-sub check_cql {
- my ($sess, $query, $exp) = @_;
- my ($rpn, $stat) = $sess->cql2pqf($query);
- if ($exp) {
- ok(($stat == $exp), "Wrong query ($stat): '$query'");
- } else {
- ok((($stat == 0) && ($rpn ne "")), "Good query query: '$query'");
- }
-}
-
-
-sub catch_warn {
- 1;
-}
+++ /dev/null
-#!perl
-# =============================================================================
-# $Id: 05_search.t,v 1.5 2004-09-15 14:11:06 heikki Exp $
-#
-# Perl API header
-# =============================================================================
-BEGIN {
- if ($ENV{PERL_CORE}) {
- chdir 't' if -d 't';
- }
- push (@INC,'demo','blib/lib','blib/arch');
-}
-
-use strict;
-use warnings;
-
-use Test::More tests => 7;
-
-# ----------------------------------------------------------------------------
-BEGIN {
- use IDZebra;
- unlink("test05.log");
- IDZebra::logFile("test05.log");
- use_ok('IDZebra::Session');
- use_ok('pod');
-}
-
-
-# ----------------------------------------------------------------------------
-# Session opening and closing
-my $sess = IDZebra::Session->open(configFile => 'demo/zebra.cfg',
- groupName => 'demo2');
-isa_ok($sess,"IDZebra::Session");
-
-# Insert some test data
-my $ret;
-my $sysno;
-my $F;
-my $filecount=0;
-$sess->databases('demo1', 'demo2');
-$sess->init();
-for $F (<"lib/IDZebra/*.pm">)
-{
- ($ret,$sysno)=$sess->insert_record (file=>$F, recordType => 'grs.perl.pod');
- ok( $ret==0, "inserted $F");
- $filecount++;
-}
-# ----------------------------------------------------------------------------
-# search
-
-my ($hits, $expected);
-
-# Search 1 databases
-my $rs1 = $sess->search(cqlmap => 'demo/cql.map',
- cql => 'IDZebra',
- termset => 1,
- databases => [qw(demo1)]);
-
-$expected = $filecount;
-$hits = $rs1->count;
-ok(($hits == $expected), "CQL search - found $hits/$expected records");
-
-
-$sess->databases('demo1', 'demo2');
-my @dblist = $sess->databases;
-ok(($#dblist == 1), "Select multiple databases");
-
-
-# Search 2 databases
-my $rs2 = $sess->search(cqlmap => 'demo/cql.map',
- cql => 'IDZebra');
-$expected = $filecount * 2;
-$hits = $rs2->count;
-ok(($hits == $expected), "CQL search - found $hits/$expected records");
-
-# RPN search;
-my $rs3 = $sess->search(cqlmap => 'demo/cql.map',
- pqf => '@attr 1=4 IDZebra');
-$expected = $filecount * 2;
-$hits = $rs3->count;
-ok(($hits == $expected), "RPN search - found $hits/$expected records");
-
-#### Terms is broken time being, don't bother testing it
-# Termlists;
-#my $rs4 = $sess->search(pqf => '@attr 1=4 @and IDZebra Session');
-#$expected = 2;
-#$hits = $rs4->count;
-#ok(($hits == $expected), "RPN search - found $hits/$expected records");
-#print STDERR "Test 8: found $hits of $expected\n";
-#
-#my @terms = $rs4->terms();
-#ok(($#terms == 1), "Got 2 terms in RPN expression");
-#my $cc = 0;
-#foreach my $t (@terms) {
-# if ($t->{term} eq 'IDZebra') {
-# ok(($t->{count} = $filecount*2), "Term IDZebra ($t->{count})");
-# $cc++;
-# }
-# elsif ($t->{term} eq 'Session') {
-# ok(($t->{count} = 2), "Term Session ($t->{count})");
-# $cc++;
-# } else {
-# ok(0,"Invalid term $t->{term}");
-# }
-#
-#}
-#ok (($cc == 2), "Got 2 terms for RS");
-
-
-
-# More specific search
-
-
-# ----------------------------------------------------------------------------
-# Close session
-
-$sess->close;
+++ /dev/null
-#!perl
-# =============================================================================
-# $Id: 06_retrieval.t,v 1.6 2004-09-15 14:11:06 heikki Exp $
-#
-# Perl API header
-# =============================================================================
-BEGIN {
- if ($ENV{PERL_CORE}) {
- chdir 't' if -d 't';
- }
- push (@INC,'demo','blib/lib','blib/arch');
-}
-
-use strict;
-use warnings;
-
-use Test::More tests => 30;
-
-# ----------------------------------------------------------------------------
-# Session opening and closing
-BEGIN {
- use IDZebra;
- unlink("test06.log");
- IDZebra::logFile("test06.log");
- use_ok('IDZebra::Session');
- use_ok('pod');
-}
-
-
-# ----------------------------------------------------------------------------
-# Session opening and closing
-my $sess = IDZebra::Session->open(configFile => 'demo/zebra.cfg',
- groupName => 'demo2');
-ok($sess,"session");
-
-# ----------------------------------------------------------------------------
-# Insert some test data
-my $ret;
-my $sysno;
-my $F;
-my $filecount=0;
-$sess->init;
-$sess->begin_trans;
-$sess->databases('demo1', 'demo2');
-$ret=$sess->end_trans;
-
-$sess->begin_trans;
-for $F (<lib/IDZebra/*.pm>)
-{
- ($ret,$sysno)=$sess->insert_record (file=>$F, recordType => 'grs.perl.pod');
- ok( $ret==0, "inserted $F");
- #print STDERR "Inserted $F ok. ret=$ret sys=$sysno\n";
- $filecount++;
-}
-$ret=$sess->end_trans;
-ok($filecount>0,"Inserted files");
-is($ret->{inserted},$filecount, "Inserted all");
-
-# search
-
-my ($hits, $expected);
-
-# Search 1 database
-my $rs1 = $sess->search(cqlmap => 'demo/cql.map',
- cql => 'IDZebra',
- databases => [qw(demo1)]);
-
-$expected = $filecount;
-$hits = $rs1->count;
-is($hits, $expected, "CQL search ");
-
-foreach my $rec ($rs1->records(from =>1,
- to =>5)) {
- isa_ok($rec,'IDZebra::RetrievalRecord');
-}
-
-my (@recs) = $rs1->records(from=>1,to=>1);
-
-ok ($#recs == 0, "Fetched 1 record");
-
-my $rec1 = shift(@recs);
-
-isa_ok($rec1,'IDZebra::RetrievalRecord');
-ok (($rec1->{errCode} == 0), "err: $rec1->{errCode}");
-ok (($rec1->{errString} eq ""), "errString: $rec1->{errString}");
-ok (($rec1->{position} == 1), "position: $rec1->{position}");
-ok (($rec1->{base} eq 'demo1'), "base: $rec1->{base}");
-ok (($rec1->{sysno}), "sysno: $rec1->{sysno}");
-ok (($rec1->{score}), "score: $rec1->{score}");
-ok (($rec1->{format} eq 'SUTRS'), "format: $rec1->{format}");
-ok ((length($rec1->{buf}) > 0), "buf: ". length($rec1->{buf})." bytes");
-
-# ----------------------------------------------------------------------------
-# Close session, check for rs availability
-
-$sess=undef;
-
-eval { my ($rec2) = $rs1->records(from=>1,to=>1); };
-
-ok (($@ ne ""), "Resultset is invalidated with session");
-# ----------------------------------------------------------------------------
-# Code from doc...
-# foreach my $rec ($rs1->records()) {
-# print STDERR "REC:$rec\n";
-# unless ($rec->errCode) {
-# printf ("Pos:%d, Base: %s, sysno: %d, score %d format: %s\n%s\n\n",
-# $rec->position,
-# $rec->base,
-# $rec->sysno,
-# $rec->score,
-# $rec->format,
-# $rec->buf
-# );
-# }
-# }
-
-
+++ /dev/null
-#!perl
-# =============================================================================
-# $Id: 07_sort.t,v 1.4 2004-09-16 15:07:55 heikki Exp $
-#
-# Perl API header
-# =============================================================================
-BEGIN {
- if ($ENV{PERL_CORE}) {
- chdir 't' if -d 't';
- }
- push (@INC,'demo','blib/lib','blib/arch');
-}
-
-use strict;
-use warnings;
-
-use Test::More tests => 32;
-
-# ----------------------------------------------------------------------------
-# Session opening and closing
-BEGIN {
- use IDZebra;
- unlink("test07.log");
- IDZebra::logFile("test07.log");
-# IDZebra::logLevel(0x4F);
-# IDZebra::logLevel(15);
- use_ok('IDZebra::Session');
- use_ok('pod');
-}
-
-
-# ----------------------------------------------------------------------------
-# Session opening and closing
-my $sess = IDZebra::Session->open(configFile => 'demo/zebra.cfg',
- groupName => 'demo2');
-# ----------------------------------------------------------------------------
-# Insert some test data
-my $ret;
-my $sysno;
-my $F;
-my $filecount=0;
-$sess->init;
-$sess->begin_trans;
-$sess->databases('demo1', 'demo2');
-$ret=$sess->end_trans;
-
-$sess->begin_trans;
-for $F (<lib/IDZebra/*.pm>)
-{
- ($ret,$sysno)=$sess->insert_record (file=>$F, recordType => 'grs.perl.pod');
- ok( $ret==0, "inserted $F");
- #print STDERR "Inserted $F ok. ret=$ret sys=$sysno\n";
- $filecount++;
-}
-$ret=$sess->end_trans;
-ok($filecount>0,"Inserted files");
-is($ret->{inserted},$filecount, "Inserted all");
-
-
-# -----------------------------------------------------------------------------
-# Search 1 database, retrieve records, sort "titles" locally (dangerous!)
-
-my $rs1 = $sess->search(cqlmap => 'demo/cql.map',
- cql => 'IDZebra',
- databases => [qw(demo1)]);
-
-my (@unsorted, @sorted, @sortedi);
-
-my $wasError = 0;
-my $sortError = 0;
-foreach my $rec ($rs1->records()) {
- if ($rec->{errCode}) {
- $wasError++;
- }
- my ($title) = ($rec->buf =~ /\n\s*package\s+([a-zA-Z0-9:]+)\s*\;\s*\n/);
- push (@unsorted, $title);
-}
-ok (($wasError == 0), "retrieval");
-
-@sorted = sort (@unsorted);
-no warnings;
-@sortedi = sort ({my $a1=$a; $a1 =~ y/[A-Z]/[a-z]/;
- my $b1=$b; $b1 =~ y/[A-Z]/[a-z]/;
- ($a1 cmp $b1);} @unsorted);
-use warnings;
-
-# -----------------------------------------------------------------------------
-# Sort rs itself ascending
-
-isa_ok ($rs1, 'IDZebra::Resultset');
-
-$rs1->sort('1=4 ia');
-
-isa_ok ($rs1, 'IDZebra::Resultset');
-
-$wasError = 0;
-$sortError = 0;
-foreach my $rec ($rs1->records()) {
- if ($rec->{errCode}) { $wasError++; }
- my ($title) = ($rec->buf =~ /\n\s*package\s+([a-zA-Z0-9:]+)\s*\;\s*\n/);
- if ($sortedi[$rec->position - 1] ne $title) { $sortError++; }
-}
-
-ok (($wasError == 0), "retrieval");
-ok (($sortError == 0), "sorting ascending");
-
-# -----------------------------------------------------------------------------
-# Sort descending, new rs
-#TODO: {
-# todo_skip "Sort into different rset crashes", 3;
-
-my $rs2 = $rs1->sort('1=4 id');
-
-isa_ok ($rs2, 'IDZebra::Resultset');
-
-$wasError = 0;
-$sortError = 0;
-foreach my $rec ($rs2->records()) {
- if ($rec->{errCode}) { $wasError++; }
- my ($title) = ($rec->buf =~ /\n\s*package\s+([a-zA-Z0-9:]+)\s*\;\s*\n/);
- if ($sorted[$rs2->count - $rec->position] ne $title) { $sortError++; }
- is ($title, $sorted[$rs2->count - $rec->position], "sort order $title");
-}
-
-
-is ($wasError,0 , "retrieval");
-is ($sortError, 0, "sorting descending");
-
-# } # end of SKIP
-
-# -----------------------------------------------------------------------------
-# Search + sort ascending
-my $rs3 = $sess->search(cql => 'IDZebra',
- databases => [qw(demo1)],
- sort => '1=4 ia');
-isa_ok ($rs3, 'IDZebra::Resultset');
-
-$wasError = 0;
-$sortError = 0;
-foreach my $rec ($rs3->records()) {
- if ($rec->{errCode}) { $wasError++; }
- my ($title) = ($rec->buf =~ /\n\s*package\s+([a-zA-Z0-9:]+)\s*\;\s*\n/);
- if ($sortedi[$rec->position - 1] ne $title) { $sortError++; }
-}
-
-ok (($wasError == 0), "saerch+sort, retrieval");
-ok (($sortError == 0), "search+sort descending");
-
-# ----------------------------------------------------------------------------
-# Bad sort
-
-my $rs4;
-$rs4 = $rs3->sort("ostrich");
-ok (($rs4->errCode != 0),"Wrong sort: ".$rs4->errCode."(".$rs4->errString.")");
-# ----------------------------------------------------------------------------
-# Close session
-$sess->close;
-
+++ /dev/null
-#!perl
-# =============================================================================
-# $Id: 08_scan.t,v 1.4 2004-09-20 15:59:48 heikki Exp $
-#
-# Perl API header
-# =============================================================================
-BEGIN {
- if ($ENV{PERL_CORE}) {
- chdir 't' if -d 't';
- }
- push (@INC,'demo','blib/lib','blib/arch');
-}
-
-use strict;
-use warnings;
-
-use Test::More tests => 32;
-#use Test::More skip_all => "Something rotten with scan.";
-
-# ----------------------------------------------------------------------------
-# Session opening and closing
-BEGIN {
- use IDZebra;
- unlink("test08.log");
- IDZebra::logFile("test08.log");
- IDZebra::logLevel(15);
- use_ok('IDZebra::Session');
- use_ok('pod');
-}
-
-
-# ----------------------------------------------------------------------------
-# Session opening and closing
-my $sess = IDZebra::Session->open(configFile => 'demo/zebra.cfg',
- groupName => 'demo1');
-
-# ----------------------------------------------------------------------------
-# Insert some test data
-my $ret;
-my $sysno;
-my $F;
-my $filecount=0;
-$sess->init;
-
-$sess->begin_trans;
-$sess->databases('demo1', 'demo2');
-for $F (<lib/IDZebra/*.pm>)
-{
- ($ret,$sysno)=$sess->insert_record (file=>$F, recordType => 'grs.perl.pod');
- ok( $ret==0, "inserted $F");
- $filecount++;
-}
-$ret=$sess->end_trans;
-ok($filecount>0,"Inserted files");
-is($ret->{inserted},$filecount, "Inserted all");
-$sess->databases('demo1');
-
-# -----------------------------------------------------------------------------
-# Scan titles in a single (default) database
-$sess->begin_trans;
-IDZebra::logMsg(2,"t08: Starting to scan");
-my $sl0 = $sess->scan(expression => "\@attr 1=4 \@attr 6=1 a");
-IDZebra::logMsg(2,"t08: scan done");
-
-my @ent=$sl0->entries(position => 1,
- num_entries => 3);
-my $nent=@ent;
-is ($nent,3,"got 3 entries");
-
-my $cnt= $sl0->num_entries;
-
-is($cnt,3,"num_entries");
-is($ent[0]->term(),"a", "first entry");
-is($ent[1]->term(),"an", "second entry");
-is($ent[2]->term(),"and", "third entry");
-
-$sess->end_trans;
-# -----------------------------------------------------------------------------
-# Scan titles in a named database
-
-my $sl1 = $sess->scan(expression => "\@attr 1=4 \@attr 6=2 a",
- databases => [qw(demo1)]);
-&test_list($sl1,$filecount, $filecount,1);
-
-# FIXME - Should test multiple databases, but I can't get that to work
-
-
-# -----------------------------------------------------------------------------
-# Scan titles in a single and default database
-my $sl2 = $sess->scan(expression => "\@attr 1=4 \@attr 6=2 a");
-&test_list($sl2,$filecount, $filecount,1);
-
-
-# -----------------------------------------------------------------------------
-# Scan long list, with position...
-my $sl3 = $sess->scan(expression => "\@attr 1=1016 a");
-
-my @entries = $sl3->entries(position => 5,
- num_entries => 10000);
-
-my $count = $#entries + 1;
-ok (($sl3->errCode == 0),"scan successful");
-ok (($sl3->num_entries == $count),"fetched $count entries");
-my $i = 1;
-my $posok = 1;
-foreach my $se (@entries) {
- $posok = 0 if ($se->position != $i);
- $i++;
-}
-ok (($posok),"position of each term");
-
-
-# -----------------------------------------------------------------------------
-# Scan error
-eval {my $sl4 = $sess->scan(expression => "\@attr 1=9999 a");};
-ok (($@ ne ""),"Wrong scan die");
-ok (($sess->errCode != 0),
- "Error reported in session: ".$sess->errCode.
- " (". $sess->errString. ")");
-
-
-# ----------------------------------------------------------------------------
-# Close session
-$sess->close;
-
-# ============================================================================
-sub test_list {
- my ($sl, $ecount, $occ, $offset) = @_;
- my @entries = $sl->entries();
- my $count = $#entries + 1;
- ok (($sl->errCode == 0),"scan successfull");
- ok (($sl->num_entries == $ecount),
- "number of entries is ".$sl->num_entries);
- is ($count,$sl->num_entries,"fetched $count entries");
-
- my $occcount=0;
- my $posok = 1;
- my $i = $offset;
- foreach my $se (@entries) {
- $occcount += $se->occurrences();
- $posok = 0 if ($se->position != $i);
- $i++;
- }
-
- is ($occcount, $occ,"occurrences: $occcount");
- ok (($posok),"position of each term");
-}
+++ /dev/null
-#include "EXTERN.h"
-#include "perl.h"
-#include "XSUB.h"
-
-#include <yaz/yaz-util.h>
-#include <yaz/proto.h>
-#include <yaz/log.h>
-#include <yaz/cql.h>
-#include <yaz/pquery.h>
-
-#include "zebra_perl.h"
-#include "../recctrl/perlread.h"
-#include <idzebra/data1.h>
-
-NMEM handles;
-
-void init (void) {
- nmem_init ();
- yaz_log_init_prefix ("ZebraPerl");
- yaz_log (YLOG_LOG, "Zebra API initialized");
-}
-
-void DESTROY (void) {
- nmem_exit ();
- yaz_log (YLOG_LOG, "Zebra API destroyed");
-}
-
-/* Logging facilities from yaz */
-void logMsg (int level, const char *message) {
- yaz_log(level, "%s", message);
-}
-
-/* debug tool for data1... maybe should be moved to data1.
- perl can't really pass filehandles */
-void data1_print_tree(data1_handle dh, data1_node *n) {
- data1_pr_tree(dh, n, stdout);
-}
-
-/* ---------------------------------------------------------------------------
- Record retrieval
- 2 phase retrieval - I didn't manage to return array of blessed references
- to wrapped structures... it's feasible, but I'll need some time
- / pop - 2002-11-17
-*/
-
-void record_retrieve(RetrievalObj *ro,
- ODR stream,
- RetrievalRecord *res,
- int pos)
-{
- int i = pos - 1;
-
-
- RetrievalRecordBuf *buf =
- (RetrievalRecordBuf *) odr_malloc(stream, sizeof(*buf));
-
- res->errCode = ro->records[i].errCode;
- if (ro->records[i].errString) {
- res->errString = odr_strdup(stream, ro->records[i].errString);
- } else {
- res->errString = "";
- }
- res->position = ro->records[i].position;
- res->base = odr_strdup(stream, ro->records[i].base);
- res->format = (char *)
- yaz_z3950_oid_value_to_str(ro->records[i].format, CLASS_RECSYN);
- res->buf = buf;
- res->buf->len = ro->records[i].len;
- res->buf->buf = ro->records[i].buf;
- res->score = ro->records[i].score;
- res->sysno = ro->records[i].sysno;
-
-}
-
-
-
-/* most of the code here was copied from yaz-client */
-void records_retrieve(ZebraHandle zh,
- ODR stream,
- const char *setname,
- const char *a_eset,
- const char *a_schema,
- const char *a_format,
- int from,
- int to,
- RetrievalObj *res)
-{
- static enum oid_value recordsyntax = VAL_SUTRS;
- static enum oid_value schema = VAL_NONE;
- static Z_ElementSetNames *elementSetNames = 0;
- static Z_RecordComposition compo;
- static Z_ElementSetNames esn;
- static char what[100];
- int i;
- int oid[OID_SIZE];
-
- compo.which = -1;
-
- if (from < 1) from = 1;
- if (from > to) to = from;
- res->noOfRecords = to - from + 1;
-
- res->records = odr_malloc (stream,
- sizeof(*res->records) * (res->noOfRecords));
-
- for (i = 0; i<res->noOfRecords; i++) res->records[i].position = from+i;
-
- if (!a_eset || !*a_eset) {
- elementSetNames = 0;
- } else {
- strcpy(what, a_eset);
- esn.which = Z_ElementSetNames_generic;
- esn.u.generic = what;
- elementSetNames = &esn;
- }
-
- if (!a_schema || !*a_schema) {
- schema = VAL_NONE;
- } else {
- schema = oid_getvalbyname (a_schema);
- if (schema == VAL_NONE) {
- yaz_log(YLOG_WARN,"unknown schema '%s'",a_schema);
- }
- }
-
-
- if (!a_format || !*a_format) {
- recordsyntax = VAL_SUTRS;
- } else {
- recordsyntax = oid_getvalbyname (a_format);
- if (recordsyntax == VAL_NONE) {
- yaz_log(YLOG_WARN,"unknown record syntax '%s', using SUTRS",a_schema);
- recordsyntax = VAL_SUTRS;
- }
- }
-
- if (schema != VAL_NONE) {
- oident prefschema;
-
- prefschema.proto = PROTO_Z3950;
- prefschema.oclass = CLASS_SCHEMA;
- prefschema.value = schema;
-
- compo.which = Z_RecordComp_complex;
- compo.u.complex = (Z_CompSpec *)
- odr_malloc(stream, sizeof(*compo.u.complex));
- compo.u.complex->selectAlternativeSyntax = (bool_t *)
- odr_malloc(stream, sizeof(bool_t));
- *compo.u.complex->selectAlternativeSyntax = 0;
-
- compo.u.complex->generic = (Z_Specification *)
- odr_malloc(stream, sizeof(*compo.u.complex->generic));
- compo.u.complex->generic->which = Z_Schema_oid;
- compo.u.complex->generic->schema.oid = (Odr_oid *)
- odr_oiddup(stream, oid_ent_to_oid(&prefschema, oid));
- if (!compo.u.complex->generic->schema.oid)
- {
- /* OID wasn't a schema! Try record syntax instead. */
- prefschema.oclass = CLASS_RECSYN;
- compo.u.complex->generic->schema.oid = (Odr_oid *)
- odr_oiddup(stream, oid_ent_to_oid(&prefschema, oid));
- }
- if (!elementSetNames)
- compo.u.complex->generic->elementSpec = 0;
- else
- {
- compo.u.complex->generic->elementSpec = (Z_ElementSpec *)
- odr_malloc(stream, sizeof(Z_ElementSpec));
- compo.u.complex->generic->elementSpec->which =
- Z_ElementSpec_elementSetName;
- compo.u.complex->generic->elementSpec->u.elementSetName =
- elementSetNames->u.generic;
- }
- compo.u.complex->num_dbSpecific = 0;
- compo.u.complex->dbSpecific = 0;
- compo.u.complex->num_recordSyntax = 0;
- compo.u.complex->recordSyntax = 0;
- }
- else if (elementSetNames) {
- compo.which = Z_RecordComp_simple;
- compo.u.simple = elementSetNames;
- }
-
- if (compo.which == -1) {
- api_records_retrieve (zh, stream, setname,
- NULL,
- recordsyntax,
- res->noOfRecords, res->records);
- } else {
- api_records_retrieve (zh, stream, setname,
- &compo,
- recordsyntax,
- res->noOfRecords, res->records);
- }
-
-}
-
-int zebra_cql2pqf (cql_transform_t ct,
- const char *query, char *res, int len) {
-
- int status;
- const char *addinfo = "";
- CQL_parser cp = cql_parser_create();
-
- if (status = cql_parser_string(cp, query)) {
- cql_parser_destroy(cp);
- return (status);
- }
-
- if (cql_transform_buf(ct, cql_parser_result(cp), res, len)) {
- status = cql_transform_error(ct, &addinfo);
- yaz_log (YLOG_WARN,"Transform error %d %s\n", status, addinfo ? addinfo : "");
- cql_parser_destroy(cp);
- return (status);
- }
-
- cql_parser_destroy(cp);
- return (0);
-}
-
-void zebra_scan_PQF (ZebraHandle zh,
- ScanObj *so,
- ODR stream,
- const char *pqf_query)
-{
- Z_AttributesPlusTerm *zapt;
- Odr_oid *attrsetid;
- const char* oidname;
- oid_value attributeset;
- ZebraScanEntry *entries;
- int i, class;
-
- yaz_log(YLOG_DEBUG,
- "scan req: pos:%d, num:%d, partial:%d",
- so->position, so->num_entries, so->is_partial);
-
- zapt = p_query_scan (stream, PROTO_Z3950, &attrsetid, pqf_query);
-
- oidname = yaz_z3950oid_to_str (attrsetid, &class);
- yaz_log (YLOG_DEBUG, "Attributreset: %s", oidname);
- attributeset = oid_getvalbyname(oidname);
-
- if (!zapt) {
- yaz_log (YLOG_WARN, "bad query %s\n", pqf_query);
- odr_reset (stream);
- return;
- }
-
- so->entries = (scanEntry *)
- odr_malloc (stream, sizeof(so->entries) * (so->num_entries));
-
-
- zebra_scan (zh, stream, zapt, attributeset,
- &so->position, &so->num_entries,
- (ZebraScanEntry **) &so->entries, &so->is_partial);
-
- yaz_log(YLOG_DEBUG,
- "scan res: pos:%d, num:%d, partial:%d",
- so->position, so->num_entries, so->is_partial);
-}
-
-scanEntry *getScanEntry(ScanObj *so, int pos) {
- return (&so->entries[pos-1]);
-}
-
-#if 1
-void Filter_store_buff (struct perl_context *context, char *buff, size_t len)
-{
- dSP;
-
- ENTER;
- SAVETMPS;
-
- PUSHMARK(SP) ;
- XPUSHs(context->filterRef);
- XPUSHs(sv_2mortal(newSVpv(buff, len)));
- PUTBACK ;
- call_method("_store_buff", 0);
- SPAGAIN ;
- PUTBACK ;
-
- FREETMPS;
- LEAVE;
-}
-
-/* The "file" manipulation function wrappers */
-int grs_perl_readf(struct perl_context *context, size_t len)
-{
- int r;
- char *buf = (char *) xmalloc (len+1);
- r = (*context->readf)(context->fh, buf, len);
- if (r > 0) Filter_store_buff (context, buf, r);
- xfree (buf);
- return (r);
-}
-
-int grs_perl_readline(struct perl_context *context)
-{
- int r;
- char *buf = (char *) xmalloc (4096);
- char *p = buf;
-
- while ((r = (*context->readf)(context->fh,p,1)) && (p-buf < 4095)) {
- p++;
- if (*(p-1) == 10) break;
- }
-
- *p = 0;
-
- if (p != buf) Filter_store_buff (context, buf, p - buf);
- xfree (buf);
- return (p - buf);
-}
-
-char grs_perl_getc(struct perl_context *context)
-{
- int r;
- char *p;
- if ((r = (*context->readf)(context->fh,p,1))) {
- return (*p);
- } else {
- return (0);
- }
-}
-
-off_t grs_perl_seekf(struct perl_context *context, off_t offset)
-{
- return ((*context->seekf)(context->fh, offset));
-}
-
-off_t grs_perl_tellf(struct perl_context *context)
-{
- return ((*context->tellf)(context->fh));
-}
-
-void grs_perl_endf(struct perl_context *context, off_t offset)
-{
- (*context->endf)(context->fh, offset);
-}
-
-/* Get pointers from the context. Easyer to wrap this by SWIG */
-data1_handle *grs_perl_get_dh(struct perl_context *context)
-{
- return(&context->dh);
-}
-
-NMEM *grs_perl_get_mem(struct perl_context *context)
-{
- return(&context->mem);
-}
-
-/* Set the result in the context */
-void grs_perl_set_res(struct perl_context *context, data1_node *n)
-{
- context->res = n;
-}
-#endif
+++ /dev/null
-#ifndef ZEBRA_PERL_H
-#define ZEBRA_PERL_H
-
-#include <idzebra/api.h>
-
-typedef struct {
- char *groupName;
- char *databaseName;
- char *path;
- char *recordId;
- char *recordType;
- int flagStoreData;
- int flagStoreKeys;
- int flagRw;
- int fileVerboseLimit;
- int databaseNamePath;
- int explainDatabase;
- int followLinks;
-} recordGroup;
-
-typedef struct {
- int noOfRecords;
- ZebraRetrievalRecord *records;
-} RetrievalObj;
-
-typedef struct {
- char *buf; /* record buffer (void pointer really) */
- int len; /* length */
-} RetrievalRecordBuf;
-
-
-typedef struct {
- int errCode; /* non-zero if error when fetching this */
- char *errString; /* error string */
- int position; /* position of record in result set (1,2,..) */
- char *base;
- SYSNO sysno;
- int score;
- char *format; /* record syntax */
- RetrievalRecordBuf *buf;
-} RetrievalRecord;
-
-/* Scan Term Descriptor */
-typedef struct {
- int occurrences; /* scan term occurrences */
- char *term; /* scan term string */
-} scanEntry;
-
-typedef struct {
- int num_entries;
- int position;
- int is_partial;
- scanEntry *entries;
-} ScanObj;
-
-#endif
-
-
projects / idzebra-moved-to-github.git / commitdiff