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

version» Context lines:

pike.git/src/modules/Perl/perlmod.c:1: - /* $Id: perlmod.c,v 1.22 2000/12/01 08:10:18 hubbe Exp $ */ + /* $Id: perlmod.c,v 1.23 2000/12/05 21:08:31 per Exp $ */      #define NO_PIKE_SHORTHAND      #include "builtin_functions.h"   #include "global.h"   #include "svalue.h"   #include "array.h"   #include "stralloc.h"   #include "interpret.h"   #include "module_support.h"
pike.git/src/modules/Perl/perlmod.c:17:   #include "module_magic.h"      #ifdef HAVE_PERL      /* #define PERL_560 1 */      #include <EXTERN.h>   #include <perl.h>      #ifdef USE_THREADS - /* #Pike_error Threaded Perl not supported. */ + /* #error Threaded Perl not supported. */   #endif      #define MY_XS 1   #undef MY_XS      /* #define PIKE_PERLDEBUG */      #ifdef MY_XS   EXTERN_C void boot_DynaLoader();   
pike.git/src/modules/Perl/perlmod.c:148:    int argc, char *argv[], char *envp[])   { int result;   #ifndef MY_XS    extern void xs_init(void);   #endif   #ifdef PIKE_PERLDEBUG    fprintf(stderr, "[_perl_parse, argc=%d]\n", argc);   #endif       if (!ps) -  Pike_error("Internal Pike_error: no Perl storage allocated.\n"); +  Pike_error("Internal error: no Perl storage allocated.\n");    if (!ps->perl) -  Pike_error("Internal Pike_error: no Perl interpreter allocated.\n"); +  Pike_error("Internal error: no Perl interpreter allocated.\n");    if (!ps->constructed) -  Pike_error("Internal Pike_error: Perl interpreter not constructed.\n"); +  Pike_error("Internal error: Perl interpreter not constructed.\n");    if (!envp && !ps->env)    { /* Copy environment data, since Perl may wish to modify it. */       INT32 d;    int env_block_size=0;    char *env_blockp;      #ifdef DECLARE_ENVIRON    extern char **environ;   #endif
pike.git/src/modules/Perl/perlmod.c:592:    strncpy(errtmp+strlen(errtmp),    SvPV(GvSV(PL_errgv), PL_na),    254-strlen(errtmp));    POPs;    PUTBACK; FREETMPS; LEAVE;    Pike_error(errtmp);    }       if (n < 0)    { PUTBACK; FREETMPS; LEAVE; -  Pike_error("Internal Pike_error: perl_call_pv returned a negative number.\n"); +  Pike_error("Internal error: perl_call_pv returned a negative number.\n");    }       if (!(perlflags & G_ARRAY) && n > 1)    while (n > 1) --n, POPs;       if (n > ps->array_size_limit)    { PUTBACK; FREETMPS; LEAVE;    Pike_error("Perl function returned too many values.\n");    }   
pike.git/src/modules/Perl/perlmod.c:668:    }    else if (type == 'H') /* hash */    { HV *hv = perl_get_hv(Pike_sp[-args].u.string->str, TRUE | GV_ADDMULTI);    SV *key = sv_2mortal(_pikev2sv(Pike_sp+1-args));    HE *he;    if (op == 'W')    { if ((he = hv_store_ent    (hv, key, _sv_2mortal(_pikev2sv(Pike_sp+2-args)), 0)))    sv_setsv(HeVAL(he), _sv_2mortal(_pikev2sv(Pike_sp+2-args)));    else -  Pike_error("Internal Pike_error: hv_store_ent returned NULL.\n"); +  Pike_error("Internal error: hv_store_ent returned NULL.\n");    }    pop_n_elems(args);    if (op == 'R')    { if ((he = hv_fetch_ent(hv, key, 0, 0)))    _pikepush_sv(HeVAL(he));    else    _push_zerotype();    }    } -  else Pike_error("Internal Pike_error in _perlmod_varop.\n"); +  else Pike_error("Internal error in _perlmod_varop.\n");       if (op != 'R') push_int(0);   }      static void perlmod_get_scalar(INT32 args)    { _perlmod_varop(args, 'R', 'S');}   static void perlmod_set_scalar(INT32 args)    { _perlmod_varop(args, 'W', 'S');}   static void perlmod_get_array_item(INT32 args)    { _perlmod_varop(args, 'R', 'A');}
pike.git/src/modules/Perl/perlmod.c:704:    { _perlmod_varop(args, 'W', 'H');}      static void perlmod_array_size(INT32 args)   { AV *av;    if (args != 1) Pike_error("Wrong number of arguments.\n");    if (Pike_sp[-args].type != PIKE_T_STRING ||    Pike_sp[-args].u.string->size_shift != 0)    Pike_error("Array name must be given as an 8-bit string.\n");       av = perl_get_av(Pike_sp[-args].u.string->str, TRUE | GV_ADDMULTI); -  if (!av) Pike_error("Interal Pike_error: perl_get_av() return NULL.\n"); +  if (!av) Pike_error("Interal error: perl_get_av() return NULL.\n");    pop_n_elems(args);    /* Return av_len()+1, since av_len() returns the value of the highest    * index, which is 1 less than the size. */    push_int(av_len(av)+1);   }      static void perlmod_get_whole_array(INT32 args)   { AV *av; int i, n; struct array *arr;    if (args != 1) Pike_error("Wrong number of arguments.\n");    if (Pike_sp[-args].type != PIKE_T_STRING ||    Pike_sp[-args].u.string->size_shift != 0)    Pike_error("Array name must be given as an 8-bit string.\n");       av = perl_get_av(Pike_sp[-args].u.string->str, TRUE | GV_ADDMULTI); -  if (!av) Pike_error("Interal Pike_error: perl_get_av() returned NULL.\n"); +  if (!av) Pike_error("Interal error: perl_get_av() returned NULL.\n");    n = av_len(av) + 1;       if (n > _THIS->array_size_limit)    Pike_error("The array is larger than array_size_limit.\n");       arr = allocate_array(n);    for(i = 0; i < n; ++i)    { SV **svp = av_fetch(av, i, 0);    _sv_to_svalue(svp ? *svp : NULL, &(arr->item[i]));    }
pike.git/src/modules/Perl/perlmod.c:742:   }      static void perlmod_get_hash_keys(INT32 args)   { HV *hv; HE *he; SV *sv; int i, n; I32 len; struct array *arr;    if (args != 1) Pike_error("Wrong number of arguments.\n");    if (Pike_sp[-args].type != PIKE_T_STRING ||    Pike_sp[-args].u.string->size_shift != 0)    Pike_error("Hash name must be given as an 8-bit string.\n");       hv = perl_get_hv(Pike_sp[-args].u.string->str, TRUE | GV_ADDMULTI); -  if (!hv) Pike_error("Interal Pike_error: perl_get_av() return NULL.\n"); +  if (!hv) Pike_error("Interal error: perl_get_av() return NULL.\n");       /* count number of elements in hash */    for(n = 0, hv_iterinit(hv); (he = hv_iternext(hv)); ++n);       if (n > _THIS->array_size_limit)    Pike_error("The array is larger than array_size_limit.\n");       arr = allocate_array(n);    for(i = 0, hv_iterinit(hv); (he = hv_iternext(hv)); ++i)    _sv_to_svalue(hv_iterkeysv(he), &(arr->item[i]));
pike.git/src/modules/Perl/perlmod.c:866:    0);   }      void pike_module_exit(void)   {   }      #else /* HAVE_PERL */      #ifdef ERROR_IF_NO_PERL - #Pike_error "No Perl!" + #error "No Perl!"   #endif      void pike_module_init(void) {}   void pike_module_exit(void) {}   #endif