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:
-
/* $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