pike.git/ src/ modules/ Perl/ perlmod.c

1998-11-22

1998-11-22 13:02:08 by Fredrik Hübinette (Hubbe) <hubbe@hubbe.net>

• 5a2b43a4e3929d1cfb94bfcc37a3653280792d9c (50 lines) (+38/-12) ^{[ Show | Annotate ]}
  Branch: 7.9

some bugs fixed..

Rev: src/modules/Perl/.cvsignore:1.2
Rev: src/modules/Perl/Makefile.in:1.2
Rev: src/modules/Perl/acconfig.h:1.1
Rev: src/modules/Perl/configure.in:1.2
Rev: src/modules/Perl/perlmod.c:1.2
Rev: src/modules/Perl/testsuite.in:1.2

6:   #include <module_support.h>   #include <threads.h>   #include <mapping.h> + #include <perl_machine.h>    -  + #ifdef HAVE_PERL +    #include <EXTERN.h>   #include <perl.h>   
23:    char **env;    char *env_block;    struct array *argv_strings; +  int parsed;    PerlInterpreter *my_perl;   };   
36:    THIS->env=0;    THIS->env_block=0;    THIS->argv_strings=0; +  THIS->parsed=0;      #ifndef MULTIPLICITY    if(num_perl_interpreters>0)
49:    THREADS_ALLOW();    mt_lock(&perl_running);    p=perl_alloc(); -  if(p) perl_construct(p); +     mt_unlock(&perl_running);    THREADS_DISALLOW();    PERL=p;
60:   {    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:    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:    push_int(i);   }    - static void perlmod_parse(INT32 args) + static void perlmod_create(INT32 args)   {    extern void xs_init(void);    int e;
114:    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:    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:       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:      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:   void pike_module_exit(void)   {   } +  + #else /* HAVE_PERL */ + void pike_module_init(void) {} + void pike_module_exit(void) {} + #endif