X-Git-Url: http://git.indexdata.com/?a=blobdiff_plain;f=perl%2Fzebra_perl.c;h=147d2acc2a9bd62056a26c73b1c9f3ecfa1c101a;hb=5437b50633032595afe6f87dc0f989bc92a5aea8;hp=b097531972f01352e24272deae82994557d56f29;hpb=cb85184168c20cf285b314ac747f92bd37012c8c;p=idzebra-moved-to-github.git

diff --git a/perl/zebra_perl.c b/perl/zebra_perl.c
index b097531..147d2ac 100644
--- a/perl/zebra_perl.c
+++ b/perl/zebra_perl.c
@@ -1,44 +1,33 @@
-#if 0
-#include "zebraapi.h"
-#endif
-
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.h"
 
 #include <yaz/yaz-util.h>
 #include <yaz/proto.h>
-#include <yaz/log.h>
+#include <yaz/ylog.h>
 #include <yaz/cql.h>
 #include <yaz/pquery.h>
 
 #include "zebra_perl.h"
-#include <data1.h>
+#include "../recctrl/perlread.h"
+#include <idzebra/data1.h>
 
 NMEM handles;
 
 void init (void) {
   nmem_init ();
   yaz_log_init_prefix ("ZebraPerl");
-  yaz_log (LOG_LOG, "Zebra API initialized");
+  yaz_log (YLOG_LOG, "Zebra API initialized");
 }
 
 void DESTROY (void) {
   nmem_exit ();
-  yaz_log (LOG_LOG, "Zebra API destroyed");
+  yaz_log (YLOG_LOG, "Zebra API destroyed");
 }   
 
 /* 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);
+  yaz_log(level, "%s", message);
 }
 
 /* debug tool for data1... maybe should be moved to data1. 
@@ -72,7 +61,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;
@@ -130,7 +119,7 @@ void records_retrieve(ZebraHandle zh,
   } else {
     schema = oid_getvalbyname (a_schema);
     if (schema == VAL_NONE) {
-      logf(LOG_WARN,"unknown schema '%s'",a_schema);
+      yaz_log(YLOG_WARN,"unknown schema '%s'",a_schema);
     }
   }
 
@@ -140,7 +129,7 @@ void records_retrieve(ZebraHandle zh,
   } else {
     recordsyntax = oid_getvalbyname (a_format);
     if (recordsyntax == VAL_NONE) {
-      logf(LOG_WARN,"unknown record syntax '%s', using SUTRS",a_schema);
+      yaz_log(YLOG_WARN,"unknown record syntax '%s', using SUTRS",a_schema);
       recordsyntax = VAL_SUTRS;
     }
   }
@@ -220,7 +209,7 @@ int zebra_cql2pqf (cql_transform_t ct,
 
   if (cql_transform_buf(ct, cql_parser_result(cp), res, len)) {
     status = cql_transform_error(ct, &addinfo);
-    logf (LOG_WARN,"Transform error %d %s\n", status, addinfo ? addinfo : "");
+    yaz_log (YLOG_WARN,"Transform error %d %s\n", status, addinfo ? addinfo : "");
     cql_parser_destroy(cp);
     return (status);
   }
@@ -241,18 +230,18 @@ void zebra_scan_PQF (ZebraHandle zh,
   ZebraScanEntry *entries;
   int i, class;
 
-  logf(LOG_DEBUG,  
+  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); 
-  logf (LOG_DEBUG, "Attributreset: %s", oidname);
+  yaz_log (YLOG_DEBUG, "Attributreset: %s", oidname);
   attributeset = oid_getvalbyname(oidname);
 
   if (!zapt) {
-    logf (LOG_WARN, "bad query %s\n", pqf_query);
+    yaz_log (YLOG_WARN, "bad query %s\n", pqf_query);
     odr_reset (stream);
     return;
   }
@@ -265,7 +254,7 @@ void zebra_scan_PQF (ZebraHandle zh,
 	      &so->position, &so->num_entries, 
 	      (ZebraScanEntry **) &so->entries, &so->is_partial);
 
-  logf(LOG_DEBUG, 
+  yaz_log(YLOG_DEBUG, 
        "scan res: pos:%d, num:%d, partial:%d", 
        so->position, so->num_entries, so->is_partial);
 }
@@ -274,3 +263,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