diff --git a/.gitattributes b/.gitattributes index 997a5d7b9a92cd51a42c4e171716729a5f920b59..2b2b6b15933229d7a93c89e67e906bf4c53fe724 100644 --- a/.gitattributes +++ b/.gitattributes @@ -222,6 +222,7 @@ testfont binary /src/modules/Oracle/configure.in foreign_ident /src/modules/Oracle/oracle.c foreign_ident /src/modules/Perl/Makefile.in foreign_ident +/src/modules/Perl/acconfig.h foreign_ident /src/modules/Perl/configure.in foreign_ident /src/modules/Pipe/Makefile.in foreign_ident /src/modules/Pipe/acconfig.h foreign_ident diff --git a/src/modules/Perl/.cvsignore b/src/modules/Perl/.cvsignore index 9b21632dac574882ee50614562c19c46f0b8db1d..61424943825502fdb410f7be38c3b8efa00a32ae 100644 --- a/src/modules/Perl/.cvsignore +++ b/src/modules/Perl/.cvsignore @@ -9,3 +9,6 @@ modlist_headers modlist_segment module_testsuite stamp-h +stamp-h.in +perl_machine.h +perl_machine.h.in diff --git a/src/modules/Perl/.gitignore b/src/modules/Perl/.gitignore index 3bbebf26966fb9f3a9b7f7f65d201c8388eeb5f7..fd1eed75b8efd86a3652e7d28035ff87569a06b7 100644 --- a/src/modules/Perl/.gitignore +++ b/src/modules/Perl/.gitignore @@ -9,3 +9,6 @@ /modlist_segment /module_testsuite /stamp-h +/stamp-h.in +/perl_machine.h +/perl_machine.h.in diff --git a/src/modules/Perl/Makefile.in b/src/modules/Perl/Makefile.in index 4b24b886023925ff7e159bd87bbfc9d97713e8c3..c2d52c5dde3d30b517691fdd6ceca11a2b442d56 100644 --- a/src/modules/Perl/Makefile.in +++ b/src/modules/Perl/Makefile.in @@ -1,8 +1,8 @@ -# $Id: Makefile.in,v 1.1 1998/11/22 11:05:03 hubbe Exp $ +# $Id: Makefile.in,v 1.2 1998/11/22 13:02:05 hubbe Exp $ SRCDIR=@srcdir@ VPATH=@srcdir@:@srcdir@/../..:../.. MODULE_LDFLAGS=@LDFLAGS@ @LIBS@ @PERL_LDFLAGS@ -OBJS=perlmod.o perlxsi.o +OBJS=perlmod.o @extra_objs@ PERL=@perl@ MODULE_CFLAGS=@PERL_CCFLAGS@ diff --git a/src/modules/Perl/acconfig.h b/src/modules/Perl/acconfig.h new file mode 100644 index 0000000000000000000000000000000000000000..bfa0b386dfa15acd48eceaa1f68f2c051b670756 --- /dev/null +++ b/src/modules/Perl/acconfig.h @@ -0,0 +1,14 @@ +/* + * $Id: acconfig.h,v 1.1 1998/11/22 13:02:06 hubbe Exp $ + */ + +#ifndef GMP_MACHINE_H +#define GMP_MACHINE_H + +@TOP@ +@BOTTOM@ + +/* Define this if you have an embeddable perl */ +#undef HAVE_PERL + +#endif diff --git a/src/modules/Perl/configure.in b/src/modules/Perl/configure.in index 7c61d38091d76a281d58a623caf2c642af8a9f78..7f640fd4bc19acbbdf56b8d77fb92788165ae28f 100644 --- a/src/modules/Perl/configure.in +++ b/src/modules/Perl/configure.in @@ -1,10 +1,13 @@ -# $Id: configure.in,v 1.1 1998/11/22 11:05:04 hubbe Exp $ +# $Id: configure.in,v 1.2 1998/11/22 13:02:06 hubbe Exp $ AC_INIT(perlmod.c) +AC_CONFIG_HEADER(perl_machine.h) AC_MODULE_INIT() AC_CHECK_PROGS(perl, perl perl5, x) +objs= + if test x$perl != xx ; then # We have perl, but do we have perlembed? # PERL_LDFLAGS=`perl -V:lddlflags | sed "s/^lddlflags='\(.*\);$/\1/"` @@ -12,11 +15,19 @@ if test x$perl != xx ; then PERL_LDFLAGS=`perl -MExtUtils::Embed -e ldopts` PERL_CCFLAGS=`perl -MExtUtils::Embed -e ccopts` + + if test "x$PERL_LDFLAGS$PERL_CCFLAGS" != x; then + extra_objs='perlxsi.o' + AC_DEFINE(HAVE_PERL) + fi fi AC_SUBST(perl) +AC_SUBST(extra_objs) AC_SUBST(PERL_LDFLAGS) AC_SUBST(PERL_CCFLAGS) + + AC_OUTPUT(Makefile,echo FOO >stamp-h ) diff --git a/src/modules/Perl/perlmod.c b/src/modules/Perl/perlmod.c index da42897d5876a15bbcc09cc160d6e7a3f0030d0b..9a936caabeeb7f8bf1d8fe5bf4b80c305b86d6b7 100644 --- a/src/modules/Perl/perlmod.c +++ b/src/modules/Perl/perlmod.c @@ -6,6 +6,9 @@ #include <module_support.h> #include <threads.h> #include <mapping.h> +#include <perl_machine.h> + +#ifdef HAVE_PERL #include <EXTERN.h> #include <perl.h> @@ -23,6 +26,7 @@ struct perlmod_storage char **env; char *env_block; struct array *argv_strings; + int parsed; PerlInterpreter *my_perl; }; @@ -36,6 +40,7 @@ static void init_perl_glue(struct object *o) THIS->env=0; THIS->env_block=0; THIS->argv_strings=0; + THIS->parsed=0; #ifndef MULTIPLICITY if(num_perl_interpreters>0) @@ -49,7 +54,6 @@ static void init_perl_glue(struct object *o) THREADS_ALLOW(); mt_lock(&perl_running); p=perl_alloc(); - if(p) perl_construct(p); mt_unlock(&perl_running); THREADS_DISALLOW(); PERL=p; @@ -60,11 +64,16 @@ 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--; @@ -98,6 +107,9 @@ static void perlmod_run(INT32 args) 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); @@ -106,7 +118,7 @@ static void perlmod_run(INT32 args) push_int(i); } -static void perlmod_parse(INT32 args) +static void perlmod_create(INT32 args) { extern void xs_init(void); int e; @@ -114,11 +126,11 @@ static void perlmod_parse(INT32 args) 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) { @@ -127,17 +139,20 @@ static void perlmod_parse(INT32 args) 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); @@ -176,6 +191,11 @@ static void perlmod_parse(INT32 args) THREADS_ALLOW(); mt_lock(&perl_running); + if(!storage->parsed) + { + perl_construct(p); + storage->parsed++; + } e=perl_parse(p, xs_init, storage->argv_strings->size, @@ -199,10 +219,10 @@ static void perlmod_call(INT32 args) 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); @@ -222,3 +242,8 @@ void pike_module_init(void) void pike_module_exit(void) { } + +#else /* HAVE_PERL */ +void pike_module_init(void) {} +void pike_module_exit(void) {} +#endif diff --git a/src/modules/Perl/testsuite.in b/src/modules/Perl/testsuite.in index c09d3ac019109910686e5f68f4cfac9b5d39c001..6e3606c5cad6e17a4e7beca38e7ba334c2997fa5 100644 --- a/src/modules/Perl/testsuite.in +++ b/src/modules/Perl/testsuite.in @@ -1,5 +1,5 @@ cond( [[ master()->resolv("Perl")->Perl ]], [[ test_true(Perl.Perl) - test_true(Perl.Perl()) + test_true(Perl.Perl( ({"perl","-e","exit 1"}) )->run()) ]])