Re^3: Configurable IO buffersize?

Ok, now I've tested it, it works, the concept is proved, but there are some issues, like using :raw causes PerlIO to croak -- probably something about XS I'm doing wrong :)

diff -ruN IO-1.25/crap.txt IO-1.25-setbuf/crap.txt
--- IO-1.25/crap.txt    1969-12-31 16:00:00.000000000 -0800
+++ IO-1.25-setbuf/crap.txt    2011-08-02 03:57:02.593750000 -0700
@@ -0,0 +1,146 @@
+#!/usr/bin/perl --
+use blib;
+use IO::Handle ;
+use 5.10.0;
+Main( @ARGV );
+exit( 0 );
+
+sub Main {
+    Fudge( __FILE__ , ':utf8', 666 );
+    Fudge( __FILE__ , ':utf8', 6666 );
+    Fudge( __FILE__ , ':raw', 6 );
+}
+sub Fudge {
+    say "\n\nFudge( @_ )";
+    my( $file , $mode, $max ) = @_;
+    open my($fh),'<'.$mode, $file or die $!;
+    One($fh,$_) for 1..3, 60,62,64,66, $max;
+    say "leng ", length scalar <$fh>; 
+    One($fh, $max + 642);
+    1 while <$fh>;
+    say "#### at eof ", $fh->input_line_number;
+    One($fh,$max + 642 );
+    say "seek => ", seek $fh, 0,0;
+    One($fh,$max + 642 );
+    say "leng ", length scalar <$fh>; 
+    One($fh,$max + 642 );
+    close $fh;
+}
+
+
+sub One{
+    my($fh, $d)=@_;
+    my($p,$f,$l ) = caller;
+    $d //= 666666;
+    say "$f:$l] get1 ", $fh->getbufsiz;
+    say "$f:$l] set($d)  ", $fh->setbuf('1' x $d );
+    say "$f:$l] get2 ", $fh->getbufsiz;
+}
+__END__
+
+
+
+
+Fudge( crap.txt :utf8 666 )
+crap.txt:17] get1 b->end(0) - b->buf (0) = b->bufsiz (0)
+crap.txt:17] set(1)
+crap.txt:17] get2 b->end(a722f4) - b->buf (a722f4) = b->bufsiz (4)
+crap.txt:17] get1 b->end(a722f4) - b->buf (a722f4) = b->bufsiz (4)
+crap.txt:17] set(2)
+crap.txt:17] get2 b->end(a7228c) - b->buf (a7228c) = b->bufsiz (4)
+crap.txt:17] get1 b->end(a7228c) - b->buf (a7228c) = b->bufsiz (4)
+crap.txt:17] set(3)
+crap.txt:17] get2 b->end(a72154) - b->buf (a72154) = b->bufsiz (4)
+crap.txt:17] get1 b->end(a72154) - b->buf (a72154) = b->bufsiz (4)
+crap.txt:17] set(60)
+crap.txt:17] get2 b->end(a7129c) - b->buf (a7129c) = b->bufsiz (64)
+crap.txt:17] get1 b->end(a7129c) - b->buf (a7129c) = b->bufsiz (64)
+crap.txt:17] set(62)
+crap.txt:17] get2 b->end(a712f4) - b->buf (a712f4) = b->bufsiz (64)
+crap.txt:17] get1 b->end(a712f4) - b->buf (a712f4) = b->bufsiz (64)
+crap.txt:17] set(64)
+crap.txt:17] get2 b->end(a7134c) - b->buf (a7134c) = b->bufsiz (68)
+crap.txt:17] get1 b->end(a7134c) - b->buf (a7134c) = b->bufsiz (68)
+crap.txt:17] set(66)
+crap.txt:17] get2 b->end(a713a4) - b->buf (a713a4) = b->bufsiz (68)
+crap.txt:17] get1 b->end(a713a4) - b->buf (a713a4) = b->bufsiz (68)
+crap.txt:17] set(666)
+crap.txt:17] get2 b->end(a716ac) - b->buf (a716ac) = b->bufsiz (668)
+leng 19
+crap.txt:19] get1 b->end(a71948) - b->buf (a716ac) = b->bufsiz (668)
+crap.txt:19] set(1308)
+crap.txt:19] get2 b->end(9bff9c) - b->buf (9bff9c) = b->bufsiz (1312)
+#### at eof 15
+crap.txt:22] get1 b->end(9bff9c) - b->buf (9bff9c) = b->bufsiz (1312)
+crap.txt:22] set(1308)
+crap.txt:22] get2 b->end(b3d02c) - b->buf (b3d02c) = b->bufsiz (1312)
+seek => 1
+crap.txt:24] get1 b->end(b3d02c) - b->buf (b3d02c) = b->bufsiz (1312)
+crap.txt:24] set(1308)
+crap.txt:24] get2 b->end(b3d564) - b->buf (b3d564) = b->bufsiz (1312)
+leng 19
+crap.txt:26] get1 b->end(b3d90b) - b->buf (b3d564) = b->bufsiz (1312)
+crap.txt:26] set(1308)
+crap.txt:26] get2 b->end(b3da9c) - b->buf (b3da9c) = b->bufsiz (1312)
+
+
+Fudge( crap.txt :utf8 6666 )
+crap.txt:17] get1 b->end(0) - b->buf (0) = b->bufsiz (0)
+crap.txt:17] set(1)
+crap.txt:17] get2 b->end(b3da9c) - b->buf (b3da9c) = b->bufsiz (1312)
+crap.txt:17] get1 b->end(b3da9c) - b->buf (b3da9c) = b->bufsiz (1312)
+crap.txt:17] set(2)
+crap.txt:17] get2 b->end(b3dfd4) - b->buf (b3dfd4) = b->bufsiz (1312)
+crap.txt:17] get1 b->end(b3dfd4) - b->buf (b3dfd4) = b->bufsiz (1312)
+crap.txt:17] set(3)
+crap.txt:17] get2 b->end(b3e50c) - b->buf (b3e50c) = b->bufsiz (1312)
+crap.txt:17] get1 b->end(b3e50c) - b->buf (b3e50c) = b->bufsiz (1312)
+crap.txt:17] set(60)
+crap.txt:17] get2 b->end(b3ea44) - b->buf (b3ea44) = b->bufsiz (1312)
+crap.txt:17] get1 b->end(b3ea44) - b->buf (b3ea44) = b->bufsiz (1312)
+crap.txt:17] set(62)
+crap.txt:17] get2 b->end(b3ef7c) - b->buf (b3ef7c) = b->bufsiz (1312)
+crap.txt:17] get1 b->end(b3ef7c) - b->buf (b3ef7c) = b->bufsiz (1312)
+crap.txt:17] set(64)
+crap.txt:17] get2 b->end(b3f4b4) - b->buf (b3f4b4) = b->bufsiz (1312)
+crap.txt:17] get1 b->end(b3f4b4) - b->buf (b3f4b4) = b->bufsiz (1312)
+crap.txt:17] set(66)
+crap.txt:17] get2 b->end(b3f9ec) - b->buf (b3f9ec) = b->bufsiz (1312)
+crap.txt:17] get1 b->end(b3f9ec) - b->buf (b3f9ec) = b->bufsiz (1312)
+crap.txt:17] set(6666)
+crap.txt:17] get2 b->end(b41944) - b->buf (b41944) = b->bufsiz (6668)
+leng 19
+crap.txt:19] get1 b->end(b41ceb) - b->buf (b41944) = b->bufsiz (6668)
+crap.txt:19] set(7308)
+crap.txt:19] get2 b->end(b4500c) - b->buf (b4500c) = b->bufsiz (7312)
+#### at eof 1
+crap.txt:22] get1 b->end(b4500c) - b->buf (b4500c) = b->bufsiz (7312)
+crap.txt:22] set(7308)
+crap.txt:22] get2 b->end(b46cb4) - b->buf (b46cb4) = b->bufsiz (7312)
+seek => 1
+crap.txt:24] get1 b->end(b46cb4) - b->buf (b46cb4) = b->bufsiz (7312)
+crap.txt:24] set(7308)
+crap.txt:24] get2 b->end(b4895c) - b->buf (b4895c) = b->bufsiz (7312)
+leng 19
+crap.txt:26] get1 b->end(b48d03) - b->buf (b4895c) = b->bufsiz (7312)
+crap.txt:26] set(7308)
+crap.txt:26] get2 b->end(b4a604) - b->buf (b4a604) = b->bufsiz (7312)
+
+
+Fudge( crap.txt :raw 6 )
+crap.txt:17] get1 b->end(8000) - b->buf (4) = b->bufsiz (4138228)
+crap.txt:17] set(1)
+Out of memory!
+refcnt_dec: fd 11838980 >= refcnt_size 16
+refcnt_dec: fd 11838980 >= refcnt_size 16
+
+
+
+
+refcnt_dec: fd %d%s
+refcnt: fd %d%s
+refcnt_inc: fd %d%s
+    (P) Perl's I/O implementation failed an internal consistency chec
+k. If you see this message, something is very wrong.
+
+
+
diff -ruN IO-1.25/IO.xs IO-1.25-setbuf/IO.xs
--- IO-1.25/IO.xs    2009-05-11 09:16:11.000000000 -0700
+++ IO-1.25-setbuf/IO.xs    2011-08-02 03:48:06.078125000 -0700
@@ -12,6 +12,10 @@
 #include "perl.h"
 #include "XSUB.h"
 #include "poll.h"
