Implemented loadable filters.

[idzebra-moved-to-github.git] / perl / zebra_perl.c

diff --git a/perl/zebra_perl.c b/perl/zebra_perl.c
index 7bc2646..793c410 100644 (file)
--- a/perl/zebra_perl.c
+++ b/perl/zebra_perl.c
@@ -1,4 +1,7 @@
-//#include "zebraapi.h"
+#if 0
+#include "zebraapi.h"
+#endif
+
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
@@ -10,6 +13,7 @@
 #include <yaz/pquery.h>
 
 #include "zebra_perl.h"
+#include "../recctrl/perlread.h"
 #include <data1.h>
 
 NMEM handles;
@@ -26,14 +30,6 @@ void DESTROY (void) {
 }   
 
 /* Logging facilities from yaz */
-void logLevel (int level) {
-  yaz_log_init_level(level);
-}
- 
-void logFile (const char *fname) {
-  yaz_log_init_file(fname);
-}
-
 void logMsg (int level, const char *message) {
   logf(level, "%s", message);
 }
@@ -69,7 +65,7 @@ void record_retrieve(RetrievalObj *ro,
     res->errString = "";
   }
   res->position   = ro->records[i].position;
-  res->base       = ro->records[i].base;
+  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;
@@ -271,3 +267,95 @@ 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