File Coverage

blib/lib/Wx/Perl/Thread/Object.pm

Criterion	Covered	Total	%
statement	7	9	77.7
branch			n/a
condition			n/a
subroutine	3	3	100.0
pod			n/a
total	10	12	83.3

package Wx::Perl::Thread::Object;

use strict;
use warnings;

use Thread::Queue::Any::Monitored;

my $SELF;

sub create {
    my( $class, @args ) = @_;
    my( $q, $t ) = Thread::Queue::Any::Monitored->new
      ( { monitor => sub { my( $meth, @args ) = @_; $SELF->$meth( @args ) },
          pre     => sub { $SELF = shift->new( @_ ) },
          }, $class, @args );

    # Oops, avoid the proxy being cloned
    my $self = bless {}, 'Wx::Perl::Thread::Object::Proxy';

    $self->{q} = $q;
    $self->{t} = $t;
    $self->{class} = $class;

    return $self;
}

package Wx::Perl::Thread::Object::Proxy;

use strict;
use warnings;

sub isa { $_[0]->{class}->isa( $_[1] ) }
sub can { $_[0]->{class}->can( $_[1] ) }

our $AUTOLOAD;

sub AUTOLOAD {
    my $name = $AUTOLOAD;
    $name =~ s/^.*:://;

    return if $name eq 'DESTROY';
    die $AUTOLOAD if Thread::Queue::Any::Monitored->self;
    die $AUTOLOAD if $name eq 'new';

    my $self = shift;

    $self->{q}->enqueue( $name, @_ );
}

sub wpto_terminate { $_[0]->{q}->enqueue( undef ) }
sub wpto_join      { $_[0]->{t}->join }

1;