view release on metacpan or  search on metacpan

BDBaccess/CTest.xs  view on Meta::CPAN

MODULE = Mail::SpamCannibal::BDBaccess::CTest	PACKAGE = Mail::SpamCannibal::BDBaccess::CTest

PROTOTYPES: DISABLE

 # first item in list is the program name

int
t_main(...)
    PREINIT:
	STRLEN  len;
	unsigned char * ptr[20];
	int i;
	extern int opterr;
    CODE:
	if (items > 20) {
	    i = 0;  
	} else {
	    for (i=0; i < items; i++)
	    {
		ptr[i] = (unsigned char *)(SvPV(ST(i), len));
	    }
	opterr = 0;
	realMain(items, (char **)ptr);
	}
	RETVAL = i;
    OUTPUT:
	RETVAL

void
t_setport(pnum)
	int pnum
    CODE:
	port = pnum;

void
t_setsig()
    CODE:
	logopen = 0;	/* skip branch in Code	*/
	oflag = 1;	/* print to stdout	*/
	set_signals();

int
t_pidrun()
    CODE:
	RETVAL = (int)pidrun;
    OUTPUT:
	RETVAL

void
t_savpid(path)
	char * path
    CODE:
	savpid(path);

void
t_chk4pid(path)
	char * path
    PREINIT:
	SV * out;
    PPCODE:
	path = chk4pid(path);
	if (path == NULL) {
	  ST(0) = &PL_sv_undef;
	}
	else {
	  out = sv_newmortal();
	  out = newSVpv(path,0);
	  ST(0) = out;
	  XSRETURN(1);
	}

void
t_pidpath()
    PREINIT:
	SV * out;
    PPCODE:
	out = sv_newmortal();
	out = newSVpv(pidpath(),0);
	ST(0) = out;
	XSRETURN(1);

int
t_init(home,...)
	unsigned char * home
    PREINIT:
	STRLEN len;
	int i;
    CODE:
	for(i=1; i<items; i++) {
	  dbtp.dbfile[i-1] = SvPV(ST(i),len);
	}
	RETVAL = dbtp_init(&dbtp,home, -1);
    OUTPUT:
	RETVAL

int
t_dump(which,name)
	int which
	char * name
    CODE:
	RETVAL = mydb_dump(which,name);
    OUTPUT:
	RETVAL

void
t_close()
    CODE:
	dbtp_close(&dbtp);

void
t_get(which, name, addr);
	int which;
	char * name
	unsigned char * addr
    PREINIT:
	SV * out;
	void * data;
    PPCODE:
	if (dbtp_readDB(&dbtp,0, name, addr, 1))
	  XSRETURN_UNDEF;

	if (which)
	  data = myct_getsec();
	else
	  data = myct_getpri();

	if (data == NULL) {
	  ST(0) = &PL_sv_undef;
	}
	else {
	  out = sv_newmortal();
	  if(which) {
	    out = newSVpv((char *)data,0);
	  } 
	  else {
	    out = newSViv(*(I32 *)data);
	  }
	  ST(0) = out;
	}
	XSRETURN(1);

void
t_getrecno(which, name, cursor)
	int which
	char * name
	U32 cursor
    PREINIT:
	SV * netaddr, * tmp;		/* older perl does not know about newSVuv */
    PPCODE:
	cursor = htonl(cursor);
	if (dbtp_readDB(&dbtp,1,name,&cursor,1)) {
	    if(GIMME == G_ARRAY)
		XSRETURN_EMPTY;
	    else
		XSRETURN_UNDEF;
	}
	netaddr = sv_newmortal();
	sv_setpvn(netaddr, (char *)dbtp.keydbt.data, (size_t)dbtp.keydbt.size);
	XPUSHs(netaddr);
	if(GIMME == G_ARRAY) {
	    if (which)
		XPUSHs(sv_2mortal(newSVpv((char *)dbtp.mgdbt.data,(size_t)dbtp.mgdbt.size)));
	    else {
		cursor = ntohl(my_u32(dbtp.mgdbt.data));	/* temp variable	*/
		tmp = newSViv(cursor);
		sv_setuv(tmp,cursor);
		XPUSHs(sv_2mortal(tmp));
	    }
	    XSRETURN(2);
	}
	XSRETURN(1);

void
t_bdberror(status)
	int status
    PPCODE:
	XPUSHs(sv_2mortal(newSVpv(db_strerror(status),0)));
	XSRETURN(1);

void
t_bdbversion()
    PREINIT:
	char version[256];
	int major, minor, patch;
    PPCODE:
	(void)db_version(&major,&minor,&patch);
	(void)sprintf(version,"%d.%d.%d",major,minor,patch);
	XPUSHs(sv_2mortal(newSVpv(version,0)));
	XSRETURN(1);

U32
t_bdbcount(name)
	char * name
    CODE:
	RETVAL = dbtp_statn(&dbtp,name);
    OUTPUT:
	RETVAL

int
t_set_parent(val)
	int val
    CODE:
	RETVAL = parent;
	parent = val;
    OUTPUT:
	RETVAL