-/* $Id: perlread.c,v 1.4 2002-11-18 13:11:30 pop 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
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));
}
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);
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 */
/* 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);
+ 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 */
Filter_process(context);