package TB2::ThreadSafeFilehandleAccessor;

use TB2::Mouse;
use TB2::Mouse::Util::TypeConstraints;


=head1 NAME

=head1 SYNOPSIS

  package Something::That::Stores::Filehandles;

  use TB2::Mouse;
  use TB2::ThreadSafeFilehandleAccessor fh_accessors => [qw(this_fh that_fh)];

  my $obj = Something::That::Stores::Filehandles->new(
      this_fh   => \*STDOUT,
      that_fh   => \*STDERR,
  );

  use threads;
  use threads::shared;
  $obj = shared_clone($obj);

=head1 DESCRIPTION

This provides accessors specially written so objects can store and
access filehandles without storing them internally.  This is necessary
if the object is to be shared across threads.

All structures which are shared between threads must have all their
internal values and objects also be shared.  Filehandles cannot be
shared.  This presents a bit of a problem for L<TB2::Formatter>
objects which contain L<TB2::Streamer> objects which contain a
filehandle.

=head2 How To Use It

    use TB2::ThreadSafeFilehandleAccessor fh_accessors => [@names];

This will create an accessor for each name in @names.


=head2 Limitations & bugs

The main limitation is changes to the filehandles in a thread will not
be shared across threads or with the parent.

The filehandles will not be cleaned up on object destruction.  This
may hold the filehandle open and prevent the file from being flushed
to the disk until the process exits.

=cut

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 'TB2::Filehandle2Key' =>
  as 'Int';
coerce 'TB2::Filehandle2Key' =>
  from 'Defined',
  via {
      my $key = $Storage_Counter++;
      $Filehandle_Storage{$key} = $_;
      return $key;
  };

sub import {
    my $class = shift;
    my $caller = caller;

    my %args = @_;
    $args{fh_accessors} ||= [];

    for my $name (@{$args{fh_accessors}}) {
        my $meta = $caller->meta;

        $meta->add_attribute( $name =>
            is            => 'rw',
            isa           => 'TB2::Filehandle2Key',
            coerce        => 1,
        );

        $meta->add_around_method_modifier( $name => sub {
            my $orig = shift;
            my $self = shift;

            if( @_ ) {                  # setting
                return $self->$orig(@_);
            }
            else {                      # getting
                my $key = $self->$orig;
                return if !defined $key;
                return $Filehandle_Storage{$key};
            }
        });
    }
}


=head1 SEE ALSO

L<TB2::Streamer::Print> is the main target for this.

=cut

no TB2::Mouse;
no TB2::Mouse::Util::TypeConstraints;

1;