using yaz/log.h again
[idzebra-moved-to-github.git] / perl / zebra_perl.c
index 3143415..aa18fb8 100644 (file)
@@ -1,7 +1,3 @@
-#if 0
-#include "zebraapi.h"
-#endif
-
 #include "EXTERN.h"
 #include "perl.h"
 #include "XSUB.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 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. 
@@ -122,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);
     }
   }
 
@@ -132,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;
     }
   }
@@ -212,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);
   }
@@ -233,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;
   }
@@ -257,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);
 }
@@ -266,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