/* ARISA - Perl Engine - Thread Entry Point * Copyright (C) 2004 Carl Ritson * * This program 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 of the License, or * (at your option) any later version. * * This program 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 this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA */ #include #include #include "arisa.h" #include "script-eng.h" #include "engine.h" #include "linkage.h" interpreter_t *perl_engine_interpreter = NULL; static plocal_t *setup_local(plocal_t *l, interpreter_t *intp) { int fds[2]; l->interpreter = intp; LOCK(intp); l->msgqueue = &(intp->msgqueue); UNLOCK(intp); l->log_msgs = pqueue_init(NULL,1); if(pipe(fds) != 0) { LOGTP(L_ERR,"Failed to allocate signaling pipe"); l->signal_fd = -1; } else { fcntl(fds[0],F_SETFL,O_NONBLOCK); fcntl(fds[1],F_SETFL,O_NONBLOCK); l->signal_fd = fds[0]; pqueue_set_notification_fd(l->msgqueue,fds[1]); pqueue_set_notification_fd(l->log_msgs,fds[1]); } l->my_perl = NULL; return l; } void *perl_thread(void *ptr) { interpreter_t *intp = (interpreter_t *)ptr; struct timeval tv, last_tick, now; unsigned long tmp; se_msg_t *msg; fd_set rd_set; plocal_t local,*l; char buffer[16], *p; int ret; thread_signal_started(&(intp->thread)); LOG_TITLE("Perl Engine"); l = setup_local(&local,intp); init_perl(l); log_subscribe(l->log_msgs); gettimeofday(&now,NULL); memcpy(&last_tick,&now,sizeof(struct timeval)); LOGTP(L_INF,"Started"); while(!thread_should_end()) { tmp = (1000000 - diff_tv_usec(&now,&last_tick)); if(tmp < 5000) tmp = 5000; else if(tmp > 1000000) tmp = 1000000; if(l->signal_fd != -1) { FD_ZERO(&rd_set); FD_SET(l->signal_fd,&rd_set); tv.tv_sec = tmp / 1000000; tv.tv_usec = tmp - (tv.tv_sec * 1000000); ret = select((l->signal_fd+1),&rd_set,NULL,NULL,&tv); } else usleep(tmp); if(l->signal_fd != -1) { if(FD_ISSET(l->signal_fd,&rd_set)) { do { ret = read(l->signal_fd,buffer,1); } while(ret != -1); } } while((msg = pqueue_pop_front(l->msgqueue)) != NULL) { se_msg_type_t type = msg->type; perl_handle_msg(l,msg); free_msg(msg); if(type == SE_SHUTDOWN) goto out; } while((p = pqueue_pop_front(l->log_msgs)) != NULL) { perl_handle_log_msg(l,p); xfree(p); } gettimeofday(&now,NULL); if(diff_tv_usec(&now,&last_tick) >= 950000) { memcpy(&last_tick,&now,sizeof(struct timeval)); perl_tick(l,&now); } } out: log_unsubscribe(l->log_msgs); pqueue_set_notification_fd(l->log_msgs,-1); pqueue_free(l->log_msgs,xfree); l->log_msgs = NULL; if(l->signal_fd != -1) close(l->signal_fd); deinit_perl(l); LOGTP(L_INF,"Shutdown"); thread_signal_finished(); return NULL; } void perl_register(void) { interpreter_t *intp = alloc_interpreter(); intp->name = xstrdup(PERL_ENGINE_NAME); intp->func = perl_thread; intp->flags = SE_F_LOAD_SAVE; PTRARR_ADD(&(intp->types),&(intp->no_types),xstrdup("*.pl")); if(se_register_interpreter(intp) == -1) free_interpreter(intp); else perl_engine_interpreter = intp; }