How to share an object which contains a filehandle? - multithreading

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

Answer 2

As an alternative to my other answer with global array, here's another approach from Perlmonks:
http://perlmonks.org/?node_id=395513
It works by actually storing fileno (file descriptor) of the filehandle. Here's his sample code based on what BrowserUk posted:
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 - as of 2004, this had a bug where you couldn't read from the shared filehandle from >1 thread. I am guessing that writing is OK. More specifics on how to do synchronised writes on a shared filehandle (from the same Monk): http://www.perlmonks.org/?node_id=807540

Answer 3

It just occurred to me there's two possible solutions:
Put the filehandle outside the Streamer object.
Put the Streamer object outside the Formatter.
#DVK's suggestions are all about doing 1.
But 2 is in some ways simpler than 1. Instead of holding the Streamer object itself, the Formatter can hold an identifier to the Streamer object. If the Streamer is implemented inside-out, that happens naturally!
Unfortunately, reference addresses change between threads, even shared ones. This can be solved with Hash::Util::FieldHash, but that's a 5.10 thing and I have to support 5.8. It's possible something could be put together using CLONE.

Answer 4

Here's what I wound up with...
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;
Using type coercion ensures that the translation from filehandle to key happens even in the object constructor.
It works, but it has flaws:
Each object stores its filehandle redundantly. If a bunch of objects all store the same filehandle they could probably just store it once. The trick would be how to identify the same filehandle. fileno or the refaddr are options.
The filehandle is not removed from %Filehandle_Storage upon object deletion. I originally put in a DESTROY method to do so, but since the object cloning idiom is $clone = shared_clone($obj) $clone's filehandle is trashed once $obj goes out of scope.
Changes which occur in children are not shared.
These are all acceptable for my purposes which will only create a handful of these objects per process.

Answer 5

Then again, one could use https://metacpan.org/module/Coro if one did not have an allergic reaction to its trolldocs.