如何共享包含文件句柄的对象？

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

如果文件句柄是“共享”或不是，它只是用于输出。也许有一个把文件句柄存储在共享对象之外的技巧？

该对象实际上包含在另一个共享对象中，该对象位于另一个共享对象中，等等。最大的讽刺之处在于，所讨论的对象从不自己使用线程，但如果用户使用线程，则必须在整个过程中保持协调。

问题can be seen here的实际代码：这些对象用于配置格式化输出的位置。一个对象是必需的，因为output does not always go to a filehandle。

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 @_; 
} 

我有一个强烈的感觉，你需要以某种方式也是线程安全的ID列表，所以也许需要一个共享的索引计数器，而不是$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 @_; 
} 

警告 - 截至2004年，这个有一个bug，你不能从> 1个线程共享的文件句柄读。我猜测写作是好的。如何做一个共享的文件句柄同步写入（来自同一个和尚）更多细节：http://www.perlmonks.org/?node_id=807540

Answer 3

它只是发生在我身上有两个可能的解决方案：

1. 把文件句柄的流光对象之外。
2. 将Streamer对象放在Formatter外部。

@ DVK的建议都是关于做1

但2是简单大于1而不是拿着流光对象本身的一些方式，格式化可容纳的标识符到数据流对象。如果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超出了作用域，所以$ clone的文件句柄被抛弃。

儿童发生的变化不共享。

这些都可以用于我的目的，它只会在每个过程中创建一些这些对象。

Answer 5

然后再次，如果一个人没有对其trolldocs有过敏反应，可以使用https://metacpan.org/module/Coro。