import Filter 1.13 from CPAN

git-cpan-module:   Filter
git-cpan-version:  1.13
git-cpan-authorid: PMQS
git-cpan-file:     authors/id/P/PM/PMQS/Filter-1.13.tar.gz

Call/Call.pm

@@ -285,7 +285,7 @@ implemented both as I<method filters> and as I<closure filters>.
 
 Below is a I<method filter> which is hard-wired to replace all
 occurrences of the string C<"Joe"> to C<"Jim">. Not particularly
-useful, but it is the first example and I wanted to keep it simple.
+Useful, but it is the first example and I wanted to keep it simple.
 
     package Joe2Jim ;
     

Call/Call.xs

@@ -154,7 +154,7 @@ filter_call(idx, buf_sv, maxlen)
 
 	    /* PERL_MODULE(my_sv) ; */
 	    /* PERL_OBJECT(my_sv) ; */
-	    filter_del(filter_call);  
+	    filter_del(filter_call); 
 
 	    /* If error, return the code */
 	    if (n < 0)

Changes

@@ -116,3 +116,11 @@
 
   * Fix Call interface to work with 5.003_94
 
+
+1.13 Monday 29th December 1997
+----
+
+  * added the order test harness.
+
+  * patch from Gurusamy Sarathy to get the filters to build and pass
+    all tests on NT.

Exec/Exec.xs

@@ -31,6 +31,133 @@ static int fdebug = 0 ;
 
 #define BLOCKSIZE       100
 
+#ifdef WIN32
+
+static int write_started = 0;
+static int pipe_pid = 0;
+
+typedef struct {
+    SV *	sv;
+    int		idx;
+} thrarg;
+
+static void
+pipe_write(args)
+void *args ;
+{
+    thrarg *targ = (thrarg *)args;
+    SV *sv = targ->sv;
+    int idx = targ->idx;
+    int    pipe_in  = PIPE_IN(sv) ;
+    int    pipe_out = PIPE_OUT(sv) ;
+    int rawread_eof = 0;
+    int r,w,len;
+    free(args);
+    for(;;)
+    {       
+
+        /* get some raw data to stuff down the pipe */
+	/* But only when BUF_SV is empty */
+        if (!rawread_eof && BUF_NEXT(sv) >= BUF_END(sv)) {       
+	    /* empty BUF_SV */
+	    SvCUR_set((SV*)BUF_SV(sv), 0) ;
+            if ((len = FILTER_READ(idx+1, (SV*) BUF_SV(sv), 0)) > 0) {
+		BUF_NEXT(sv) = BUF_START(sv);
+                if (fdebug)
+                    warn ("*pipe_read(%d) Filt Rd returned %d %d [%*s]\n", 
+			idx, len, BUF_SIZE(sv), BUF_SIZE(sv), BUF_START(sv)) ;
+	     }
+             else {
+                /* eof, close write end of pipe after writing to it */
+		 rawread_eof = 1;
+	     }
+	}
+
+ 	/* write down the pipe */
+        if ((w = BUF_END(sv) - BUF_NEXT(sv)) > 0) {
+	    errno = 0;
+            if ((w = write(pipe_out, BUF_NEXT(sv), w)) > 0) {
+		BUF_NEXT(sv) += w;
+		if (fdebug)
+		    warn ("*pipe_read(%d) wrote %d bytes to pipe\n", idx, w) ;
+	    }
+            else {
+                if (fdebug)
+                   warn ("*pipe_read(%d) closing pipe_out errno = %d %s\n", 
+			idx, errno, Strerror(errno)) ;
+                close(pipe_out) ;
+		CloseHandle((HANDLE)pipe_pid);
+		write_started = 0;
+		return;
+	    }
+	}
+	else if (rawread_eof) {
+	    close(pipe_out);
+	    CloseHandle((HANDLE)pipe_pid);
+	    write_started = 0;
+	    return;
+	}
+    }
+}
+
+static int
+pipe_read(sv, idx, maxlen)
+SV  * sv ;
+int idx ;
+int maxlen ;
+{
+    int    pipe_in  = PIPE_IN(sv) ;
+    int    pipe_out = PIPE_OUT(sv) ;
+
+    int r ;
+    int w ;
+    int len ;
+
+    if (fdebug)
+        warn ("*PIPE_READ(sv=%d, SvCUR(sv)=%d, idx=%d, maxlen=%d\n",
+		sv, SvCUR(sv), idx, maxlen) ;
+
+    if (!maxlen)
+	maxlen = 1024 ;
+
+    /* just make sure the SV is big enough */
+    SvGROW(sv, SvCUR(sv) + maxlen) ;
+
+    if ( !BUF_NEXT(sv) )
+        BUF_NEXT(sv) = BUF_START(sv);
+
+    if (!write_started) {
+	thrarg *targ = malloc(sizeof(thrarg));
+	targ->sv = sv; targ->idx = idx;
+	/* thread handle is close when pipe_write() returns */
+	_beginthread(pipe_write,0,(void *)targ);
+	write_started = 1;
+    }
+
+    /* try to get data from filter, if any */
+    errno = 0;
+    len = SvCUR(sv) ;
+    if ((r = read(pipe_in, SvPVX(sv) + len, maxlen)) > 0)
+    {
+	if (fdebug)
+	    warn ("*pipe_read(%d) from pipe returned %d [%*s]\n", 
+			idx, r, r, SvPVX(sv) + len) ;
+	SvCUR_set(sv, r + len) ;
+	return SvCUR(sv);
+    }
+
+    if (fdebug)
+	warn ("*pipe_read(%d) returned %d, errno = %d %s\n", 
+		idx, r, errno, Strerror(errno)) ;
+
+    /* close the read pipe on error/eof */
+    if (fdebug)
+	warn("*pipe_read(%d) -- EOF <#########\n", idx) ;
+    close (pipe_in) ; 
+    return 0;
+}
+
+#else /* !WIN32 */
 
 
 static int
