Permalink
Browse files

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
  • Loading branch information...
1 parent 33f73a1 commit 45821d832511469e4626e973ba499866202e3195 Paul Marquess committed with schwern Dec 29, 1997
Showing with 320 additions and 17 deletions.
  1. +1 −1 Call/Call.pm
  2. +1 −1 Call/Call.xs
  3. +8 −0 Changes
  4. +194 −1 Exec/Exec.xs
  5. +1 −0 MANIFEST
  6. +1 −1 Makefile.PL
  7. +6 −3 README
  8. +1 −1 decrypt/encrypt
  9. +11 −5 lib/Filter/cpp.pm
  10. +6 −1 lib/Filter/sh.pm
  11. +2 −3 t/call.t
  12. +1 −0 t/cpp.t
  13. +13 −0 t/exec.t
  14. +61 −0 t/order.t
  15. +13 −0 t/sh.t
View
@@ -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 ;
View
@@ -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)
View
@@ -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.
View
@@ -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
}
View
@@ -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
View
@@ -4,7 +4,7 @@ require 5.002 ;
WriteMakefile(
NAME => 'Filter',
- VERSION => '1.12',
+ VERSION => '1.13',
'linkext' => {LINKTYPE => ''},
'dist' => {COMPRESS=>'gzip', SUFFIX=>'gz'},
) ;
View
@@ -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
------------
View
@@ -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" ;
}
View
@@ -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 ;
View
@@ -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 ;
View
@@ -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/) ;
View
@@ -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 ;
Oops, something went wrong.

0 comments on commit 45821d8

Please sign in to comment.