-/* $Id: perlread.c,v 1.1 2002-11-15 21:26:01 adam Exp $ */
+/* $Id: perlread.c,v 1.8 2003-03-05 16:43:48 adam Exp $
+ Copyright (C) 1995,1996,1997,1998,1999,2000,2001,2002
+ Index Data Aps
+
+This file is part of the Zebra server.
+
+Zebra is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 2, or (at your option) any later
+version.
+
+Zebra is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with Zebra; see the file LICENSE.zebra. If not, write to the
+Free Software Foundation, 59 Temple Place - Suite 330, Boston, MA
+02111-1307, USA.
+*/
#if HAVE_PERL
-#define PERL_IMPLICIT_CONTEXT
#include "perlread.h"
#include "EXTERN.h"
#include "perl.h"
#include "XSUB.h"
#include <stdio.h>
-#include <assert.h>
#include <string.h>
#include <ctype.h>
#define GRS_PERL_MODULE_NAME_MAXLEN 255
-// Context information for the filter
+/* Context information for the filter */
struct perl_context {
PerlInterpreter *perli;
PerlInterpreter *origi;
data1_node *res;
};
-// Constructor call for the filter object
+/* Constructor call for the filter object */
void Filter_create (struct perl_context *context)
{
dSP;
sv_setref_pv(msv, "_p_perl_context", (void*)context);
XPUSHs(msv) ;
PUTBACK ;
- call_method("new", 0);
+ call_method("new", G_EVAL);
SPAGAIN ;
context->filterRef = POPs;
dSP;
+ ENTER;
+ SAVETMPS;
+
PUSHMARK(SP) ;
XPUSHs(context->filterRef);
PUTBACK ;
SPAGAIN ;
res = POPi;
PUTBACK ;
+
+ FREETMPS;
+ LEAVE;
+
return (res);
}
*/
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)));
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) {
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));
}
}
/* Get pointers from the context. Easyer to wrap this by SWIG */
-data1_handle grs_perl_get_dh(struct perl_context *context) {
- return(context->dh);
+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);
+NMEM *grs_perl_get_mem(struct perl_context *context) {
+ return(&context->mem);
}
/* Set the result in the context */
struct perl_context *context =
(struct perl_context *) xmalloc (sizeof(*context));
- // If there is an interpreter (context) running, - we are calling
- // indexing and retrieval from the perl API - we don't create a new one.
+ /* If there is an interpreter (context) running, - we are calling
+ indexing and retrieval from the perl API - we don't create a new one. */
context->origi = PERL_GET_CONTEXT;
if (context->origi == NULL) {
context->perli = perl_alloc();
logf (LOG_LOG, "Destroying perl interpreter context");
if (context->perli_ready) {
+ /*
FREETMPS;
LEAVE;
+ */
if (context->origi == NULL) perl_destruct(context->perli);
}
if (context->origi == NULL) perl_free(context->perli);
struct perl_context *context = (struct perl_context *) p->clientData;
char *filterClass = p->type;
- // The "file" manipulation function wrappers
+ /* The "file" manipulation function wrappers */
context->readf = p->readf;
context->seekf = p->seekf;
context->tellf = p->tellf;
context->endf = p->endf;
- // The "file", data1 and NMEM handles
+ /* The "file", data1 and NMEM handles */
context->fh = p->fh;
context->dh = p->dh;
context->mem = p->mem;
- // If the class was not interpreted before...
- // This is not too efficient, when indexing with many different filters...
+ /* If the class was not interpreted before... */
+ /* This is not too efficient, when indexing with many different filters... */
if (strcmp(context->filterClass,filterClass)) {
char modarg[GRS_PERL_MODULE_NAME_MAXLEN + 2];
char *arglist[6] = { "", "-I", "", "-M", "-e", "" };
if (context->perli_ready) {
+ /*
FREETMPS;
LEAVE;
+ */
if (context->origi == NULL) perl_destruct(context->perli);
}
if (context->origi == NULL) perl_construct(context->perli);
+
+ /*
ENTER;
SAVETMPS;
+ */
context->perli_ready = 1;
- // parse, and run the init call
+ /* parse, and run the init call */
if (context->origi == NULL) {
logf (LOG_LOG, "Interpreting filter class:%s", filterClass);
strcpy(context->filterClass, filterClass);
- // create the filter object as a filterClass blessed reference
+ /* create the filter object as a filterClass blessed reference */
Filter_create(context);
}
- // Wow... if calling with individual update_record calls from perl,
- // the filter object reference may go out of scope...
- if (!SvOK(context->filterRef)) Filter_create(context);
+ /* Wow... if calling with individual update_record calls from perl,
+ the filter object reference may go out of scope... */
+ if (!sv_isa(context->filterRef, context->filterClass)) {
+ Filter_create(context);
+ logf (LOG_DEBUG,"Filter recreated");
+ }
+ if (!SvTRUE(context->filterRef)) {
+ logf (LOG_WARN,"Failed to initialize perl filter %s",context->filterClass);
+ return (0);
+ }
- // call the process method
+ /* call the process method */
Filter_process(context);
- // return the created data1 node
+ /* return the created data1 node */
return (context->res);
}
projects / idzebra-moved-to-github.git / blobdiff