Подтвердить что ты не робот

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

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

{
    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";

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

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

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

4b9b3361

Ответ 1

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

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

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);

Ответ 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

Ответ 3

Мне пришло в голову два возможных решения:

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

@DVK - это сделать 1.

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

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

Ответ 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;

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

Он работает, но он имеет недостатки:

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

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

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

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

Ответ 5

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