POE-Component-Pool-Thread-0.015/0000755000214100017500000000000010545645076015601 5ustar smccoysmccoyPOE-Component-Pool-Thread-0.015/CHANGES0000644000214100017500000000155210545645077016600 0ustar smccoysmccoy------------------------------------------------------------------------ r22 | integral | 2006-04-15 02:48:11 -0700 (Sat, 15 Apr 2006) | 3 lines Converted t/pre_interface.t to Test::Simple which claims thread-safety when threads.pm is loaded before it. ------------------------------------------------------------------------ r21 | integral | 2006-04-15 01:58:34 -0700 (Sat, 15 Apr 2006) | 4 lines * Removed CHANGES, pm_to_blib and Makefile since the first two are empty, and the third is generated by Makefile.PL * Added svn:ignore property ------------------------------------------------------------------------ r13 | scottmc | 2006-04-04 23:52:04 -0700 (Tue, 04 Apr 2006) | 3 lines ''Added old perl modules'' '''Starting to think maybe I should structure the new repository differently''' ------------------------------------------------------------------------ POE-Component-Pool-Thread-0.015/Thread.pm0000644000214100001440000003254110545645055017210 0ustar smccoyuserspackage POE::Component::Pool::Thread; # ----------------------------------------------------------------------------- # "THE BEER-WARE LICENSE" (Revision 43) borrowed from FreeBSD's jail.c: # wrote this file. As long as you retain this notice you # can do whatever you want with this stuff. If we meet some day, and you think # this stuff is worth it, you can buy me a beer in return. Scott S. McCoy # ----------------------------------------------------------------------------- use strict; use warnings FATAL => "all"; no warnings 'numeric'; # grep int hack use threads; use threads::shared; use Thread::Semaphore; use Thread::Queue; use IO::Handle; use POE qw( Pipe::OneWay Filter::Line Wheel::ReadWrite ); use Fcntl; # Circumvent warnings... BEGIN { run POE::Kernel } *VERSION = \0.015; use constant DEBUG => 0; sub new { die __PACKAGE__, "->new() requires a balanced list" unless @_ % 2; my ($type, %opt) = @_; $opt{inline_states} ||= {}; $opt{StartThreads} ||= 0; $opt{MinFree} ||= 2; $opt{MaxFree} ||= 10; POE::Session->create ( inline_states => { %{ $opt{inline_states} }, _start => sub { my ($kernel, $heap) = @_[ KERNEL, HEAP ]; $kernel->alias_set($opt{Name}) if $opt{Name}; $heap->{queue} = []; my ($pipe_in, $pipe_out) = POE::Pipe::OneWay->new; $heap->{pipe_out} = $pipe_out; die "Unable to create pipe" unless defined $pipe_in and defined $pipe_out; $heap->{wheel} = POE::Wheel::ReadWrite->new ( Handle => $pipe_in, InputEvent => "-thread_talkback", ErrorEvent => "-thread_talkerror", ); for (1 .. $opt{StartThreads}) { $kernel->call($_[SESSION], "-spawn_thread"); } goto $opt{inline_states}{_start} if $opt{inline_states}{_start}; }, _stop => sub { my ($kernel, $heap) = @_[ KERNEL, HEAP ]; DEBUG && warn "Joining all threads"; for my $tid (keys %{ $heap->{thread} }) { $heap->{thread}{$tid}{iqueue}->enqueue("last"); $heap->{thread}{$tid}{thread}->join; } goto $opt{inline_states}{_stop} if $opt{inline_states}{_stop}; }, _default => sub { die "_default caught state: ", $_[ARG0]; }, -thread_talkerror => sub { die $_[ARG0], $_[ARG2] }, -thread_talkback => sub { my ($kernel, $heap, $input) = @_[ KERNEL, HEAP, ARG0 ]; my ($tid, $command) = ($input =~ m/(\d+): (\w+)/); DEBUG and warn "Recieved: $input"; # Depending upon the settings of perlvar's, its possible we may get # some garbage through here. if (defined $command) { if ($command eq "cleanup") { $kernel->yield(-execute_cleanup => $tid); } elsif ($command eq "collect") { $kernel->yield(-collect_garbage => $tid); } } }, -collect_garbage => sub { DEBUG && warn "GC Called, thread exited"; my ($kernel, $session, $heap, $tid) = @_[ KERNEL, SESSION, HEAP, ARG0 ]; my $tdsc = delete $heap->{thread}{$tid} or return; $tdsc->{thread}->join; unless ($kernel->refcount_decrement($session->ID, "thread")) { delete $heap->{wheel}; } delete $tdsc->{$_} for keys %$tdsc; }, -execute_cleanup => sub { my ($kernel, $session, $heap, $tid) = @_[ KERNEL, SESSION, HEAP, ARG0 ]; DEBUG && warn "GC Called, thread finished task"; my $thread = $heap->{thread}; my @free = grep ${ $_->{semaphore} }, values %$thread; my $queue = $heap->{queue}; my $rqueue = $heap->{thread}{$tid}{rqueue}; my $iqueue = $heap->{thread}{$tid}{iqueue}; if ($rqueue->pending) { if ($opt{CallBack}) { DEBUG && warn "Dispatching CallBack"; $opt{CallBack}->( @_[0..ARG0-1], @{$rqueue->dequeue} ); } } if (@$queue) { my $args = &share([]); push @$args, @{ shift @$queue }; $iqueue->enqueue($args); } elsif (@free > $opt{MaxFree}) { (shift @free)->{iqueue}->enqueue("last"); } }, -spawn_thread => sub { my ($kernel, $session, $heap) = @_[ KERNEL, SESSION, HEAP ]; return if $opt{MaxThreads} == scalar keys %{ $heap->{thread} }; DEBUG && warn "Spawning a new thread"; my $semaphore = Thread::Semaphore->new; my $iqueue = Thread::Queue->new; my $rqueue = Thread::Queue->new; my $pipe_out = $heap->{pipe_out}; my $queue = $heap->{queue}; my $thread = threads->create ( \&thread_entry_point, $semaphore, $iqueue, $rqueue, fileno($pipe_out), $opt{EntryPoint} ); $kernel->refcount_increment($session->ID, "thread"); $heap->{thread}{$thread->tid} = { semaphore => $semaphore, iqueue => $iqueue, rqueue => $rqueue, thread => $thread, lifespan => 0, # Not currently used }; if (@$queue) { my $args = &share([]); push @$args, @{ shift @$queue }; $iqueue->enqueue($args); } }, run => sub { my ($kernel, $heap, @arg) = @_[ KERNEL, HEAP, ARG0 .. $#_ ]; DEBUG && warn "Assigned a task"; my $thread = $heap->{thread}; my @free = grep ${ $_->{semaphore} }, values %$thread; if (@free) { my $tdsc = shift @free; # Trickery so we can pass this through Thread::Queue; my $sharg = &share([]); # Just to be polite... lock $sharg; push @$sharg, @arg; DEBUG and warn "Enqueueing on ", $tdsc->{thread}->tid; $tdsc->{iqueue}->enqueue($sharg); } else { push @{ $heap->{queue} }, [ @arg ]; } if (@free < $opt{MinFree}) { unless (scalar(keys %$thread) >= $opt{MaxThreads}) { $kernel->yield("-spawn_thread"); } } }, shutdown => sub { my ($kernel, $heap) = @_[ KERNEL, HEAP ]; $heap->{shutdown} = 1; $kernel->alias_remove($opt{Name}); for my $thread (values %{ $heap->{thread} }) { $thread->{iqueue}->enqueue("last"); } }, }, ); } sub thread_entry_point { my ($semaphore, $iqueue, $rqueue, $pipe_fd, $task) = @_; my $pipe = IO::Handle->new_from_fd($pipe_fd, "a") or die $!; # XXX Hack my $code = $task; # Just incase local $\ = "\n"; while (my $action = $iqueue->dequeue) { DEBUG and warn threads->self->tid, ": recieved action"; $semaphore->down; # lock $action; unless (ref $action) { if ($action eq "last") { $$semaphore = -1; last; } } else { my $arg = $action; # lock $arg; # Just incase... my $result = &share([]); push @$result, $code->(@$arg); DEBUG and warn threads->self->tid, ": Enqueuing result: @$result"; $rqueue->enqueue($result); } DEBUG and warn threads->self->tid, ": Requesting cleanup"; $pipe->print( threads->self->tid, ": cleanup" ); $pipe->flush; $semaphore->up; } $pipe->print( threads->self->tid, ": collect" ); $pipe->flush; DEBUG and warn threads->self->tid, ": Requesting Destruction"; } 1; =head1 NAME POE::Component::Pool::Thread - A POE Managed Boss/Worker threadpool. =head1 SYNOPSIS use POE qw( Component::Pool::Thread ); POE::Component::Pool::Thread->new ( MinFree => 2, MaxFree => 5, MaxThreads => 15, StartThrneads => 5, Name => "ThreadPool", EntryPoint => \&thread_entry_point, CallBack => \&result_handler, inline_states => { _start => sub { my ($kernel, $heap) = @_[ KERNEL, HEAP ]; # We are inside the component session $kernel->yield(run => @arguements); $kernel->post(ThreadPool => run => @arguements); }, } ); sub thread_entry_point { my (@arguements) = @_; return 1; } sub result_handler { my ($kernel, $result) = @_[ KERNEL, ARG0 ]; $result == 1; } =head1 DESCRIPTION This is an expand-on-demand thread pool managed through a POE session in a manner that does not interfer with cooperative multitasking. A single pipe is created, each thread communicates its state to the main process through this pipe. No serialization occurs (these are threads, not child processes), so execution is very fast. =head1 RATIONALE Cooperative Co-routine type programming isn't always available. Some third party software (dependant libraries and/or modules) and particular tasks block processing weither you like it or not. Creation of threads is alot of overhead, infact quite a bit more overhead under the current implementation of ithreads than fork is. Allocating these resources before you need them is an obvious solution to this problem, if you create the threads and re-use them, they're around when you need them without the horrendously slow threads->create() method. Communicating the results of a threads processing requires allowing it to exit. This means you will require the overhead of threads->create() next time you need to accomplish this task. With a thread pool designed in this fasion, the main thread itself has its own process loop. The result of each iteration is passed through a thread safe queue, allowing you to collect the results of a threads execution without the thread exiting. =head1 CONSTRUCTOR =over 4 =item new MANY THINGS The new constructor is the only package method available with this package. It creates a POE thread pool session which you describe in the following arguements. =over 4 =item EntryPoint CODE This arguement describes the entry point of the thread and is required. In the actual implementation, this is not actually an entry point. This is instead a coderef the thread will call repeatedly. The arguements of this subroutine will be the arguements recieved by the controlling session. In order to pass references as arguements, each reference must be shared (L). Filehandles and blessed references cannot be shared. You will have to translate them yourself. With file handles, you can pass simply the file descriptor and reopen it in the child thread. With blessed references, you can pass the datastructure only, and rebless the reference in the thread. =item CallBack CODE This arguement descirbes the result handler, which is where the captured results of a threads last execution are sent. As with EntryPoint subroutine arguements, any data structures you wish to pass through return results must be explicitly shared (L). =item Name ALIAS This arguement descirbes the default alias your threadpool session is given. =item StartThreads INTEGER This arguement describes the number of threads the component will create during its "_start" state, or when the POE Session is being started. This should be a number greater than MinFree and less than or equal to MaxFree. =item MaxThreads INTEGER This arguement descirbes the maximum number of threads this component will create for this task. If the component is assigned more tasks than threads, it will place the remaining tasks in an internal FIFO queue and assign them threads as they complete their tasks. =item MinFree INTEGER This arguement sets the minimum number of free threads to maintain. When the component is assigned a new task, if there are less than this number of threads available, it will yield a request to create a new thread at the components convience. =item MaxFree INTEGER This arguement provides the maximum number of free threads to maintain. Upon completion of a task, this value is checked. If there are more free threads than this value available, the oldest thread is asked to shut down. =back =back =head1 INLINE STATES =over 4 =item run LIST The run state assigns a task to one of the free threads in the pool, or appends the task to the components internal FIFO if no threads are available and our thread resources are exhausted. =item shutdown This state politely asks all threads to exit, deletes the wheel watching the one way pipe threads are using to communicate, removes the session alias and awaits a clean session shutdown. =back =head1 BUGS Oh I'm pretty sure of it. If you find some, let me know. =head1 THANKS Matt Cashner Rocco Caputo =head1 AUTHOR Scott McCoy (tag@cpan.org) =cut POE-Component-Pool-Thread-0.015/MANIFEST0000644000214100017500000000027710545645076016740 0ustar smccoysmccoyCHANGES Makefile.PL MANIFEST This list of files t/post_queue.t t/post_threshold.t t/pre_interface.t Thread.pm META.yml Module meta-data (added by MakeMaker) POE-Component-Pool-Thread-0.015/t/0000755000214100017500000000000010545645076016044 5ustar smccoysmccoyPOE-Component-Pool-Thread-0.015/t/pre_interface.t0000644000214100001440000000234610545637414020701 0ustar smccoyusers#!/usr/bin/perl use strict; use warnings FATAL => "all"; our $TOTAL_JOBS; BEGIN { $TOTAL_JOBS = 4 } use POE qw( Component::Pool::Thread ); use Test::Simple tests => 2*$TOTAL_JOBS; POE::Component::Pool::Thread->new ( MaxFree => 5, MinFree => 2, MaxThreads => 10, StartThreads => 5, Name => "ThreadPool", EntryPoint => \&thread_entry_point, CallBack => \&response, inline_states => { _start => sub { $_[KERNEL]->yield(loop => 1), }, loop => sub { my ($kernel, $i) = @_[ KERNEL, ARG0 ]; $kernel->yield(run => $i); if ($i < $TOTAL_JOBS) { $kernel->yield(loop => $i + 1); # Simulate variable loads select undef, undef, undef, rand 0.2; } }, } ); sub thread_entry_point { my $point = shift; # Simulate tasks that take time and block select undef, undef, undef, rand 0.5; ok(1, "thread_entry_point $point"); return $point; } { my $responses = 0; sub response { my ($kernel, $result) = @_[ KERNEL, ARG0 ]; ok(1, "response $result\n"); if (++$responses == $TOTAL_JOBS) { $kernel->yield("shutdown"); } } } run POE::Kernel; POE-Component-Pool-Thread-0.015/t/post_queue.t0000644000214100001440000000117210545637362020262 0ustar smccoyusers#!/usr/bin/perl -l use strict; use warnings FATAL => "all"; use POE qw( Component::Pool::Thread ); use Test::Simple tests => 100; my $responses; POE::Component::Pool::Thread->new ( MaxThreads => 1, StartThreads => 1, EntryPoint => sub { my ($result) = @_; ok 1; return $result; }, CallBack => sub { ok keys(%{ $_[HEAP]->{thread} })== 1; $_[KERNEL]->yield("shutdown") if (++$responses == 50); }, inline_states => { _start => sub { $_[KERNEL]->call($_[SESSION], run => $_) for 1 .. 50; }, } ); POE::Kernel->run; POE-Component-Pool-Thread-0.015/t/post_threshold.t0000644000214100001440000000413610545640242021124 0ustar smccoyusers#!/usr/bin/perl use strict; use warnings FATAL => "all"; no warnings "numeric"; use POE qw( Component::Pool::Thread ); use Test::Simple tests => 1; # This test is full of screwed up race condition based behavior...it needs to # be rethought. # # It appears the component is working correctly, I just apparently didn't know # what I was doing at the time. ok 1; exit 0; POE::Component::Pool::Thread->new ( MaxFree => 5, MinFree => 2, MaxThreads => 8, StartThreads => 3, Name => "ThreadPool", EntryPoint => \&thread_entry_point, CallBack => \&response, inline_states => { _start => sub { $_[KERNEL]->yield("go"); }, go => sub { my ($kernel, $session, $heap) = @_[ KERNEL, SESSION, HEAP ]; my ($thread, @free); $kernel->call($session, run => 1) for 1 .. 3; $thread = $heap->{thread}; @free = grep ${ $_->{semaphore} }, values %$thread; # These are race condition-y # ok(scalar keys %$thread == 0); $kernel->call($session, run => 0) for 4 .. 20; # ok @{ $heap->{queue} }; # What was I thinking...what an obvious race condition. # $kernel->yield(run => "finished"); }, } ); sub thread_entry_point { my ($delay) = @_; # So we can check select undef, undef, undef, 0.5 if int $delay; ok 1; return $delay; } { my $responses = 0; sub response { my ($kernel, $heap, $result) = @_[ KERNEL, HEAP, ARG0 ]; my (@thread, @free); @thread = values %{ $heap->{thread} }; @free = grep ${ $_->{semaphore} }, @thread; ok @thread <= 8; if (@{ $heap->{queue} }) { ok ((@free >= 2 && @free <= 5) || (@free == 8 && @thread <= 8)); } else { # During shut down or quick load drops this happens, but only # temporarily. Eventually the component gets around to GC'ing # everything. This is just to make sure there aren't extra threads ok @free <= 8; } if (++$responses == 20) { ok 1; $kernel->yield("shutdown"); } } } run POE::Kernel; POE-Component-Pool-Thread-0.015/Makefile.PL0000644000214100001440000000204110545641601017376 0ustar smccoyusers#!/usr/bin/perl use strict; use warnings FATAL => "all"; use ExtUtils::MakeMaker; # Touch CHANGES so it exists. open CHANGES, ">>CHANGES" and close CHANGES; # Dont laugh! #sub MY::postamble { # q( #document: # $(NOECHO) $(PERLRUN) "-MFile::Find" \ # -le 'find { wanted => sub { if (m/otl$$/) { \ # my $$pod = $$_; \ # $$pod =~ s/otl/pod/; \ # print "Converting $$File::Find::name to $$pod"; \ # system("otl2pod $$_ > $$pod"); \ # } } }, "lib";' # ); #} WriteMakefile ( NAME => 'POE::Component::Pool::Thread', AUTHOR => 'Scott S. McCoy (tag@cpan.org)', ABSTRACT => 'A POE Component for managing Boss/Worker Thread pools', VERSION_FROM => 'Thread.pm', PREREQ_PM => { POE => 0.30, threads => 1.03, }, dist => { DIST_DEFAULT => "tardist", COMPRESS => 'gzip -9f', SUFFIX => 'gz', PREOP => ( 'svn log | ' . 'tee ./$(DISTNAME)-$(VERSION)/CHANGES > ./CHANGES' ), }, ); POE-Component-Pool-Thread-0.015/META.yml0000644000214100017500000000061210545645076017051 0ustar smccoysmccoy# http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: POE-Component-Pool-Thread version: 0.015 version_from: Thread.pm installdirs: site requires: POE: 0.3 threads: 1.03 distribution_type: module generated_by: ExtUtils::MakeMaker version 6.30_01