dougm 00/03/29 16:44:42
Modified: . Changes
src/modules/perl Constants.xs mod_perl.h perl_config.c
perl_util.c
Log:
workaround use of Perl api functions that are no longer public with
Perl 5.6.0 + win32
Revision Changes Path
1.445 +3 -0 modperl/Changes
Index: Changes
===================================================================
RCS file: /home/cvs/modperl/Changes,v
retrieving revision 1.444
retrieving revision 1.445
diff -u -r1.444 -r1.445
--- Changes 2000/03/30 00:20:32 1.444
+++ Changes 2000/03/30 00:44:39 1.445
@@ -10,6 +10,9 @@
=item 1.22_01-dev
+workaround use of Perl api functions that are no longer public with
+Perl 5.6.0 + win32, thanks to Randy Kobes for spotting
+
change $Apache::VERSION check to use a string instead of SvNV, which
was troublesome with Perl 5.6.0, thanks to Dave Seidel for pinpointing
1.20 +16 -13 modperl/src/modules/perl/Constants.xs
Index: Constants.xs
===================================================================
RCS file: /home/cvs/modperl/src/modules/perl/Constants.xs,v
retrieving revision 1.19
retrieving revision 1.20
diff -u -r1.19 -r1.20
--- Constants.xs 2000/03/02 20:21:03 1.19
+++ Constants.xs 2000/03/30 00:44:40 1.20
@@ -56,22 +56,28 @@
}
#endif /*XS_IMPORT*/
-static CV *no_warn = Nullcv;
+/* prevent prototype mismatch warnings */
-CV *empty_anon_sub(void)
+static void check_proto(HV *stash, char *name)
{
- return newSUB(start_subparse(FALSE, 0),
- newSVOP(OP_CONST, 0, newSVpv("__ANON__",8)),
- Nullop,
- block_end(block_start(TRUE), newOP(OP_STUB,0)));
+ GV **gvp = (GV**)hv_fetch(stash, name, strlen(name), FALSE);
+ CV *cv;
+
+ if (!(gvp && *gvp && (cv = GvCVu(*gvp)))) {
+ return;
+ }
+ if (CvROOT(cv)) {
+ return;
+ }
+ if (!SvPOK(cv)) {
+ sv_setsv((SV*)cv, &sv_no);
+ }
}
#ifdef newCONSTSUB
#define my_newCONSTSUB(stash, name, sv) \
- if(!no_warn) no_warn = empty_anon_sub(); \
- SAVESPTR(warnhook); \
- warnhook = (SV*)no_warn; \
+ check_proto(stash, name); \
newCONSTSUB(stash, name, sv)
#else
@@ -94,10 +100,7 @@
curstash = curcop->cop_stash = stash;
}
- /* prevent prototype mismatch warnings */
- if(!no_warn) no_warn = empty_anon_sub();
- SAVESPTR(warnhook);
- warnhook = (SV*)no_warn;
+ check_proto(stash, name);
(void)newSUB(start_subparse(FALSE, 0),
newSVOP(OP_CONST, 0, newSVpv(name,0)),
1.96 +0 -2 modperl/src/modules/perl/mod_perl.h
Index: mod_perl.h
===================================================================
RCS file: /home/cvs/modperl/src/modules/perl/mod_perl.h,v
retrieving revision 1.95
retrieving revision 1.96
diff -u -r1.95 -r1.96
--- mod_perl.h 2000/03/22 01:17:34 1.95
+++ mod_perl.h 2000/03/30 00:44:40 1.96
@@ -1107,12 +1107,10 @@
void perl_run_rgy_endav(char *s);
void perl_run_endav(char *s);
void perl_call_halt(int status);
-CV *empty_anon_sub(void);
void perl_reload_inc(server_rec *s, pool *p);
I32 perl_module_is_loaded(char *name);
SV *perl_module2file(char *name);
int perl_require_module(char *module, server_rec *s);
-void perl_qrequire_module (char *name);
int perl_load_startup_script(server_rec *s, pool *p, char *script, I32 my_warn);
array_header *perl_cgi_env_init(request_rec *r);
void perl_clear_env(void);
1.93 +3 -0 modperl/src/modules/perl/perl_config.c
Index: perl_config.c
===================================================================
RCS file: /home/cvs/modperl/src/modules/perl/perl_config.c,v
retrieving revision 1.92
retrieving revision 1.93
diff -u -r1.92 -r1.93
--- perl_config.c 2000/03/22 01:17:34 1.92
+++ perl_config.c 2000/03/30 00:44:40 1.93
@@ -391,6 +391,7 @@
cfg->pnotes = Nullhv;
cfg->setup_env = 0;
+#ifndef WIN32
cfg->sigsave = make_array(p, 1, sizeof(perl_request_sigsave *));
for (i=0; sigsave[i]; i++) {
@@ -403,6 +404,8 @@
sigsave[i], (int)sig->signo, (unsigned long)sig->h));
*(perl_request_sigsave **)push_array(cfg->sigsave) = sig;
}
+
+#endif
return cfg;
}
1.37 +10 -16 modperl/src/modules/perl/perl_util.c
Index: perl_util.c
===================================================================
RCS file: /home/cvs/modperl/src/modules/perl/perl_util.c,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -r1.36 -r1.37
--- perl_util.c 2000/03/22 01:17:34 1.36
+++ perl_util.c 2000/03/30 00:44:40 1.37
@@ -226,6 +226,15 @@
return newRV_noinc(insv);
}
+#ifndef load_module
+#define load_module(flags, name, ver, imp) \
+{ \
+ OP *modname = newSVOP(OP_CONST, 0, name); \
+ modname->op_private |= OPpCONST_BARE; \
+ utilize(TRUE, start_subparse(FALSE,0), Nullop, modname, Nullop); \
+}
+#endif
+
SV *mod_perl_tie_table(table *t)
{
HV *hv = newHV();
@@ -233,8 +242,7 @@
/*try to make this quick as possible*/
if(!hv_exists(GvHV(incgv), "Apache/Table.pm", 15)) {
- utilize(TRUE, start_subparse(FALSE, 0), Nullop,
- newSVOP(OP_CONST, 0, newSVpv("Apache/Table.pm",15)), Nullop);
+ load_module(0, newSVpv("Apache::Table",0), Nullsv, Nullsv);
}
sv_setref_pv(sv, "Apache::table", (void*)t);
@@ -566,20 +574,6 @@
MP_TRACE_d(fprintf(stderr, "ok\n"));
return 0;
-}
-
-/* faster than require_module,
- * used when we're already in an eval context
- */
-void perl_qrequire_module(char *name)
-{
- OP *reqop;
- SV *key = perl_module2file(name);
- if((key && hv_exists_ent(GvHV(incgv), key, FALSE)))
- return;
- reqop = newSVOP(OP_CONST, 0, key);
- /*reqop->op_private |= OPpCONST_BARE;*/
- utilize(TRUE, start_subparse(FALSE, 0), Nullop, reqop, Nullop);
}
void perl_do_file(char *pv)
