view release on metacpan or  search on metacpan

Call/Call.xs  view on Meta::CPAN

    	    PUTBACK ;
    	    FREETMPS ;
    	    LEAVE ;
	}
	else
	    n = FILTER_READ(idx + 1, my_sv, maxlen) ;

 	if (n <= 0)
	{
	    /* Either EOF or an error */

	    if (fdebug) 
	        warn ("filter_read %d returned %d , returning %" IVdf "\n", idx, n,
		      (SvCUR(buf_sv)>0) ? (IV)SvCUR(buf_sv) : (IV)n);

	    /* PERL_MODULE(my_sv) ; */
	    /* PERL_OBJECT(my_sv) ; */
	    filter_del(filter_call); 

	    /* If error, return the code */
	    if (n < 0)
		return n ;

	    /* return what we have so far else signal eof */
	    return (SvCUR(buf_sv)>0) ? (int)SvCUR(buf_sv) : n;
	}

    }
}



MODULE = Filter::Util::Call		PACKAGE = Filter::Util::Call

REQUIRE:	1.924
PROTOTYPES:	ENABLE

#define IDX		current_idx

int
filter_read(size=0)
	int	size 
	CODE:
	{
    	    dMY_CXT;
	    SV * buffer = DEFSV ;

	    RETVAL = FILTER_READ(IDX + 1, buffer, size) ;
	}
	OUTPUT:
	    RETVAL




void
real_import(object, perlmodule, coderef)
    SV *	object
    char *	perlmodule 
    IV		coderef
    PPCODE:
    {
        SV * sv = newSV(1) ;

        (void)SvPOK_only(sv) ;
        filter_add(filter_call, sv) ;

	PERL_MODULE(sv) = savepv(perlmodule) ;
	PERL_OBJECT(sv) = (GV*) newSVsv(object) ;
	FILTER_ACTIVE(sv) = TRUE ;
        BUF_OFFSET(sv) = 0 ;
	CODE_REF(sv)   = coderef ;

        SvCUR_set(sv, 0) ;

    }

void
filter_del()
    CODE:
        dMY_CXT;
	if (PERL_FILTER_EXISTS(IDX) && FILTER_DATA(IDX) && FILTER_ACTIVE(FILTER_DATA(IDX)))
	    FILTER_ACTIVE(FILTER_DATA(IDX)) = FALSE ;



void
unimport(package="$Package", ...)
    const char *package
    PPCODE:
    PERL_UNUSED_VAR(package);
    filter_del(filter_call);


BOOT:
  {
    MY_CXT_INIT;
#ifdef FDEBUG
    fdebug = 1;
#else
    fdebug = 0;
#endif
    /* temporary hack to control debugging in toke.c */
    if (fdebug)
        filter_add(NULL, (fdebug) ? (SV*)"1" : (SV*)"0");  
  }