How to share an object which contains a filehandle?

Question

Perl threads do not support sharing filehandles. All the elements of a shared data structure must be shared. This presents a problem if one needs to share an object which contains a filehandle.

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

It really doesn't matter if the filehandle is "shared" or not, it's only used for output. Perhaps there is a trick where the filehandle is stored outside the shared object?

This object is actually contained in another shared object which is in another and so on. The grand irony is the objects in question never use threads themselves, but must remain coordinated across the process if the user uses threads.

The real code in question can be seen here: These objects are used to configure where formatted output goes. An object is necessary because output does not always go to a filehandle.

Answer 1

I don't have access to threaded Perl at the moment, so can't guarantee that this will work.

But a somewhat simplistic approach would be to use a level of abstraction and store a key/index into a global filehandle hash/array into the object, something similar to the following:

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

I have a strong feeling that you would need to somehow also thread-safe the list of IDs, so perhaps an shared index counter would be needed instead of $stdout = scalar(@filehandles);