如何获取用户可配置的打印缓冲区？

Question

我想要一个支持用户可配置缓冲区的打印功能，因此只有在缓冲区大于阈值时才打印缓冲区中的内容。

我需要编写多个文件，所以我有多个文件句柄要写入，为此，面向对象的模块可能更方便。

我想像这样：

my $printer1 = Print::Buffer->new({ size => 1000, filehandle => \$OUT1 });

for (my $i=1; $i<1000; $i++) {
 $printer1->print("This string will be eventually printed ($i/1000)");
}
# and at the end print the remaining buffer
$printer1->flush();

有什么推荐吗？我可能没有使用正确的关键字，因为我在 CPAN 中没有找到明确的匹配项。

更新： 感谢大家提供非常有用的 cmets。正如你们中的一些人所指出的，这个问题比我最初想象的要复杂，而且可能是个坏主意。 （当我在每次循环迭代时使用打印语句打印非常大的文件 [>100Gb] 时出现了这个问题，并指出如果我打印每百次迭代我有一个加速，但这可能取决于循环的方式变了……）

更新 2： 我需要/想要接受答案。对我来说，两者都很有启发性，而且都很有用。我对两者都进行了测试，它们都需要进一步的工作才能对改进进行基准测试（如果有的话，请参阅上面的更新）。 tie 句柄是我喜欢的一个鲜为人知的功能，这就是我接受它的原因。在我看来，它们都同样接近预期的答案。非常感谢大家的讨论和见解。

Answer 1

我想要一个支持用户可配置缓冲区的打印功能，[...]
我想像这样：[...]

写这样的东西并不难。这是一个基本草图

文件PrintBuffer.pm

package PrintBuffer;

use warnings;
use strict;

sub new { 
    my ($class, %args) = @_; 
    my $self = { 
        _size => $args{size}       // 64*1024,            #//
        _fh   => $args{filehandle} // *STDOUT,
        _buf  => ''
    };  
    $self->{_fh}->autoflush;  # want it out once it's printed
    bless $self, $class;
}

sub print {
    my ($self, $string) = @_; 
    $self->{_buf} .= $string;
    if ( length($self->{_buf}) > $self->{_size} ) { 
        print { $self->{_fh} } $self->{_buf};
        $self->{_buf} = ''; 
    }
    return $self;
}

sub DESTROY {
    my $self = shift;
    print { $self->{_fh} } $self->{_buf}  if $self->{_buf} ne ''; 
    $self->{_buf} = ''; 
}

1;

这里还有很多事情要做，还有很多可以添加的，因为它只依赖于可以根据需要添加/更改的基本工具。^†其中之一，我可以想象一个 size 方法来操作现有对象的缓冲区大小（如果数据已经超过新大小，则打印）和 flush。

请注意，DESTROY 方法提供了在对象退出任何范围并被销毁时打印的缓冲区，这似乎是合理的做法。

司机

use warnings;
use strict;
use feature 'say';

use PrintBuffer;

my $fout = shift // die "Usage: $0 out-file\n";

open my $fh, '>', $fout  or die "Can't open $fout: $!";

my $obj_file   = PrintBuffer->new(size => 100, filehandle => $fh);
my $obj_stdout = PrintBuffer->new(size => 100);

$obj_file->print('a little bit');
$obj_stdout->print('a little bit');
say "printed 'a little bit' ..."; sleep 10;

$obj_file->print('out'x30);                 # push it over a 100 chars
$obj_stdout->print('out'x30);
say "printed 'out'x30 ... "; sleep 10;

$obj_file->print('again...');               # check  DESTROY
$obj_stdout->print('again');
say "printed 'again' (and we're done)";

每次打印信息后，在另一个终端中检查输出文件的大小。

我尝试了 Grinnz 在评论中提出的PerlIO::buffersize，它似乎像他们所说的那样“像宣传的那样”工作。它不允许你做你想做的所有事情，但它可能是满足基本需求的现成解决方案。请注意，这不适用于正在使用的 :encoding 层。

感谢 ikegami 提供的 cmets 和测试（链接在 cmets 中）。

---

^†print 与 autoflush-ed 句柄一起使用。不过，第一个更改可能是改用syswrite，它是无缓冲的，并尝试通过一个write(2) 调用直接写入所有要求的内容。但由于无法保证所有内容都已写好，我们还需要检查

use Carp;  # for croak

WRITE: {
    my $bytes_written = 0;
    while ( $bytes_written < length $self->{_buf} ) {
        my $rv = syswrite( 
            $self->{_fh}, 
            $self->{_buf}, 
            length($self->{_buf}) - $bytes_written,
            $bytes_written
        );
        croak "Error writing: $!" if not defined $rv;
        $bytes_written += $rv;
    }
    $self->{_buf} = '';
};

我把它放在一个块中只是为了限制$bytes_written 的范围以及人们可能希望引入的任何其他变量以减少$self 的取消引用次数（但请注意$self->{_buf} 可能是相当大，复制它以“优化”取消引用可能最终会变慢）。

天真地我们只需要syswrite(FH, SCALAR)，但如果不是所有SCALAR都被写入，那么我们需要从过去的内容继续写入，因此需要使用带有长度写入的表单和偏移量。

由于这是无缓冲的，它不能与缓冲的 IO 混合（或者需要非常小心地完成）；请参阅文档。此外，:encoding 层不能与它一起使用。考虑针对此类可能需要的其他功能的这些限制。

Answer 2

我也没有看到关于 CPAN 的通用解决方案。但这对于绑定的文件句柄来说很简单。类似的东西

use Symbol;
sub Print::Buffer::new {
    my ($class,$mode,$file,@opts) = @_;
    my $x = Symbol::gensym;
    open ($x, $mode, $file) or die "failed to open '$file': $!";
    tie *$x, "Print::Buffer", fh => $fh, @opts;
    $x;
}

sub Print::Buffer::TIEHANDLE {
    my $pkg = shift;
    my $self = { @_ };
    $self->{bufsize} //= 16 * 1024 * 1024;
    $self->{_buffer} = "";
    bless $self, $pkg;
}

sub Print::Buffer::PRINT {
    my ($self,@msg) = @_;
    $self->{buffer} .= join($,,@msg);
    $self->_FLUSH if length($self->{buffer}) > $self->{bufsize};
}

sub Print::Buffer::_FLUSH {
    my $self = shift;
    print  {$self->{fh}}  $self->{buffer};
    $self->{buffer} = "";
}

sub Print::Buffer::CLOSE {
    my $self = shift;
    $self->_FLUSH;
    close( $self->{fh} );
}

sub Print::Buffer::DESTROY {
    my $self = shift;
    $self->_FLUSH;
}

#  ----------------------------------------

my $fh1 = Print::Buffer->new(">", "/tmp/file1", 
                             bufsize => 16*1024*1024);

for (my $i=1; $i<1000; $i++) {
    print $fh1 "This string will be eventually printed ($i/1000)\n";
}