richter 2002/10/11 12:40:55
Modified: . Tag: Embperl2c Changes.pod epio.c test.pl
Log:
fix tied stdout for perl 5.8.0
Revision Changes Path
No revision
No revision
1.129.4.97 +1 -0 embperl/Changes.pod
Index: Changes.pod
===================================================================
RCS file: /home/cvs/embperl/Changes.pod,v
retrieving revision 1.129.4.96
retrieving revision 1.129.4.97
diff -u -r1.129.4.96 -r1.129.4.97
--- Changes.pod 11 Oct 2002 15:45:22 -0000 1.129.4.96
+++ Changes.pod 11 Oct 2002 19:40:55 -0000 1.129.4.97
@@ -31,6 +31,7 @@
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 with [$ sub $] when running under Perl 5.8.0.
+ - Fixed problem when STDOUT is tied, because storege has changed in Perl 5.8.0.
=head1 2.0b8 (BETA) 25. Juni 2002
1.16.4.16 +47 -22 embperl/epio.c
Index: epio.c
===================================================================
RCS file: /home/cvs/embperl/epio.c,v
retrieving revision 1.16.4.15
retrieving revision 1.16.4.16
diff -u -r1.16.4.15 -r1.16.4.16
--- epio.c 23 May 2002 22:24:45 -0000 1.16.4.15
+++ epio.c 11 Oct 2002 19:40:55 -0000 1.16.4.16
@@ -55,6 +55,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,17 +361,22 @@
return ok ;
#endif
- handle = gv_fetchpv("STDIN", TRUE, SVt_PVIO) ;
- if (handle && SvMAGICAL(handle) && (mg = mg_find((SV*)handle, 'q')) &&
mg->mg_obj)
- {
- r -> Component.ifdobj = mg->mg_obj ;
- if (r -> Component.Config.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 -> pApp, "[%d]Open TIED STDIN %s...\n", r -> pThread -> nPid,
package) ;
+ r -> Component.ifdobj = mg->mg_obj ;
+ if (r -> Component.Config.bDebug)
+ {
+ char *package = HvNAME(SvSTASH((SV*)SvRV(mg->mg_obj)));
+ lprintf (r -> pApp, "[%d]Open TIED STDIN %s...\n", r -> pThread ->
nPid, package) ;
+ }
+ return ok ;
}
- return ok ;
- }
+ }
if (r -> Component.ifd && r -> Component.ifd != PerlIO_stdinF)
PerlIO_close (r -> Component.ifd) ;
@@ -678,18 +698,23 @@
}
#endif
- handle = gv_fetchpv("STDOUT", TRUE, SVt_PVIO) ;
- if (handle && SvMAGICAL(handle) && (mg = mg_find((SV*)handle, 'q')) &&
mg->mg_obj)
- {
- r -> Component.pOutput -> ofdobj = mg->mg_obj ;
- if (r -> Component.Config.bDebug)
- {
- char *package = HvNAME(SvSTASH((SV*)SvRV(mg->mg_obj)));
- lprintf (r -> pApp, "[%d]Open TIED STDOUT %s for output...\n", r ->
pThread -> 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 -> Component.pOutput -> ofdobj = mg->mg_obj ;
+ if (r -> Component.Config.bDebug)
+ {
+ char *package = HvNAME(SvSTASH((SV*)SvRV(mg->mg_obj)));
+ lprintf (r -> pApp, "[%d]Open TIED STDOUT %s for output...\n", r
-> pThread -> nPid, package) ;
+ }
+ return ok ;
+ }
+ }
+
r -> Component.pOutput -> ofd = PerlIO_stdoutF ;
if (r -> Component.Config.bDebug)
1.70.4.142 +2 -2 embperl/test.pl
Index: test.pl
===================================================================
RCS file: /home/cvs/embperl/test.pl,v
retrieving revision 1.70.4.141
retrieving revision 1.70.4.142
diff -u -r1.70.4.141 -r1.70.4.142
--- test.pl 25 Jun 2002 06:09:59 -0000 1.70.4.141
+++ test.pl 11 Oct 2002 19:40:55 -0000 1.70.4.142
@@ -2000,7 +2000,7 @@
$Embperl::Test::STDOUT::output = '' ;
tie *STDOUT, 'Embperl::Test::STDOUT' ;
$t1 = 0 ; # Embperl::Clock () ;
- $err = Embperl::Execute ({'inputfile' => $src,
+ $err = Embperl::Execute ({'inputfile' => $src,
'mtime' => 1,
'debug' => $defaultdebug,
input_escmode => 7,
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
