I backported these changes from Embperl2:
- Fixed compiler warnings and errors when compiling with Perl 5.8.0.
- Replaced PL_sv_undef with ep_sv_undef (which is a copy of
PL_sv_undef), because storing PL_sv_undef in a Perl 5.8.0 hash is
treated as a placeholder and doesn't work as before.
- Fixed problem when STDOUT is tied, because storege has changed in
Perl 5.8.0.
and a few other small fixes to epio.c while I was at it (mostly type
changes).
Seems to pass "make test", I haven't tried it on anything else.
(In particular, I haven't backported the change for imported subs. I
presume either its not a problem in 1.3.x, or make test doesn't test
it)
perl 5.8, apache 1.3.26, mod_perl 1.27
Debian 1.3.4 package will be uploaded shortly, my apologies for the
delay.
- Gus
Index: epmain.c
===================================================================
RCS file: /var/lib/cvs/debian/libhtml-embperl-perl/epmain.c,v
retrieving revision 1.1.1.5
diff -u -r1.1.1.5 epmain.c
--- epmain.c 5 Dec 2001 05:34:50 -0000 1.1.1.5
+++ epmain.c 30 Oct 2002 21:24:59 -0000
@@ -64,6 +64,13 @@
filename + packagename,
value=>cache hash for file) */
+SV ep_sv_undef ; /* we need our own undef value, because when
+ storing a PL_sv_undef with Perl 5.8.0 in a hash
+ Perl takes it as a placeholder and pretents it
+ isn't there :-( */
+
+
+
/* */
/* print error */
/* */
@@ -1429,6 +1436,8 @@
pCurrReq = r ;
r -> nIOType = _nIOType ;
+
+ memcpy (&ep_sv_undef, &PL_sv_undef, sizeof(PL_sv_undef)) ;
#ifdef APACHE
r -> pApacheReq = NULL ;
Index: epio.c
===================================================================
RCS file: /var/lib/cvs/debian/libhtml-embperl-perl/epio.c,v
retrieving revision 1.1.1.3
diff -u -r1.1.1.3 epio.c
--- epio.c 17 Oct 2001 05:44:47 -0000 1.1.1.3
+++ epio.c 30 Oct 2002 22:06:19 -0000
@@ -57,6 +57,21 @@
#endif
+/* Some helper macros for tied handles, taken from mod_perl 2.0 :-) */
+/*
+ * bleedperl change #11639 switch tied handle magic
+ * from living in the gv to the GvIOp(gv), so we have to deal
+ * with both to support 5.6.x
+ */
+#if ((PERL_REVISION == 5) && (PERL_VERSION >= 7))
+# define TIEHANDLE_SV(handle) (SV*)GvIOp((SV*)handle)
+#else
+# define TIEHANDLE_SV(handle) (SV*)handle
+#endif
+
+#define HANDLE_GV(name) gv_fetchpv(name, TRUE, SVt_PVIO)
+
+
#ifdef APACHE
#define DefaultLog "/tmp/embperl.log"
@@ -346,16 +361,21 @@
return ok ;
#endif
- handle = gv_fetchpv("STDIN", TRUE, SVt_PVIO) ;
- if (handle && SvMAGICAL(handle) && (mg = mg_find((SV*)handle, 'q')) &&
mg->mg_obj)
- {
- r -> ifdobj = mg->mg_obj ;
- if (r -> bDebug)
+ handle = HANDLE_GV("STDIN") ;
+ if (handle)
+ {
+ SV *iohandle = TIEHANDLE_SV(handle) ;
+
+ if (iohandle && SvMAGICAL(iohandle) && (mg = mg_find((SV*)iohandle, 'q')) &&
+mg->mg_obj)
{
- char *package = HvNAME(SvSTASH((SV*)SvRV(mg->mg_obj)));
- lprintf (r, "[%d]Open TIED STDIN %s...\n", r -> nPid, package) ;
+ r -> ifdobj = mg->mg_obj ;
+ if (r -> bDebug)
+ {
+ char *package = HvNAME(SvSTASH((SV*)SvRV(mg->mg_obj)));
+ lprintf (r, "[%d]Open TIED STDIN %s...\n", r -> nPid, package) ;
+ }
+ return ok ;
}
- return ok ;
}
if (r -> ifd && r -> ifd != PerlIO_stdinF)
@@ -410,6 +430,7 @@
XPUSHs(r -> ifdobj);
PUTBACK;
perl_call_method ("CLOSE", G_VOID | G_EVAL) ;
+ SPAGAIN ;
FREETMPS;
LEAVE;
r -> ifdobj = NULL ;
@@ -465,7 +486,7 @@
n = 0 ;
if (num > 0)
{
- int n = POPi ;
+ STRLEN n = POPu ;
char * p ;
STRLEN l ;
if (n >= 0)
@@ -576,7 +597,7 @@
return rcFileOpenErr ;
}
- if ((long)nFileSize < 0)
+ if ((long)*nFileSize < 0)
return rcFileOpenErr ;
@@ -671,18 +692,22 @@
}
#endif
- handle = gv_fetchpv("STDOUT", TRUE, SVt_PVIO) ;
- if (handle && SvMAGICAL(handle) && (mg = mg_find((SV*)handle, 'q')) &&
mg->mg_obj)
- {
- r -> ofdobj = mg->mg_obj ;
- if (r -> bDebug)
- {
- char *package = HvNAME(SvSTASH((SV*)SvRV(mg->mg_obj)));
- lprintf (r, "[%d]Open TIED STDOUT %s for output...\n", r -> nPid,
package) ;
- }
- return ok ;
- }
-
+ handle = HANDLE_GV("STDOUT") ;
+ if (handle)
+ {
+ SV *iohandle = TIEHANDLE_SV(handle) ;
+
+ if (iohandle && SvMAGICAL(iohandle) && (mg = mg_find((SV*)iohandle, 'q'))
+&& mg->mg_obj)
+ {
+ r -> ofdobj = mg->mg_obj ;
+ if (r -> bDebug)
+ {
+ char *package = HvNAME(SvSTASH((SV*)SvRV(mg->mg_obj)));
+ lprintf (r, "[%d]Open TIED STDOUT %s for output...\n", r -> nPid,
+package) ;
+ }
+ return ok ;
+ }
+ }
r -> ofd = PerlIO_stdoutF ;
if (r -> bDebug)
@@ -744,6 +769,7 @@
XPUSHs(r -> ifdobj);
PUTBACK;
perl_call_method ("CLOSE", G_VOID | G_EVAL) ;
+ SPAGAIN ;
FREETMPS;
LEAVE;
r -> ofdobj = NULL ;
@@ -825,7 +851,7 @@
/*in*/ const void * ptr, size_t size)
{
- int n = size ;
+ size_t n = size ;
if (n == 0 || r -> bDisableOutput)
return 0 ;
@@ -833,10 +859,10 @@
if (r -> pMemBuf)
{
char * p ;
- int s = r -> nMemBufSize ;
+ size_t s = r -> nMemBufSize ;
if (n >= r -> nMemBufSizeFree)
{
- int oldsize = s ;
+ size_t oldsize = s ;
if (s < n)
s = n + r -> nMemBufSize ;
@@ -875,6 +901,7 @@
XPUSHs(sv_2mortal(newSVpv((char *)ptr,size)));
PUTBACK;
perl_call_method ("PRINT", G_SCALAR) ;
+ SPAGAIN ;
FREETMPS;
LEAVE;
return size ;
@@ -895,7 +922,7 @@
return 0 ;
}
#endif
- if (n > 0)
+ if (n > 0 && r -> ofd)
{
n = PerlIO_write (r -> ofd, (void *)ptr, size) ;
Index: ep.h
===================================================================
RCS file: /var/lib/cvs/debian/libhtml-embperl-perl/ep.h,v
retrieving revision 1.1.1.5
diff -u -r1.1.1.5 ep.h
--- ep.h 2 Nov 2001 10:25:58 -0000 1.1.1.5
+++ ep.h 30 Oct 2002 21:28:56 -0000
@@ -21,7 +21,15 @@
#include <ctype.h>
#include <time.h>
-#if !defined(PERLIO_IS_STDIO)
+#ifndef PERL_VERSION
+#include <patchlevel.h>
+#ifndef PERL_VERSION
+#define PERL_VERSION PATCHLEVEL
+#define PERL_SUBVERSION SUBVERSION
+#endif
+#endif
+
+#if !defined(PERLIO_IS_STDIO) && PERL_VERSION < 8
#define PERLIO_IS_STDIO
#endif
@@ -96,12 +104,6 @@
#undef sleep
#endif
-#ifndef PERL_VERSION
-#include <patchlevel.h>
-#define PERL_VERSION PATCHLEVEL
-#define PERL_SUBVERSION SUBVERSION
-#endif
-
#if PERL_VERSION >= 6
#ifdef opendir
@@ -171,6 +173,12 @@
#define PATH_MAX 512
#endif
+
+#ifdef sv_undef
+#undef sv_undef
+#endif
+#define sv_undef ep_sv_undef
+extern SV ep_sv_undef ;
/* ---- global variables ---- */
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