+
+#include "perlio.h"
+#include "perliol.h"
+
 #ifdef I_UNISTD
 #  include <unistd.h>
 #endif
@@ -376,20 +380,58 @@
     RETVAL
 
 void
-setbuf(handle, ...)
-    OutputStream    handle
+fsetbuf(handle, ...)
+    InputStream     handle
     CODE:
+        if (items != 2 ){
+            Perl_croak(aTHX_ "Usage: IO::Handle::setvbuf(handle, buf)
+");
+        }
+    
     if (handle)
 #ifdef PERLIO_IS_STDIO
-        {
+    {
         char *buf = items == 2 && SvPOK(ST(1)) ?
           sv_grow(ST(1), BUFSIZ) : 0;
         setbuf(handle, buf);
     }
 #else
-        not_here("IO::Handle::setbuf");
+    {    /* not_here("IO::Handle::setbuf"); */
+        
+        PerlIOBuf * const b = PerlIOSelf( handle, PerlIOBuf);
+        PERL_UNUSED_CONTEXT;
+        if(items == 2 && SvPOK(ST(1)) )
+        {
+            PerlIO_debug("IO::Handle::setbuf %s %d\n", handle, SvLEN(
+ST(1)) );
+            b->bufsiz = SvLEN(ST(1));
+            Newxz(b->buf, b->bufsiz , STDCHAR);
+
+            if (!b->buf) {
+                b->buf = (STDCHAR *) & b->oneword;
+                b->bufsiz = sizeof(b->oneword);
+            }
+            b->end = b->ptr = b->buf;
+        }
+    }
 #endif
 
+
+
+    
+SV*
+fgetbufsiz(handle)
+    InputStream     handle
+CODE:
+    if(handle)
+    {
+        PerlIOBuf * const b = PerlIOSelf( handle, PerlIOBuf);
+        PERL_UNUSED_CONTEXT;
+        RETVAL = newSVpvf("b->end(%p) - b->buf (%p) = b->bufsiz (%u) 
+", b->end , b->buf, b->bufsiz );
+    }
+OUTPUT:
+    RETVAL
+    
+
+
 SysRet
 setvbuf(...)
     CODE:
[download]

I used ->getbufsiz to test if ->setbuf had effect, because Devel::Peek/Data::Peek was no help with handles, and trying to parse perliol.h with Convert::Binary::C wasn't happening

This definitely needs official support

Cheers

Comment on Re^3: Configurable IO buffersize? Download Code

Replies are listed 'Best First'.
Re^4: Configurable IO buffersize? by Anonymous Monk on Aug 02, 2011 at 13:44 UTC
Some more testing, none of these behave like :raw, they seem to "work" `Fudge( __FILE__ , ':raw:perlio:encoding(UTF-16LE):crlf', 6 ); Fudge( __FILE__ , ':raw:perlio:encoding(UTF-16LE):utf8', 6 ); Fudge( __FILE__ , ':raw:perlio', 7666 ); Fudge( __FILE__ , ':raw:win32', 6 ); Fudge( __FILE__ , ':win32', 6 );` [download] Though now its obvious that the :raw issue is probably pointer arithmetic related (and/or related to Chicanery Needed to Handle Unicode Text on Microsoft Windows) It remains, that setting a lower length than previous buffer length, doesn't change the length, only setting a higher one changes it I reiterate, this definitely needs official support :)	[reply] [d/l]
Re^4: Configurable IO buffersize? by BrowserUk (Patriarch) on Aug 02, 2011 at 11:21 UTC
here are some issues, like using :raw causes PerlIO to croak Doesn't `:raw` disable buffering? Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error. "Science is about questioning the status quo. Questioning authority". In the absence of evidence, opinion is indistinguishable from prejudice.	[reply] [d/l]
Re^5: Configurable IO buffersize? by Anonymous Monk on Aug 02, 2011 at 12:27 UTC
Doesn't :raw disable buffering? http://search.cpan.org/~jesse/perl-5.14.1/lib/PerlIO.pm#:raw says no, The stream will still be buffered, just like with binmode	[reply]