CODEWITHSUNDEEP
multithreadingperl
Schwern
Schwern

Reputation: 164939

How to share an object which contains a filehandle?

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.

Upvotes: 16

Views: 1543

Answers (5)

Reverend Chip
Reverend Chip

Reputation: 1

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

Upvotes: 0

Schwern
Schwern

Reputation: 164939

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.

Upvotes: 1

Schwern
Schwern

Reputation: 164939

It just occurred to me there's two possible solutions:

  1. Put the filehandle outside the Streamer object.
  2. 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.

Upvotes: 3

DVK
DVK

Reputation: 129433

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

Upvotes: 5

DVK
DVK

Reputation: 129433

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

Upvotes: 6

Related Questions