Как поделиться объектом, который содержит файловый дескриптор?

Question

Потоки Perl не поддерживают совместное использование файловых дескрипторов. Все элементы общей структуры данных должны быть общими. Это создает проблему, если нужно совместно использовать объект, который содержит файловый дескриптор.

{
    package Foo;
    use Mouse;

    has fh =>
      is      => 'rw',
      default => sub { \*STDOUT };
}

use threads;
use threads::shared;
my $obj = Foo->new;
$obj = shared_clone($obj);           # error: "Unsupported ref type: GLOB"
print {$obj->fh} "Hello, world!\n";

На самом деле не имеет значения, является ли файловый дескриптор «общим» или нет, он используется только для вывода. Возможно, есть хитрость, когда файловый дескриптор хранится вне общего объекта?

Этот объект фактически содержится в другом общем объекте, который находится в другом и так далее. Главная ирония в том, что рассматриваемые объекты никогда не используют сами потоки, но должны оставаться скоординированными по всему процессу, если пользователь использует потоки.

Реальный код, о котором идет речь , можно увидеть здесь : Эти объекты используются для конфигурирования, куда идет форматированный вывод. Объект необходим, потому что вывод не всегда идет в дескриптор файла .

Answer 1

В данный момент у меня нет доступа к многопоточному Perl, поэтому я не могу гарантировать, что это будет работать.

Но несколько упрощенным подходом было бы использование уровня абстракции и сохранение ключа / индекса в глобальном хеше / массиве файловых дескрипторов в объекте, что-то вроде следующего:

my @filehandles = (); # Stores all the filehandles         ### CHANGED

my $stdout; # Store the index into @filehandles, NOT filehandle.
            # Should really be renamed "$stdout_id" instead.

sub stdout {
    my $self = shift;

    return $stdout if defined $stdout;

    $stdout = scalar(@filehandles);                         ### CHANGED
    my $stdout_fh = $self->dup_filehandle(\*STDOUT);        ### CHANGED
    push @filehandles, $stdout_fh;                          ### CHANGED

    $self->autoflush($stdout_fh);                           ### CHANGED
    $self->autoflush(\*STDOUT);

    return $stdout;
}

sub safe_print {
    my $self = shift;
    my $fh_id = shift;                                       ### CHANGED
    my $fh = $filehandles[$fh_id];                           ### CHANGED

    local( $\, $, ) = ( undef, '' );
    print $fh @_; 
}

У меня есть сильное чувство, что вам нужно каким-то образом поточно-ориентировать список идентификаторов, поэтому, возможно, вместо $stdout = scalar(@filehandles);

понадобится общий счетчик индекса

Answer 2

В качестве альтернативы моему другому ответу с глобальным массивом, есть еще один подход от Perlmonks:

http://perlmonks.org/?node_id=395513

Он работает, фактически сохраняя fileno (дескриптор файла) дескриптора файла.Вот его пример кода, основанный на том, что опубликовал BrowserUk:

my $stdout; # Store the fileno, NOT filehandle.
            # Should really be renamed "$stdout_fileno" instead.

sub stdout {
    my $self = shift;

    return $stdout if defined $stdout;

    my $stdout_fh = $self->dup_filehandle(\*STDOUT);        ### CHANGED
    $stdout = fileno $stdout_fh;                            ### CHANGED

    $self->autoflush($stdout_fh);                           ### CHANGED
    $self->autoflush(\*STDOUT);

    return $stdout;
}

sub safe_print {
    my $self = shift;
    my $fh_id = shift;                                       ### CHANGED
    open(my $fh, ">>&=$fh_id")                                ### CHANGED
        || die "Error opening filehandle: $fh_id: $!\n";     ### CHANGED

    local( $\, $, ) = ( undef, '' );
    print $fh @_; 
}

CAVEAT - в 2004 году была ошибка, из-за которой вы не могли прочитать из общего дескриптора файла из> 1 потока.Я предполагаю, что письмо в порядке.Более подробная информация о том, как выполнять синхронизированные записи в общем файловом дескрипторе (из того же Monk): http://www.perlmonks.org/?node_id=807540

Answer 3

Мне только что пришло в голову, что есть два возможных решения:

1. Поместите дескриптор файла вне объекта Streamer.
2. Поместите объект Streamer вне средства форматирования.

@ Советы ДВК касаются выполнения 1.

Но 2 в некоторой степени проще, чем 1. Вместо того, чтобы держать сам объект Streamer, Formatter может содержать идентификатор для объекта Streamer. Если Streamer реализован наизнанку, это происходит естественно!

К сожалению, ссылочные адреса меняются между потоками, даже общими. Это можно решить с помощью Hash :: Util :: FieldHash , но это 5.10, и я должен поддерживать 5.8. Возможно, что-то можно собрать, используя CLONE .

Answer 4

Вот что я завел ...

package ThreadSafeFilehandle;

use Mouse;
use Mouse::Util::TypeConstraints;

my %Filehandle_Storage;    # unshared storage of filehandles
my $Storage_Counter = 1;   # a counter to use as a key

# This "type" exists to intercept incoming filehandles.
# The filehandle goes into %Filehandle_Storage and the
# object gets the key.
subtype 'FilehandleKey' =>
  as 'Int';
coerce 'FilehandleKey' =>
  from 'Defined',
  via {
      my $key = $Storage_Counter++;
      $Filehandle_Storage{$key} = $_;
      return $key;
  };

has thread_safe_fh =>
  is            => 'rw',
  isa           => 'FilehandleKey',
  coerce        => 1,
;

# This converts the stored key back into a filehandle upon getting.
around thread_safe_fh => sub {
    my $orig = shift;
    my $self = shift;

    if( @_ ) {                  # setting
        return $self->$orig(@_);
    }
    else {                      # getting
        my $key = $self->$orig;
        return $Filehandle_Storage{$key};
    }
};

1;

Использование приведения типов гарантирует, что перевод из файлового дескриптора в ключ происходит даже в конструкторе объектов.

Работает, но есть недостатки:

Каждый объект сохраняет свой дескриптор файла с избыточностью. Если все объекты хранят один и тот же файловый дескриптор, они, вероятно, могут просто сохранить его один раз. Хитрость заключается в том, как идентифицировать один и тот же файловый дескриптор. fileno или refaddr - это варианты.

Файловый дескриптор не удаляется из% Filehandle_Storage при удалении объекта. Первоначально я использовал для этого метод DESTROY, но так как идиома клонирования объекта - это $clone = shared_clone($obj), дескриптор файла клона $ удаляется, когда $ obj выходит из области видимости.

Изменения, которые происходят у детей, не передаются.

Это все приемлемо для моих целей, которые будут создавать только несколько таких объектов на процесс.

Answer 5

Опять же, можно использовать https://metacpan.org/module/Coro, если у человека нет аллергической реакции на его тролдок.