Front page | perl.perl5.porters |
Postings from March 2000
Re: Source filters
From:
Gurusamy Sarathy
Date:
March 24, 2000 06:41
Subject:
Re: Source filters
Message ID:
200003241440.GAA11712@maul.ActiveState.com
On Fri, 24 Mar 2000 11:51:15 GMT, "Moore, Paul" wrote:
>If so, there are some problems with Filter-1.17 when used with a Perl built
>with MULTI/ITHREADS/IMP_SYS on Win32. Specifically, the filter callback
>functions seem to be missing the appropriate scattering of pTHXo_ in the
>declarations. I've attached a patch for this.
It needs a more complete patch than that. See below.
>However there are still test failures.
>
>t/call fails with errors which look related to binmode scripts (test 24 is
>failing and it uses filter_read_exact, which may be going wrong because each
>line has an extra character (CR) beyond what is expected.
>t/decrypt, t/order and t/tee fail as well, which may be similar.
>Worse are t/cpp, t/exec and t/sh, which crash Perl. I can't see why.
>
>I think the binmode scripts thing is going to be a nasty portability
>problem. IMHO, the user of the Filter module should not have to worry about
>line ending conventions in scripts. Of course, if the filter is slurping in
>binary data and translating it, binmode is necessary (that's why it was
>introduced, for byteloader). Maybe the filter module needs something in the
>API to request binmode or textmode input of the script (with textmode the
>default, as I expect the majority of filters will be text-based).
I disagree. See ByteLoader. It would be the job of the particular filter
implementation to know whether it wants to filter "text" or "binary" input,
and behave accordingly.
I think Filter::Util::Call could use some convenience switches
to do s/\r$// in filter_read() or ignore CRs when counting characters
in filter_read_exact(). But I don't think it's really that big a
portability issue if it can be clearly documented.
>This is starting to look hard...
The attached patch makes Filter 1.16 pass all tests on Windows, assuming
you have GNU cpp.exe and tr.exe installed. It fails test 24 on Linux,
for reasons that aren't clear. I haven't investigated much, but it
seems that it could be a bug in either Filter (buffering issue?) or
stdio. The problem that causes the failure is that the initial read
from filter_read_exact() in test 24 doesn't return nine characters
like it is supposed to. Instead it returns only two.
I haven't checked Filter 1.17, but IIRC it only had documentation
updates, so this patch should apply there too. (Note to PMQS: Filter
should probably require/strongly recommend Perl 5.6.0 on Windows.
Earlier versions of Perl are suboptimal, owing to the fact that
PL_rsfp wasn't opened in binmode().)
Sarathy
gsar@ActiveState.com
-----------------------------------8<-----------------------------------
diff -ur Filter-1.16/Call/Call.xs Filter/Call/Call.xs
--- Filter-1.16/Call/Call.xs Tue Sep 21 14:56:13 1999
+++ Filter/Call/Call.xs Wed Mar 22 21:42:12 2000
@@ -33,10 +33,7 @@
static int current_idx ;
static I32
-filter_call(idx, buf_sv, maxlen)
- int idx;
- SV *buf_sv;
- int maxlen;
+filter_call(pTHX_ int idx, SV *buf_sv, int maxlen)
{
SV *my_sv = FILTER_DATA(idx);
char *nl = "\n";
diff -ur Filter-1.16/Exec/Exec.xs Filter/Exec/Exec.xs
--- Filter-1.16/Exec/Exec.xs Tue Sep 21 14:56:13 1999
+++ Filter/Exec/Exec.xs Wed Mar 22 21:42:13 2000
@@ -59,11 +59,13 @@
#ifdef USE_THREADS
struct perl_thread * parent;
#endif
+#ifdef USE_ITHREADS
+ PerlInterpreter * parent;
+#endif
} thrarg;
static void
-pipe_write(args)
-void *args ;
+pipe_write(void *args)
{
thrarg *targ = (thrarg *)args;
SV *sv = targ->sv;
@@ -72,11 +74,14 @@
int pipe_out = PIPE_OUT(sv) ;
int rawread_eof = 0;
int r,w,len;
- free(args);
#ifdef USE_THREADS
/* use the parent's perl thread context */
SET_THR(targ->parent);
#endif
+#ifdef USE_ITHREADS
+ PERL_SET_THX(targ->parent);
+#endif
+ free(args);
for(;;)
{
@@ -125,10 +130,7 @@
}
static int
-pipe_read(sv, idx, maxlen)
-SV * sv ;
-int idx ;
-int maxlen ;
+pipe_read(SV *sv, int idx, int maxlen)
{
int pipe_in = PIPE_IN(sv) ;
int pipe_out = PIPE_OUT(sv) ;
@@ -151,11 +153,14 @@
BUF_NEXT(sv) = BUF_START(sv);
if (!write_started) {
- thrarg *targ = malloc(sizeof(thrarg));
+ thrarg *targ = (thrarg*)malloc(sizeof(thrarg));
targ->sv = sv; targ->idx = idx;
#ifdef USE_THREADS
targ->parent = THR;
#endif
+#ifdef USE_ITHREADS
+ targ->parent = aTHX;
+#endif
/* thread handle is closed when pipe_write() returns */
_beginthread(pipe_write,0,(void *)targ);
write_started = 1;
@@ -188,10 +193,7 @@
static int
-pipe_read(sv, idx, maxlen)
-SV * sv ;
-int idx ;
-int maxlen ;
+pipe_read(SV *sv, int idx, int maxlen)
{
int pipe_in = PIPE_IN(sv) ;
int pipe_out = PIPE_OUT(sv) ;
@@ -292,8 +294,7 @@
static void
-make_nonblock(f)
-int f;
+make_nonblock(int f)
{
int RETVAL ;
int mode = fcntl(f, F_GETFL);
@@ -317,15 +318,14 @@
#define WRITER 1
static void
-spawnCommand(fil, command, parameters, p0, p1)
-FILE * fil;
-char * command ;
-char * parameters[] ;
-int * p0 ;
-int * p1 ;
+spawnCommand(PerlIO *fil, char *command, char *parameters[], int *p0, int *p1)
{
#ifdef WIN32
+#if defined(PERL_OBJECT)
+# define win32_pipe(p,n,f) _pipe(p,n,f)
+#endif
+
int p[2], c[2];
SV * sv ;
int oldstdout, oldstdin;
@@ -457,10 +457,7 @@
static I32
-filter_exec(idx, buf_sv, maxlen)
- int idx;
- SV *buf_sv;
- int maxlen;
+filter_exec(pTHX_ int idx, SV *buf_sv, int maxlen)
{
I32 len;
SV *buffer = FILTER_DATA(idx);
diff -ur Filter-1.16/decrypt/decrypt.xs Filter/decrypt/decrypt.xs
--- Filter-1.16/decrypt/decrypt.xs Tue Sep 21 14:56:13 1999
+++ Filter/decrypt/decrypt.xs Wed Mar 22 21:42:13 2000
@@ -63,9 +63,7 @@
#define SET_DECRYPT_BUFFER_LEN(s,n) SvCUR_set(DECRYPT_SV(s), n)
static unsigned
-Decrypt(in_sv, out_sv)
-SV * in_sv ;
-SV * out_sv ;
+Decrypt(SV *in_sv, SV *out_sv)
{
/* Here is where the actual decryption takes place */
@@ -96,10 +94,7 @@
}
static int
-ReadBlock(idx, sv, size)
-int idx ;
-SV * sv ;
-unsigned size ;
+ReadBlock(int idx, SV *sv, unsigned size)
{ /* read *exactly* size bytes from the next filter */
int i = size;
while (1) {
@@ -115,8 +110,7 @@
}
static void
-preDecrypt(idx)
- int idx;
+preDecrypt(int idx)
{
/* If the encrypted data starts with a header or needs to do some
initialisation it can be done here
@@ -146,10 +140,7 @@
}
static I32
-filter_decrypt(idx, buf_sv, maxlen)
- int idx;
- SV *buf_sv;
- int maxlen;
+filter_decrypt(pTHX_ int idx, SV *buf_sv, int maxlen)
{
SV *my_sv = FILTER_DATA(idx);
char *nl = "\n";
diff -ur Filter-1.16/decrypt/encrypt Filter/decrypt/encrypt
--- Filter-1.16/decrypt/encrypt Tue Sep 21 14:56:13 1999
+++ Filter/decrypt/encrypt Wed Mar 22 21:42:13 2000
@@ -29,6 +29,7 @@
open (F, "<$file") or die "Cannot open $file: $!\n" ;
open (O, ">${file}.pe") or die "Cannot open ${file}.pe: $!\n" ;
+ binmode O;
# Get the mode
$mode = (stat F)[2] ;
diff -ur Filter-1.16/t/call.t Filter/t/call.t
--- Filter-1.16/t/call.t Tue Sep 21 14:56:14 1999
+++ Filter/t/call.t Wed Mar 22 21:42:13 2000
@@ -420,6 +420,7 @@
# read first line
if (($status = filter_read()) > 0) {
chop ;
+ s/\r$//;
# and now the second line (it will append)
$status = filter_read() ;
}
@@ -623,7 +624,7 @@
my ($self) = @_ ;
my ($status) ;
- if (($status = filter_read_exact(6)) > 0) {
+ if (($status = filter_read_exact(9)) > 0) {
s/HERE/THERE/g
}
@@ -638,7 +639,7 @@
EOM
print "
HERE I am
-I am HERE
+I'm HERE
HERE today gone tomorrow\n" ;
EOM
@@ -647,8 +648,8 @@
ok(24, $a eq <<EOM) ;
THERE I am
-I am HERE
-HERE today gone tomorrow
+I'm HERE
+THERE today gone tomorrow
EOM
unlink $filename ;
diff -ur Filter-1.16/tee/tee.xs Filter/tee/tee.xs
--- Filter-1.16/tee/tee.xs Tue Sep 21 14:56:14 1999
+++ Filter/tee/tee.xs Wed Mar 22 21:42:14 2000
@@ -12,13 +12,10 @@
#include "XSUB.h"
static I32
-filter_tee(idx, buf_sv, maxlen)
- int idx;
- SV * buf_sv ;
- int maxlen;
+filter_tee(pTHX_ int idx, SV *buf_sv, int maxlen)
{
I32 len;
- FILE * fil = (FILE*) SvIV(FILTER_DATA(idx)) ;
+ PerlIO * fil = (PerlIO*) SvIV(FILTER_DATA(idx)) ;
int old_len = SvCUR(buf_sv) ;
if ( (len = FILTER_READ(idx+1, buf_sv, maxlen)) <=0 ) {
@@ -44,8 +41,8 @@
char * filename
CODE:
SV * stream = newSViv(0) ;
- FILE * fil ;
- char * mode = "w" ;
+ PerlIO * fil ;
+ char * mode = "wb" ;
filter_add(filter_tee, stream);
/* check for append */
@@ -53,7 +50,7 @@
++ filename ;
if (*filename == '>') {
++ filename ;
- mode = "a" ;
+ mode = "ab" ;
}
}
if ((fil = PerlIO_open(filename, mode)) == NULL)
End of Patch.