pike.git
/
src
/
modules
/
Perl
/
perlmod.c
version
»
Context lines:
10
20
40
80
file
none
3
pike.git/src/modules/Perl/perlmod.c:1:
#include <global.h> #include <svalue.h> #include <array.h> #include <stralloc.h> #include <interpret.h> #include <module_support.h> #include <threads.h> #include <mapping.h>
+
#include <perl_machine.h>
-
+
#ifdef HAVE_PERL
+
#include <EXTERN.h> #include <perl.h> static int num_perl_interpreters=0; DEFINE_MUTEX(perl_running); #ifdef MULTIPLICITY #endif struct perlmod_storage { char **argv; char **env; char *env_block; struct array *argv_strings;
-
+
int parsed;
PerlInterpreter *my_perl; }; #define THIS ((struct perlmod_storage *)(fp->current_storage)) #define PERL THIS->my_perl static void init_perl_glue(struct object *o) { PerlInterpreter *p; THIS->argv=0; THIS->env=0; THIS->env_block=0; THIS->argv_strings=0;
-
+
THIS->parsed=0;
#ifndef MULTIPLICITY if(num_perl_interpreters>0) { PERL=0; fprintf(stderr,"num_perl_interpreters=%d\n",num_perl_interpreters); /* error("Perl: There can be only one!\n"); */ return; } #endif THREADS_ALLOW(); mt_lock(&perl_running); p=perl_alloc();
-
if(p) perl_construct(p);
+
mt_unlock(&perl_running); THREADS_DISALLOW(); PERL=p; if(p) num_perl_interpreters++; } static void exit_perl_glue(struct object *o) { if(PERL) {
-
PerlInterpreter
*
p
=
PERL
;
+
struct
perlmod_storage
*
storage
=
THIS
;
+
THREADS_ALLOW(); mt_lock(&perl_running);
-
perl_destruct(
p
);
-
perl_free(
p
);
+
if(storage->parsed)
+
{
+
perl_destruct(
storage->my_perl
);
+
storage->parsed=0;
+
}
+
perl_free(
storage->my_perl
);
mt_unlock(&perl_running); THREADS_DISALLOW(); num_perl_interpreters--; } if(THIS->argv) { free((char *)THIS->argv); THIS->argv=0; } if(THIS->argv_strings)
pike.git/src/modules/Perl/perlmod.c:91:
} } static void perlmod_run(INT32 args) { INT32 i; PerlInterpreter *p=PERL; if(!p) error("No perl interpreter available.\n"); pop_n_elems(args);
+
if(!THIS->argv_strings)
+
error("Perl->create() must be called first.\n");
+
THREADS_ALLOW(); mt_lock(&perl_running); i=perl_run(p); mt_unlock(&perl_running); THREADS_DISALLOW(); push_int(i); }
-
static void perlmod_
parse
(INT32 args)
+
static void perlmod_
create
(INT32 args)
{ extern void xs_init(void); int e; struct mapping *env_mapping=0; PerlInterpreter *p=PERL; struct perlmod_storage *storage=THIS;
-
check_all_args("Perl->
parse
",args,BIT_ARRAY, BIT_MAPPING|BIT_VOID, 0);
+
check_all_args("Perl->
create
",args,BIT_ARRAY, BIT_MAPPING|BIT_VOID, 0);
if(!p) error("No perl interpreter available.\n"); if(THIS->argv_strings)
-
error("Perl->
parse
() can only be called once.\n");
+
error("Perl->
create
() can only be called once.\n");
switch(args) { default: env_mapping=sp[1-args].u.mapping; mapping_fix_type_field(env_mapping); if(m_ind_types(env_mapping) & ~BIT_STRING)
-
error("Bad argument 2 to Perl->
parse
().\n");
+
error("Bad argument 2 to Perl->
create
().\n");
if(m_val_types(env_mapping) & ~BIT_STRING)
-
error("Bad argument 2 to Perl->
parse
().\n");
+
error("Bad argument 2 to Perl->
create
().\n");
case 1: THIS->argv_strings=sp[-args].u.array; add_ref(THIS->argv_strings); array_fix_type_field(THIS->argv_strings);
-
+
if(THIS->argv_strings->size<2)
+
error("Perl: Too few elements in argv array.\n");
+
if(THIS->argv_strings->type_field & ~BIT_STRING)
-
error("Bad argument 2 to Perl->
parse
().\n");
+
error("Bad argument 2 to Perl->
create
().\n");
} THIS->argv=(char **)xalloc(sizeof(char *)*THIS->argv_strings->size); for(e=0;e<THIS->argv_strings->size;e++) THIS->argv[e]=ITEM(THIS->argv_strings)[e].u.string->str; if(env_mapping) { INT32 d; int env_block_size=0;
pike.git/src/modules/Perl/perlmod.c:169:
MEMCPY(env_blockp,k->val.u.string->str,k->ind.u.string->len); env_blockp+=k->val.u.string->len; *(env_blockp++)='0'; } THIS->env[d]=0; } THREADS_ALLOW(); mt_lock(&perl_running);
+
if(!storage->parsed)
+
{
+
perl_construct(p);
+
storage->parsed++;
+
}
e=perl_parse(p, xs_init, storage->argv_strings->size, storage->argv, storage->env); mt_unlock(&perl_running); THREADS_DISALLOW(); pop_n_elems(args); push_int(e); }
pike.git/src/modules/Perl/perlmod.c:192:
error("Perl->eval not yet implemented.\n"); } static void perlmod_call(INT32 args) { error("Perl->call not yet implemented.\n"); } void pike_module_init(void) {
-
perl_destruct_level=
1
;
+
perl_destruct_level=
2
;
start_new_program(); add_storage(sizeof(struct perlmod_storage));
-
add_function("
parse
",perlmod_
parse
,"function(array(string),void|mapping(string:string):int)",0);
+
add_function("
create
",perlmod_
create
,"function(array(string),void|mapping(string:string):int)",0);
add_function("run",perlmod_run,"function(:int)",0); add_function("eval",perlmod_eval,"function(string:int)",0); add_function("call",perlmod_call,"function(string,mixed...:int)",0); set_init_callback(init_perl_glue); set_exit_callback(exit_perl_glue); end_class("Perl",0); add_integer_constant("MULTIPLICITY", #ifdef MULTIPLICITY 1, #else 0, #endif 0); } void pike_module_exit(void) { }
-
+
+
#else /* HAVE_PERL */
+
void pike_module_init(void) {}
+
void pike_module_exit(void) {}
+
#endif