/**
Executes the Perl "Execute" function in SCALAR context.
TODO: This function seems to be obsolete. Check and clean it out.
The functionName argument is never used.
@param args arguments to pass to the Perl function in form of
a NULL terminated list of C strings
@param functionName (passed in but never used)
@return a C2PERLResult_t result set structure
*/
int ExecuteFunctionScalar(char **args, const char *functionName)
{
dSP ;
int error;
int n;
if (!g_init)
{
printf ("Error: not connected to C2PERL\nPlease, do C2PERLConnect\n");
return 0;
}
n = perl_call_argv("Execute", G_SCALAR , args);
SPAGAIN;
error = ( n ? (POPi) : -1);
return error;
}
int main(int argc, char * argv[])
{
PerlInterpreter *my_perl;
my_perl = perl_alloc();
perl_construct( my_perl );
char pzObjectAndPath[512];
sprintf(pzObjectAndPath,"%s%s",(const char *)"C:\\Users\\Brian\\Desktop\\XMLFoundation\\Examples\\Perl\\","PerlTest.pl");
// sprintf(pzObjectAndPath,"%s%s",(const char *)"/home/ubt/Desktop/XMLFoundation/Examples/Perl/","PerlTest.pl");
char *pzPerlFileArg[] = { "", pzObjectAndPath };
// parse the Perl Script
perl_parse(my_perl, 0, 2, pzPerlFileArg, (char **)NULL);
char *args[] = { NULL };
perl_call_argv("showtime", G_DISCARD | G_NOARGS, args);
perl_destruct(my_perl);
perl_free(my_perl);
return 0;
}
static void perlfilter()
{
char *embedding[] = { "", WRAPPERPL };
char *args[] = { "", "0", NULL, NULL, NULL};
int exitstatus = 0;
int sock;
PerlInterpreter *my_perl;
if((my_perl = perl_alloc()) == NULL)
{
fprintf(stderr, "no memory!");
exit(1);
}
perl_construct(my_perl);
exitstatus = perl_parse(my_perl, xs_init, 2, embedding, NULL);
if (exitstatus || (exitstatus=perl_run(my_perl)) != 0)
{
fprintf(stderr, "Cannot parse " WRAPPERPL "\n");
exit(exitstatus);
}
while ((sock=lf_accept(listen_sock)) >= 0)
{
char sockbuf[100];
args[0]=filter;
sprintf(sockbuf, "%d", sock);
args[2]=sockbuf;
{
dSP ;
ENTER ;
SAVETMPS ;
perl_call_argv("Embed::Persistent::eval_file",
G_VOID | G_DISCARD | G_EVAL, args);
#ifdef ERRSV
if(SvTRUE(ERRSV))
#else
if(SvTRUE(GvSV(errgv)))
#endif
{
clog_open_syslog("perlfilter");
clog_msg_start_err();
clog_msg_str("eval error: ");
#ifdef ERRSV
clog_msg_str(SvPV(ERRSV,PL_na));
#else
clog_msg_str(SvPV(GvSV(errgv),na));
#endif
clog_msg_send();
}
FREETMPS ;
LEAVE ;
}
close(sock); /* Just in case */
}
#ifdef perl_destruct_level
perl_destruct_level=0;
#else
PL_perl_destruct_level=0;
#endif
perl_destruct(my_perl);
perl_free(my_perl);
exit(0);
}