@@ -156,7 +283,7 @@ int  f;
                 RETVAL, errno) ;
 }
 
-
+#endif
 
 
 #define READER	0
@@ -170,6 +297,71 @@ char * parameters[] ;
 int  * p0 ;
 int  * p1 ;
 {
+#ifdef WIN32
+
+    int p[2], c[2];
+    SV * sv ;
+    int oldstdout, oldstdin;
+
+    /* create the pipes */
+    if (win32_pipe(p,512,O_TEXT|O_NOINHERIT) == -1
+	|| win32_pipe(c,512,O_BINARY|O_NOINHERIT) == -1) {
+	fclose( fil );
+	croak("Can't get pipe for %s", command);
+    }
+
+    /* duplicate stdout and stdin */
+    oldstdout = dup(fileno(stdout));
+    if (oldstdout == -1) {
+	fclose( fil );
+	croak("Can't dup stdout for %s", command);
+    }
+    oldstdin  = dup(fileno(stdin));
+    if (oldstdin == -1) {
+	fclose( fil );
+	croak("Can't dup stdin for %s", command);
+    }
+
+    /* duplicate inheritable ends as std handles for the child */
+    if (dup2(p[WRITER], fileno(stdout))) {
+	fclose( fil );
+	croak("Can't attach pipe to stdout for %s", command);
+    }
+    if (dup2(c[READER], fileno(stdin))) {
+	fclose( fil );
+	croak("Can't attach pipe to stdin for %s", command);
+    }
+
+    /* close original inheritable ends in parent */
+    close(p[WRITER]);
+    close(c[READER]);
+
+    /* spawn child process (which inherits the redirected std handles) */
+    pipe_pid = spawnvp(P_NOWAIT, command, parameters);
+    if (pipe_pid == -1) {
+	fclose( fil );
+	croak("Can't spawn %s", command);
+    }
+
+    /* restore std handles */
+    if (dup2(oldstdout, fileno(stdout))) {
+	fclose( fil );
+	croak("Can't restore stdout for %s", command);
+    }
+    if (dup2(oldstdin, fileno(stdin))) {
+	fclose( fil );
+	croak("Can't restore stdin for %s", command);
+    }
+
+    /* close saved handles */
+    close(oldstdout);
+    close(oldstdin);
+
+    *p0 = p[READER] ;
+    *p1 = c[WRITER] ;
+
+#else /* !WIN32 */
+
     int p[2], c[2];
     SV * sv ;
     int	pipepid;
@@ -233,6 +425,7 @@ int  * p1 ;
 
     *p0 = p[READER] ;
     *p1 = c[WRITER] ;
+#endif
 }
 
 

MANIFEST

@@ -35,6 +35,7 @@ t/call.t
 t/cpp.t
 t/decrypt.t
 t/exec.t
+t/order.t
 t/sh.t
 t/tee.t
 tee/Makefile.PL

Makefile.PL

@@ -4,7 +4,7 @@ require 5.002 ;
 
 WriteMakefile(
 	NAME      => 'Filter',
-	VERSION   => '1.12',
+	VERSION   => '1.13',
 	'linkext'   => {LINKTYPE => ''},
 	'dist'	  =>	{COMPRESS=>'gzip', SUFFIX=>'gz'},
 	) ;

