From 937b367d393d2f47eca488c9413d9e139fc7d431 Mon Sep 17 00:00:00 2001
From: Nicholas Clark <nick@ccl4.org>
Date: Sat, 15 Apr 2006 18:05:12 +0000
Subject: [PATCH] If the downstream caller wants block mode, and we're in line
 mode, then don't return more bytes than they asked for. Hold bytes over until
 next time if necessary.

p4raw-id: //depot/perl@27816
---
 pp_ctl.c         | 62 ++++++++++++++++++++++++++++++++++++++++++++++++--------
 t/op/incfilter.t | 40 +++++++++++++++++++++++++++++++++---
 2 files changed, 90 insertions(+), 12 deletions(-)

diff --git a/pp_ctl.c b/pp_ctl.c
index 2c36b59..7ea62e5 100644
--- a/pp_ctl.c
+++ b/pp_ctl.c
@@ -4516,7 +4516,6 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
     dVAR;
     SV * const datasv = FILTER_DATA(idx);
     const int filter_has_file = IoLINES(datasv);
-    GV * const filter_child_proc = (GV *)IoFMT_GV(datasv);
     SV * const filter_state = (SV *)IoTOP_GV(datasv);
     SV * const filter_sub = (SV *)IoBOTTOM_GV(datasv);
     int len = 0;
@@ -4535,6 +4534,26 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
        for PL_error_count == 0.)  Solaris doesn't segfault --
        not sure where the trouble is yet.  XXX */
 
+    if (maxlen && IoFMT_GV(datasv)) {
+	SV *const cache = (SV *)IoFMT_GV(datasv);
+	if (SvOK(cache)) {
+	    STRLEN cache_len;
+	    const char *cache_p = SvPV(cache, cache_len);
+	    /* Running in block mode and we have some cached data already.  */
+	    if (cache_len >= maxlen) {
+		/* In fact, so much data we don't even need to call
+		   filter_read.  */
+		sv_catpvn(buf_sv, cache_p, maxlen);
+		sv_chop(cache, cache_p + maxlen);
+		/* Definately not EOF  */
+		return 1;
+	    }
+	    sv_catsv(buf_sv, cache);
+	    maxlen -= cache_len;
+	    SvOK_off(cache);
+	}
+    }
+	
     if (filter_has_file) {
 	len = FILTER_READ(idx+1, upstream, maxlen);
     }
@@ -4570,12 +4589,41 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 	LEAVE;
     }
 
+    if (maxlen) {
+	/* Running in block mode.  */
+	STRLEN got_len;
+	const char *got_p = SvPV(upstream, got_len);
+
+	if (got_len > maxlen) {
+	    /* Oh. Too long. Stuff some in our cache.  */
+	    SV *cache = (SV *)IoFMT_GV(datasv);
+
+	    if (!cache) {
+		IoFMT_GV(datasv) = (GV*) (cache = newSV(got_len - maxlen));
+	    } else if (SvOK(cache)) {
+		/* Cache should be empty.  */
+		assert(!SvCUR(cache));
+	    }
+
+	    sv_setpvn(cache, got_p + maxlen, got_len - maxlen);
+	    /* If you ask for block mode, you may well split UTF-8 characters.
+	       "If it breaks, you get to keep both parts"
+	       (Your code is broken if you  don't put them back together again
+	       before something notices.) */
+	    if (SvUTF8(upstream)) {
+		SvUTF8_on(cache);
+	    }
+	    SvCUR_set(upstream, maxlen);
+	}
+    }
+
+    if (upstream != buf_sv) {
+	sv_catsv(buf_sv, upstream);
+    }
+
     if (len <= 0) {
 	IoLINES(datasv) = 0;
-	if (filter_child_proc) {
-	    SvREFCNT_dec(filter_child_proc);
-	    IoFMT_GV(datasv) = NULL;
-	}
+	SvREFCNT_dec(IoFMT_GV(datasv));
 	if (filter_state) {
 	    SvREFCNT_dec(filter_state);
 	    IoTOP_GV(datasv) = NULL;
@@ -4586,10 +4634,6 @@ S_run_user_filter(pTHX_ int idx, SV *buf_sv, int maxlen)
 	}
 	filter_del(S_run_user_filter);
     }
-
-    if (upstream != buf_sv) {
-	sv_catsv(buf_sv, upstream);
-    }
     return len;
 }
 
diff --git a/t/op/incfilter.t b/t/op/incfilter.t
index 2ca4704..650aa15 100644
--- a/t/op/incfilter.t
+++ b/t/op/incfilter.t
@@ -14,7 +14,7 @@ BEGIN {
 use strict;
 use Filter::Util::Call;
 
-plan(tests => 19);
+plan(tests => 108);
 
 unshift @INC, sub {
     no warnings 'uninitialized';
@@ -103,8 +103,6 @@ sub prepend_rot13_filter {
 		   my $test = "fzrt!";
 		   $_ = $test;
 		   my $status = filter_read();
-		   # Sadly, doing this inside the source filter causes an
-		   # infinte loop
 		   my $got = substr $_, 0, length $test, '';
 		   is $got, $test, "Upstream didn't alter existing data";
 		   tr/A-Za-z/N-ZA-Mn-za-m/;
@@ -120,3 +118,39 @@ pass("This will rot13'ed twice");
 EOC
 
 do [$fh, sub {tr/A-Za-z/N-ZA-Mn-za-m/; return;}] or die;
+
+# This generates a heck of a lot of oks, but I think it's necessary.
+my $amount = 1;
+sub prepend_block_counting_filter {
+    filter_add(sub {
+		   my $output = defined $_ ? $_ : '';
+		   my $count = 256;
+		   while (--$count) {
+		       $_ = '';
+		       my $status = filter_read($amount);
+		       cmp_ok (length $_, '<=', $amount, "block mode works?");
+		       $output .= $_;
+		       if ($status <= 0 or /\n/s) {
+			   $_ = $output;
+			   return $status;
+		       }
+		   }
+		   die "Looping infinitely";
+			  
+	       })
+}
+
+open $fh, "<", \<<'EOC';
+BEGIN {prepend_block_counting_filter};
+pass("one by one");
+pass("and again");
+EOC
+
+do [$fh, sub {return;}] or die;
+
+open $fh, "<", \<<'EOC';
+BEGIN {prepend_block_counting_filter};
+pas("SSS make s fast SSS");
+EOC
+
+do [$fh, sub {s/s/ss/gs; s/([\nS])/$1$1$1/gs; return;}] or die;
-- 
2.7.4