/* Initialize perl interpreter */ void perl_scripts_init(void) { char *code, *use_code; perl_scripts = NULL; perl_sources_start(); perl_signals_start(); my_perl = perl_alloc(); perl_construct(my_perl); perl_parse(my_perl, xs_init, G_N_ELEMENTS(perl_args), perl_args, NULL); #if PERL_STATIC_LIBS == 1 perl_eval_pv("Irssi::Core::->boot_Irssi_Core(0.9);", TRUE); #endif perl_common_start(); use_code = perl_get_use_list(); code = g_strdup_printf(irssi_core_code, PERL_STATIC_LIBS, use_code); perl_eval_pv(code, TRUE); g_free(code); g_free(use_code); }
main (int argc, char **argv, char **env) { STRLEN n_a; char *embedding[] = { "", "-e", "0" }; my_perl = perl_alloc(); perl_construct( my_perl ); perl_parse(my_perl, NULL, 3, embedding, NULL); perl_run(my_perl); /** Treat $a as an integer **/ perl_eval_pv("$a = 3; $a **= 2", TRUE); printf("a = %d\n", SvIV(perl_get_sv("a", FALSE))); /** Treat $a as a float **/ perl_eval_pv("$a = 3.14; $a **= 2", TRUE); printf("a = %f\n", SvNV(perl_get_sv("a", FALSE))); /** Treat $a as a string **/ perl_eval_pv("$a = 'rekcaH lreP rehtonA tsuJ'; $a = reverse($a);", TRUE); printf("a = %s\n", SvPV(perl_get_sv("a", FALSE), n_a)); perl_destruct(my_perl); perl_free(my_perl); }
static void coroae_loop() { if (uwsgi.async < 2) { if (uwsgi.mywid == 1) { uwsgi_log("the Coro::AnyEvent loop engine requires async mode (--async <n>)\n"); } exit(1); } if (!uperl.loaded) { uwsgi_log("no perl/PSGI code loaded (with --psgi), unable to initialize Coro::AnyEvent\n"); exit(1); } perl_eval_pv("use Coro;", 0); if (SvTRUE(ERRSV)) { uwsgi_log("unable to load Coro module\n"); exit(1); } perl_eval_pv("use AnyEvent;", 0); if (SvTRUE(ERRSV)) { uwsgi_log("unable to load AnyEvent module\n"); exit(1); } perl_eval_pv("use Coro::AnyEvent;", 0); if (SvTRUE(ERRSV)) { uwsgi_log("unable to load Coro::AnyEvent module\n"); exit(1); } uwsgi.current_wsgi_req = coroae_current_wsgi_req; uwsgi.wait_write_hook = coroae_wait_fd_write; uwsgi.wait_read_hook = coroae_wait_fd_read; I_CORO_API("uwsgi::coroae"); // create signal watchers if (uwsgi.signal_socket > -1) { coroae_add_watcher(uwsgi.signal_socket, (SV *) coroae_closure_sighandler(uwsgi.signal_socket)); coroae_add_watcher(uwsgi.my_signal_socket, (SV *) coroae_closure_sighandler(uwsgi.my_signal_socket)); } struct uwsgi_socket *uwsgi_sock = uwsgi.sockets; while(uwsgi_sock) { // check return value here coroae_add_watcher(uwsgi_sock->fd, (SV *) coroae_closure_acceptor(uwsgi_sock)); uwsgi_sock = uwsgi_sock->next; }; SV *condvar = coroae_condvar_new(); coroae_wait_condvar(condvar); if (uwsgi.workers[uwsgi.mywid].manage_next_request == 0) { uwsgi_log("goodbye to the Coro::AnyEvent loop on worker %d (pid: %d)\n", uwsgi.mywid, uwsgi.mypid); exit(UWSGI_RELOAD_CODE); } uwsgi_log("the Coro::AnyEvent loop is no more :(\n"); }
static void coroae_loop() { if (uwsgi.async < 1) { if (uwsgi.mywid == 1) { uwsgi_log("the Coro::AnyEvent loop engine requires async mode (--async <n>)\n"); } exit(1); } if (!uperl.loaded) { uwsgi_log("no perl/PSGI code loaded (with --psgi), unable to initialize Coro::AnyEvent\n"); exit(1); } perl_eval_pv("use Coro;", 1); perl_eval_pv("use AnyEvent;", 1); perl_eval_pv("use Coro::AnyEvent;", 1); uwsgi.current_wsgi_req = coroae_current_wsgi_req; uwsgi.wait_write_hook = coroae_wait_fd_write; uwsgi.wait_read_hook = coroae_wait_fd_read; uwsgi.wait_milliseconds_hook = coroae_wait_milliseconds; I_CORO_API("uwsgi::coroae"); // patch goodbye_cruel_world uwsgi.gbcw_hook = coroae_gbcw; ucoroae.watchers = newAV(); av_push(ucoroae.watchers, coroae_add_signal_watcher("HUP", newXS(NULL, XS_coroae_hup_sighandler, "uwsgi::coroae"))); av_push(ucoroae.watchers, coroae_add_signal_watcher("INT", newXS(NULL, XS_coroae_int_sighandler, "uwsgi::coroae"))); av_push(ucoroae.watchers, coroae_add_signal_watcher("TERM", newXS(NULL, XS_coroae_int_sighandler, "uwsgi::coroae"))); // create signal watchers if (uwsgi.signal_socket > -1) { av_push(ucoroae.watchers, coroae_add_watcher(uwsgi.signal_socket, coroae_closure_sighandler(uwsgi.signal_socket))); av_push(ucoroae.watchers, coroae_add_watcher(uwsgi.my_signal_socket, coroae_closure_sighandler(uwsgi.my_signal_socket))); } struct uwsgi_socket *uwsgi_sock = uwsgi.sockets; while(uwsgi_sock) { // check return value here av_push(ucoroae.watchers, coroae_add_watcher(uwsgi_sock->fd, coroae_closure_acceptor(uwsgi_sock))); uwsgi_sock = uwsgi_sock->next; }; ucoroae.condvar = coroae_condvar_new(); coroae_condvar_call(ucoroae.condvar, "recv"); SvREFCNT_dec(ucoroae.condvar); if (uwsgi.workers[uwsgi.mywid].manage_next_request == 0) { uwsgi_log("goodbye to the Coro::AnyEvent loop on worker %d (pid: %d)\n", uwsgi.mywid, uwsgi.mypid); exit(UWSGI_RELOAD_CODE); } uwsgi_log("the Coro::AnyEvent loop is no more :(\n"); }
void do_something_perlish(char *something) { if (netsnmp_ds_get_boolean(NETSNMP_DS_APPLICATION_ID, NETSNMP_DS_AGENT_DISABLE_PERL)) { return; } maybe_source_perl_startup(); if (netsnmp_ds_get_boolean(NETSNMP_DS_APPLICATION_ID, NETSNMP_DS_AGENT_DISABLE_PERL)) { return; } DEBUGMSGTL(("perl", "calling perl\n")); #if defined(HAVE_EVAL_PV) || defined(eval_pv) /* newer perl */ eval_pv(something, TRUE); #else #if defined(HAVE_PERL_EVAL_PV_LC) || defined(perl_eval_pv) /* older perl? */ perl_eval_pv(something, TRUE); #else /* HAVE_PERL_EVAL_PV_LC */ #ifdef HAVE_PERL_EVAL_PV_UC /* older perl? */ Perl_eval_pv(my_perl, something, TRUE); #else /* !HAVE_PERL_EVAL_PV_UC */ #error embedded perl broken #endif /* !HAVE_PERL_EVAL_PV_LC */ #endif /* !HAVE_PERL_EVAL_PV_UC */ #endif /* !HAVE_EVAL_PV */ DEBUGMSGTL(("perl", "finished calling perl\n")); }
/* Destroy all perl scripts and deinitialize perl interpreter */ void perl_scripts_deinit(void) { if (my_perl == NULL) return; /* unload all scripts */ while (perl_scripts != NULL) perl_script_unload(perl_scripts->data); signal_emit("perl scripts deinit", 0); perl_signals_stop(); perl_sources_stop(); perl_common_stop(); /* Unload all perl libraries loaded with dynaloader */ perl_eval_pv("foreach my $lib (@DynaLoader::dl_modules) { if ($lib =~ /^Irssi\\b/) { $lib .= '::deinit();'; eval $lib; } }", TRUE); /* We could unload all libraries .. but this crashes with some libraries, probably because we don't call some deinit function.. Anyway, this would free some memory with /SCRIPT RESET, but it leaks memory anyway. */ /*perl_eval_pv("eval { foreach my $lib (@DynaLoader::dl_librefs) { DynaLoader::dl_unload_file($lib); } }", TRUE);*/ /* perl interpreter */ perl_destruct(my_perl); perl_free(my_perl); my_perl = NULL; }
static void cmd_perl(const char *data) { dSP; GString *code; char *uses; SV *sv; ENTER; SAVETMPS; PUSHMARK(SP); code = g_string_new(NULL); uses = perl_get_use_list(); g_string_sprintf(code, "sub { use Irssi;%s\n%s }", uses, data); sv = perl_eval_pv(code->str, TRUE); perl_call_sv(sv, G_VOID|G_NOARGS|G_EVAL|G_DISCARD); g_free(uses); g_string_free(code, TRUE); SPAGAIN; if (SvTRUE(ERRSV)) { STRLEN n_a; signal_emit("gui dialog", 2, "error", SvPV(ERRSV, n_a)); } PUTBACK; FREETMPS; LEAVE; }
static void irssi_perl_start(void) { /* stolen from xchat, thanks :) */ char *args[] = {"", "-e", "0"}; char load_file[] = "sub load_file()\n" "{\n" " (my $file_name) = @_;\n" " open FH, $file_name or return \"File not found: $file_name\";\n" " local($/) = undef;\n" " $file = <FH>;\n" " close FH;\n" " eval $file;\n" " eval $file if $@;\n" " return $@ if $@;\n" "}"; first_signals = g_hash_table_new((GHashFunc) g_direct_hash, (GCompareFunc) g_direct_equal); last_signals = g_hash_table_new((GHashFunc) g_direct_hash, (GCompareFunc) g_direct_equal); perl_timeouts = NULL; irssi_perl_interp = perl_alloc(); perl_construct(irssi_perl_interp); perl_parse(irssi_perl_interp, xs_init, 3, args, NULL); perl_eval_pv(load_file, TRUE); }
static int coroae_wait_milliseconds(int timeout) { char buf[256]; double d = ((double)timeout)/1000.0; int ret = snprintf(buf, 256, "Coro::AnyEvent::sleep %f", d); if (ret <= 0 || ret > 256) return -1; perl_eval_pv(buf, 0); return 0; }
char match(char *string, char *pattern) { char *command; command = malloc(sizeof(char) * strlen(string) + strlen(pattern) + 37); sprintf(command, "$string = '%s'; $return = $string =~ %s", string, pattern); perl_eval_pv(command, TRUE); free(command); return SvIV(perl_get_sv("return", FALSE)); }
/* Destroy all perl scripts and deinitialize perl interpreter */ void perl_scripts_deinit(void) { if (my_perl == NULL) return; /* unload all scripts */ while (perl_scripts != NULL) perl_script_unload(perl_scripts->data); signal_emit("perl scripts deinit", 0); perl_signals_stop(); perl_sources_stop(); perl_common_stop(); /* Unload all perl libraries loaded with dynaloader */ perl_eval_pv("foreach my $lib (@DynaLoader::dl_modules) { if ($lib =~ /^Irssi\\b/) { $lib .= '::deinit();'; eval $lib; } }", TRUE); #if PERL_STATIC_LIBS == 1 /* If perl is statically built we should manually deinit the modules which are booted in boot_Irssi_Core above */ perl_eval_pv("foreach my $lib (qw(" "Irssi" " " "Irssi::Irc" " " "Irssi::UI" " " "Irssi::TextUI" ")) { eval $lib . '::deinit();'; }", TRUE); #endif /* We could unload all libraries .. but this crashes with some libraries, probably because we don't call some deinit function.. Anyway, this would free some memory with /SCRIPT RESET, but it leaks memory anyway. */ /*perl_eval_pv("eval { foreach my $lib (@DynaLoader::dl_librefs) { DynaLoader::dl_unload_file($lib); } }", TRUE);*/ /* perl interpreter */ PL_perl_destruct_level = 1; perl_destruct(my_perl); perl_free(my_perl); my_perl = NULL; }
int substitute(char *string[], char *pattern) { char *command; STRLEN length; command = malloc(sizeof(char) * strlen(*string) + strlen(pattern) + 35); sprintf(command, "$string = '%s'; $ret = ($string =~ %s)", *string, pattern); perl_eval_pv(command, TRUE); free(command); *string = SvPV(perl_get_sv("string", FALSE), length); return SvIV(perl_get_sv("ret", FALSE)); }
char* perleval (char* input) { char *retval=NULL; if (input && *input) { SV *sv; perlstartstop(1); ++perlcalldepth; ENTER; SAVETMPS; sv=perl_eval_pv((char*)input, FALSE); SV2STR(sv,retval); FREETMPS; LEAVE; --perlcalldepth; }; RETURN_MSTR(retval); }
static void irssi_perl_start(void) { char *args[] = {"", "-e", "0"}; char eval_file_code[] = "package Irssi::Load;\n" "\n" "use Symbol qw(delete_package);\n" "\n" "sub eval_file {\n" " my ($filename, $id) = @_;\n" " my $package = \"Irssi::Script::$id\";\n" " delete_package($package);\n" "\n" " local *FH;\n" " open FH, $filename or die \"File not found: $filename\";\n" " local($/) = undef;\n" " my $sub = <FH>;\n" " close FH;\n" "\n" " my $eval = qq{package $package; %s sub handler { $sub; }};\n" " {\n" " # hide our variables within this block\n" " my ($filename, $package, $sub);\n" " eval $eval;\n" " }\n" " die $@ if $@;\n" "\n" " eval {$package->handler;};\n" " die $@ if $@;\n" "}\n"; char *code, *use_code; perl_signals_start(); perl_sources = NULL; my_perl = perl_alloc(); perl_construct(my_perl); perl_parse(my_perl, xs_init, 3, args, NULL); use_code = *PERL_LIB_DIR == '\0' ? "" : "use lib \""PERL_LIB_DIR"\";"; code = g_strdup_printf(eval_file_code, use_code); perl_eval_pv(code, TRUE); g_free(code); perl_common_init(); }
static int hbm_perl_exec (HBArgs *d, char *code) { dSP; SV *args; SV *retval; args = perl_get_sv("args", TRUE); if (!args) printf("PANIC: No args\n"); sv_setref_pv(args, "hbargsPtr", (void*) d); retval = perl_eval_pv(code, TRUE); return SvIV(retval); }
int matches(char *string, char *pattern, char **match_list[]) { char *command; SV *current_match; AV *array; I32 num_matches; STRLEN length; int i; command = malloc(sizeof(char) * strlen(string) + strlen(pattern) + 38); sprintf(command, "$string = '%s'; @array = ($string =~ %s)", string, pattern); perl_eval_pv(command, TRUE); free(command); array = perl_get_av("array", FALSE); num_matches = av_len(array) + 1; /** assume $[ is 0 **/ *match_list = (char **) malloc(sizeof(char *) * num_matches); for (i = 0; i <= num_matches; i++) { current_match = av_shift(array); (*match_list)[i] = SvPV(current_match, length); } return num_matches; }
static void perl_end(void) { if (my_perl == NULL) return; PL_perl_destruct_level = 1; PERL_SET_CONTEXT(my_perl); perl_eval_pv( "foreach my $lib (@DynaLoader::dl_modules) {" "if ($lib =~ /^Purple\\b/) {" "$lib .= '::deinit();';" "eval $lib;" "}" "}", TRUE); PL_perl_destruct_level = 1; PERL_SET_CONTEXT(my_perl); perl_destruct(my_perl); perl_free(my_perl); my_perl = NULL; }
static int perl_code ( HBArgs *d ) { char *em[] = { "", "-e", "0" }; char *code; int code_f; int retval; if (!d->sym->arg(d, NULL, &code, NULL, &code_f)) return 0; if (!code) return 1; pthread_mutex_lock(&perl_mutex); perl_int = perl_alloc(); perl_construct(perl_int); perl_parse(perl_int, xs_init, 3, em, NULL); perl_run(perl_int); perl_eval_pv("use HB;", TRUE); retval = hbm_perl_exec(d, code); perl_destruct(perl_int); perl_free(perl_int); pthread_mutex_unlock(&perl_mutex); if (code_f) free(code); return retval; }
int init_psgi_app(struct wsgi_request *wsgi_req, char *app, uint16_t app_len, PerlInterpreter **interpreters) { struct stat st; int i; SV **callables; time_t now = uwsgi_now(); char *app_name = uwsgi_concat2n(app, app_len, "", 0); // prepare for $0 uperl.embedding[1] = app_name; int fd = open(app_name, O_RDONLY); if (fd < 0) { uwsgi_error_open(app_name); goto clear2; } if (fstat(fd, &st)) { uwsgi_error("fstat()"); close(fd); goto clear2; } char *buf = uwsgi_calloc(st.st_size+1); if (read(fd, buf, st.st_size) != st.st_size) { uwsgi_error("read()"); close(fd); free(buf); goto clear2; } close(fd); // the first (default) app, should always be loaded in the main interpreter if (interpreters == NULL) { if (uwsgi_apps_cnt) { interpreters = uwsgi_calloc(sizeof(PerlInterpreter *) * uwsgi.threads); interpreters[0] = uwsgi_perl_new_interpreter(); if (!interpreters[0]) { uwsgi_log("unable to create new perl interpreter\n"); free(interpreters); goto clear2; } } else { interpreters = uperl.main; } } if (!interpreters) { goto clear2; } callables = uwsgi_calloc(sizeof(SV *) * uwsgi.threads); uperl.tmp_streaming_stash = uwsgi_calloc(sizeof(HV *) * uwsgi.threads); uperl.tmp_input_stash = uwsgi_calloc(sizeof(HV *) * uwsgi.threads); uperl.tmp_error_stash = uwsgi_calloc(sizeof(HV *) * uwsgi.threads); uperl.tmp_stream_responder = uwsgi_calloc(sizeof(CV *) * uwsgi.threads); uperl.tmp_psgix_logger = uwsgi_calloc(sizeof(CV *) * uwsgi.threads); for(i=0;i<uwsgi.threads;i++) { if (i > 0 && interpreters != uperl.main) { interpreters[i] = uwsgi_perl_new_interpreter(); if (!interpreters[i]) { uwsgi_log("unable to create new perl interpreter\n"); // what to do here ? i hope no-one will use threads with dynamic apps...but clear the whole stuff... free(callables); uwsgi_perl_free_stashes(); while(i>=0) { perl_destruct(interpreters[i]); perl_free(interpreters[i]); goto clear2; } } } PERL_SET_CONTEXT(interpreters[i]); uperl.tmp_current_i = i; if (uperl.locallib) { uwsgi_log("using %s as local::lib directory\n", uperl.locallib); uperl.embedding[1] = uwsgi_concat2("-Mlocal::lib=", uperl.locallib); uperl.embedding[2] = app_name; if (perl_parse(interpreters[i], xs_init, 3, uperl.embedding, NULL)) { // what to do here ? i hope no-one will use threads with dynamic apps... but clear the whole stuff... free(uperl.embedding[1]); uperl.embedding[1] = app_name; free(callables); uwsgi_perl_free_stashes(); goto clear; } free(uperl.embedding[1]); uperl.embedding[1] = app_name; } else { if (perl_parse(interpreters[i], xs_init, 2, uperl.embedding, NULL)) { // what to do here ? i hope no-one will use threads with dynamic apps... but clear the whole stuff... free(callables); uwsgi_perl_free_stashes(); goto clear; } } perl_eval_pv("use IO::Handle;", 0); perl_eval_pv("use IO::File;", 0); perl_eval_pv("use Scalar::Util;", 0); if (!uperl.no_die_catch) { perl_eval_pv("use Devel::StackTrace;", 0); if (!SvTRUE(ERRSV)) { uperl.stacktrace_available = 1; perl_eval_pv("$SIG{__DIE__} = \\&uwsgi::stacktrace;", 0); } } SV *dollar_zero = get_sv("0", GV_ADD); sv_setsv(dollar_zero, newSVpv(app, app_len)); callables[i] = perl_eval_pv(uwsgi_concat4("#line 1 ", app_name, "\n", buf), 0); if (!callables[i]) { uwsgi_log("unable to find PSGI function entry point.\n"); // what to do here ? i hope no-one will use threads with dynamic apps... free(callables); uwsgi_perl_free_stashes(); goto clear; } PERL_SET_CONTEXT(interpreters[0]); } free(buf); if(SvTRUE(ERRSV)) { uwsgi_log("%s\n", SvPV_nolen(ERRSV)); free(callables); uwsgi_perl_free_stashes(); goto clear; } if (uwsgi_apps_cnt >= uwsgi.max_apps) { uwsgi_log("ERROR: you cannot load more than %d apps in a worker\n", uwsgi.max_apps); goto clear; } int id = uwsgi_apps_cnt; struct uwsgi_app *wi = NULL; if (wsgi_req) { // we need a copy of app_id wi = uwsgi_add_app(id, psgi_plugin.modifier1, uwsgi_concat2n(wsgi_req->appid, wsgi_req->appid_len, "", 0), wsgi_req->appid_len, interpreters, callables); } else { wi = uwsgi_add_app(id, psgi_plugin.modifier1, "", 0, interpreters, callables); } wi->started_at = now; wi->startup_time = uwsgi_now() - now; uwsgi_log("PSGI app %d (%s) loaded in %d seconds at %p (interpreter %p)\n", id, app_name, (int) wi->startup_time, callables[0], interpreters[0]); free(app_name); // copy global data to app-specific areas wi->stream = uperl.tmp_streaming_stash; wi->input = uperl.tmp_input_stash; wi->error = uperl.tmp_error_stash; wi->responder0 = uperl.tmp_stream_responder; wi->responder1 = uperl.tmp_psgix_logger; uwsgi_emulate_cow_for_apps(id); // restore context if required if (interpreters != uperl.main) { PERL_SET_CONTEXT(uperl.main[0]); } return id; clear: if (interpreters != uperl.main) { for(i=0;i<uwsgi.threads;i++) { perl_destruct(interpreters[i]); perl_free(interpreters[i]); } free(interpreters); } PERL_SET_CONTEXT(uperl.main[0]); clear2: free(app_name); return -1; }
static void perl_init(void) { /* changed the name of the variable from load_file to perl_definitions * since now it does much more than defining the load_file sub. * Moreover, deplaced the initialisation to the xs_init function. * (TheHobbit) */ char *perl_args[] = { "", "-e", "0", "-w" }; char perl_definitions[] = { /* We use to function one to load a file the other to execute * the string obtained from the first and holding the file * contents. This allows to have a really local $/ without * introducing temp variables to hold the old value. Just a * question of style:) */ "package Purple::PerlLoader;" "use Symbol;" "sub load_file {" "my $f_name=shift;" "local $/=undef;" "open FH,$f_name or return \"__FAILED__\";" "$_=<FH>;" "close FH;" "return $_;" "}" "sub destroy_package {" "eval { $_[0]->UNLOAD() if $_[0]->can('UNLOAD'); };" "Symbol::delete_package($_[0]);" "}" "sub load_n_eval {" "my ($f_name, $package) = @_;" "destroy_package($package);" "my $strin=load_file($f_name);" "return 2 if($strin eq \"__FAILED__\");" "my $eval = qq{package $package; $strin;};" "{" " eval $eval;" "}" "if($@) {" /*" #something went wrong\n"*/ "die(\"Errors loading file $f_name: $@\");" "}" "return 0;" "}" }; my_perl = perl_alloc(); PERL_SET_CONTEXT(my_perl); PL_perl_destruct_level = 1; perl_construct(my_perl); #ifdef DEBUG perl_parse(my_perl, xs_init, 4, perl_args, NULL); #else perl_parse(my_perl, xs_init, 3, perl_args, NULL); #endif #ifdef HAVE_PERL_EVAL_PV eval_pv(perl_definitions, TRUE); #else perl_eval_pv(perl_definitions, TRUE); /* deprecated */ #endif perl_run(my_perl); }
zAPI::IModule::ChainStatus ModPerl::onPreSend(zAPI::IHttpRequest* request, zAPI::IHttpResponse* response) { if (request->getParam("modPerl_status") != NULL) { int* fds_input = new int[2]; int* fds_output = new int[2]; request->setParam("modPerl_fds_input", fds_input); request->setParam("modPerl_fds_output", fds_output); if (pipe(fds_input) < 0) return zAPI::IModule::ERRORMODULE; if (pipe(fds_output) < 0) return zAPI::IModule::ERRORMODULE; pid_t pid = fork(); if (pid == -1) { perror("fork"); return zAPI::IModule::ERRORMODULE; } else if (pid == 0) { dup2(fds_input[0], 0); dup2(fds_output[1], 1); close(fds_input[1]); close(fds_output[0]); char *perlOpts[] = {"", "-e", "0"}; struct stat sb; int fd; void* addr; PerlInterpreter* _perl; _perl = perl_alloc(); perl_construct(_perl); perl_parse(_perl, NULL, 3, perlOpts, NULL); perl_run(_perl); fd = open((*(request->getConfig()->getParam("DocumentRoot")) + request->getUri()).c_str() ,O_RDONLY); if (fd == -1) exit(1); if (fstat(fd, &sb) == -1) { close(fd); exit(1); } addr = mmap(NULL, sb.st_size, PROT_READ, MAP_PRIVATE, fd, 0); if (addr == MAP_FAILED) { close(fd); exit(1); } perl_eval_pv((char*)addr,TRUE); munmap(addr, sb.st_size); close(fd); perl_destruct(_perl); perl_free(_perl); exit(0); } else { request->setParam("modPerl_pid_t", reinterpret_cast<void*>(pid)); close(fds_output[1]); close(fds_input[0]); zAPI::IResponseStream* post = request->getBodyStream(); if (post) { char buff[1024]; size_t ret; while (post->completed() == false) { ret = post->read(buff, 1024); write(fds_input[1], buff, ret); } } close(fds_input[1]); } } return zAPI::IModule::CONTINUE; }