README

@@ -1,8 +1,8 @@
                                  Source Filters
 
-                                  Version 1.09
+                                  Version 1.13
 
-                               22nd April 1996
+                                  29th Dec 1997
 
              Copyright (c) 1995,1996 Paul Marquess. All rights reserved.
          This program is free software; you can redistribute it and/or
@@ -41,11 +41,14 @@ The modules can now be built using this sequence of commands:
 The filters have been successfully built and tested on the following
 systems (at least):
 
-	SunOS 4.1.3 (Sun C compiler)
+	SunOS 4.1.3 (Sun C compiler & gcc 2.7.2.3)
 	Solaris 2.3 (Sun C Compiler)
 	irix 5.3	
 	irix 6.x	
+	Windows NT 4.0 (Visual C++ 5.0 and Borland C++ 5.02)
 
+GNU tr and GNU cpp must be installed somewhere on the path for the
+testsuite to pass successfully on Windows NT.
 
 INSTALLATION
 ------------

decrypt/encrypt

@@ -60,7 +60,7 @@ foreach $file (@ARGV)
     rename ("${file}.pe", $file) 
 	or die "Could not rename $file.pe to $file: $!\n" ;
 
-    chmod $mode, $file ;
+    chmod $mode, $file unless $^O eq 'MSWin32' ;
 
     print "encrypted $file\n" ;
 }

lib/Filter/cpp.pm

@@ -12,13 +12,19 @@ sub import
 { 
     my($self, @args) = @_ ;
 
-    croak ("Cannot find cpp")
-	if $Config{'cppstdin'} eq '' ;
-
     #require "Filter/exec.pm" ;
-
-    Filter::Util::Exec::filter_add ($self, 'sh', '-c', 
+
+    if ($^O eq 'MSWin32') {
+        # assume GNU cpp is installed
+        Filter::Util::Exec::filter_add ($self, 'cmd', '/c', 
+		"cpp.exe 2>nul") ;
+    }
+    else {
+        croak ("Cannot find cpp")
+	    if $Config{'cppstdin'} eq '' ;
+        Filter::Util::Exec::filter_add ($self, 'sh', '-c', 
 		"$Config{'cppstdin'} $Config{'cppminus'} 2>/dev/null") ;
+    }
 }
 
 1 ;

lib/Filter/sh.pm

@@ -15,7 +15,12 @@ sub import
 
     #require "Filter/exec.pm" ;
     #Filter::exec::import ($self, 'sh', '-c', "@args") ; 
-    Filter::Util::Exec::filter_add ($self, 'sh', '-c', "@args") ; 
+    if ($^O eq 'MSWin32') {
+        Filter::Util::Exec::filter_add ($self, 'cmd', '/c', "@args") ; 
+    }
+    else {
+        Filter::Util::Exec::filter_add ($self, 'sh', '-c', "@args") ; 
+    }
 }
 
 1 ;

t/call.t

@@ -1,4 +1,3 @@
-
 require "util" ;
 use Cwd ;
 $here = getcwd ;
@@ -35,7 +34,7 @@ sub import { filter_add(bless []) }
 EOM
 
 $a = `$Perl -I. $Inc -e "use ${module} ;"  2>&1` ;
-ok(1, ($? >>8) != 0) ;
+ok(1, (($? >>8) != 0 or ($^O eq 'MSWin32' && $? != 0))) ;
 ok(2, $a =~ /^Can't locate object method "filter" via package "MyTest"/) ;
 
 # no reference parameter in filter_add
@@ -52,7 +51,7 @@ sub import { filter_add() }
 EOM
 
 $a = `$Perl -I. $Inc -e "use ${module} ;"  2>&1` ;
-ok(3, ($? >>8) != 0) ;
+ok(3, (($? >>8) != 0 or ($^O eq 'MSWin32' && $? != 0))) ;
 #ok(4, $a =~ /^usage: filter_add\(ref\) at ${module}.pm/) ;
 ok(4, $a =~ /^Not enough arguments for Filter::Util::Call::filter_add/) ;
 

t/cpp.t

@@ -37,6 +37,7 @@ $a = `$Perl $Inc $cpp_script 2>&1` ;
 
 print "1..2\n" ;
 ok(1, ($? >>8) == 0) ;
+#print "|$a| vs |$expected_output|\n";
 ok(2, $a eq $expected_output) ;
 
 unlink $cpp_script ;