Как получить настраиваемый пользователем буфер для печати?

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.

ОБНОВЛЕНИЕ: Спасибо всем за очень полезные комментарии. Как некоторые из вас отмечали, проблема более сложная, чем я думал, и, вероятно, плохая идея. (Этот вопрос возник, когда я печатал очень большие файлы [> 100 ГБ] с оператором print на каждой итерации l oop, и отметил, что, если бы я печатал каждую более длинную итерацию, у меня было ускорение, но это могло зависеть от того, как l oop было изменено ...)

ОБНОВЛЕНИЕ 2: Мне нужно / хочу принять ответ. Для меня оба были поучительны, и они оба полезны. Я протестировал оба, и им обоим нужна дополнительная работа, прежде чем они смогут оценить улучшение (если есть, см. Обновление выше). Ручка t ie - менее известная особенность, которая мне очень понравилась, поэтому я принял это. Они оба были одинаково близки к желаемому ответу на мой взгляд. Большое спасибо всем за обсуждение и понимание.

Answer 1

Я хотел бы иметь функцию печати, поддерживающую настраиваемый пользователем буфер, [...]
Я представляю что-то вроде этого: [...]

Не сложно написать что-то подобное. Вот базовый c набросок

Файл 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;

Здесь есть еще кое-что, что можно добавить, и поскольку оно опирается только на c инструменты, которые можно добавлять / изменять по своему усмотрению. ^† Для одного я могу представить 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)";

Проверяйте размер выходного файла в другом терминале после каждого информационного отпечатка.

Я попробовал PerlIO :: buffersize , который поднял Гриннц в комментарии, и кажется, что он работает "как рекламируется", как они говорят. Он не позволяет вам делать все возможное с sh, но может быть готовым решением для базовых c нужд. Обратите внимание, что это не работает с используемым слоем :encoding.

Спасибо ikegami за комментарии и тесты (ссылки в комментариях).

---

^† print работает с ручкой autoflush. Тем не менее, первое изменение может заключаться в использовании вместо этого 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 и любых других переменных, которые могут быть wi sh ввести так, чтобы уменьшить количество разыменований $self (но учтите, что $self->{_buf} может быть довольно большим, и копирование его "для оптимизации" разыменования может закончиться медленнее).

Наивно мы бы только нужно syswrite(FH, SCALAR), но если случится так, что не все из SCALAR будут записаны, тогда нам нужно продолжать писать из прошлого того, что было написано, таким образом, необходимо использовать форму с длиной записи и смещением.

Поскольку это небуферизованное, его нельзя смешивать с буферизованным вводом-выводом (или это нужно делать очень осторожно); смотри документы. Кроме того, :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";
}