Thread-Conveyor-0.21/0000755000175000017500000000000014776764346013535 5ustar rockyrockyThread-Conveyor-0.21/META.json0000644000175000017500000000176214776764346015164 0ustar rockyrocky{ "abstract" : "transport of any data-structure", "author" : [ "Elizabeth Mattijsen (liz@dijkmat.nl)" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.60, CPAN::Meta::Converter version 2.150010", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "Thread-Conveyor", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Thread::Serialize" : "0", "Thread::Tie" : "0.09", "load" : "0" } } }, "release_status" : "stable", "version" : "0.21", "x_serialization_backend" : "JSON::PP version 4.06" } Thread-Conveyor-0.21/VERSION0000644000175000017500000000000511445735710014557 0ustar rockyrocky0.19 Thread-Conveyor-0.21/README0000644000175000017500000000136411445441367014402 0ustar rockyrockyREADME for Thread::Conveyor Pass (almost) any data-structure between threads on a first-in, first-out basis. *** A note of CAUTION *** This module only functions on Perl versions 5.8.0 and later. And then only when threads are enabled with -Dusethreads. It is of no use with any version of Perl before 5.8.0 or without threads enabled. ************************* Copyright (c) 2002-2003, 2010 Elizabeth Mattijsen . All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Version: 0.19 Required Modules: load (any) Thread::Serialize (any) Thread::Tie (0.09) perl Makefile.PL make make test make install Thread-Conveyor-0.21/Makefile.PL0000644000175000017500000000135310700770345015464 0ustar rockyrockyrequire 5.008; # do we have threads? my $module; BEGIN { $module = "Thread::Conveyor", require Config; Config->import; if ( !$Config{useithreads} ) { print "$module requires a version of perl that has threads enabled.\n"; exit 0; } } # set up stuff use ExtUtils::MakeMaker; # set version and dependency info eval "use Devel::Required"; # set up WriteMakefile ( NAME => $module, AUTHOR => 'Elizabeth Mattijsen (liz@dijkmat.nl)', ABSTRACT => 'transport of any data-structure', VERSION_FROM => 'lib/Thread/Conveyor.pm', PREREQ_PM => { qw( load 0 Thread::Serialize 0 Thread::Tie 0.09 ) }, ); Thread-Conveyor-0.21/TODO0000644000175000017500000000037310050423641014173 0ustar rockyrockyCheck out whether Data::Dumper as an alternate way to safely serialize data (including code refs) between threads, as per suggestion of Brent Dax. Maybe make 'cpu' optimization default for 5.8.2 and higher? As shared arrays are not leaking anymore? Thread-Conveyor-0.21/lib/0000755000175000017500000000000014776764346014303 5ustar rockyrockyThread-Conveyor-0.21/lib/Thread/0000755000175000017500000000000014776764346015512 5ustar rockyrockyThread-Conveyor-0.21/lib/Thread/Conveyor/0000755000175000017500000000000014776764346017316 5ustar rockyrockyThread-Conveyor-0.21/lib/Thread/Conveyor/Array.pm0000644000175000017500000001702514776764303020730 0ustar rockyrockypackage Thread::Conveyor::Array; # Make sure we have version info for this module # Make sure we are a belt # Make sure we do everything by the book from now on $VERSION = '0.21'; @ISA = qw(Thread::Conveyor); use strict; # Make sure we only load stuff when we actually need it use load; # Satisfy -require- 1; #--------------------------------------------------------------------------- # The following subroutines are loaded only on demand __END__ #--------------------------------------------------------------------------- # Class methods #--------------------------------------------------------------------------- # IN: 1 class with which to bless the object # OUT: 1 instantiated object sub new { # Obtain the class # Create the conveyor belt # And bless it as an object my $class = shift; my @belt : shared; bless \@belt,$class; } #new #--------------------------------------------------------------------------- # object methods #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1 shared item on which you can lock sub semaphore { shift } # semaphore #--------------------------------------------------------------------------- # Object methods #--------------------------------------------------------------------------- # IN: 1 instantiated object # 2..N parameters to be passed as a box onto the belt sub put { # Obtain the object # Return now if nothing to do my $belt = shift; return unless @_; # Make sure we're the only one putting things on the belt # Freeze the parameters and put it in a box on the belt # Signal the other worker threads that there is a new box on the belt lock( @$belt ); push( @$belt,Thread::Serialize::freeze( @_ ) ); threads::shared::cond_signal( @$belt ); } #put #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1..N parameters returned from a box on the belt sub take { # Obtain the object # Create an empty box my $belt = shift; my $box; # Make sure we're the only one working on the belt # Wait until someone else puts something on the belt # Take the box off the belt # Wake up other worker threads if there are still boxes now {lock( @$belt ); threads::shared::cond_wait( @$belt ) until @$belt; $box = shift( @$belt ); threads::shared::cond_signal( @$belt ) if @$belt; } #@$belt # Thaw the contents of the box and return the result Thread::Serialize::thaw( $box ); } #take #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1..N parameters returned from a box on the belt sub take_dontwait { # Obtain the object # Make sure we're the only one handling the belt # Return the result of taking of a box if there is one, or an empty list my $belt = shift; lock( @$belt ); return @$belt ? $belt->take : (); } #take_dontwait #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1..N references to data-structures in boxes sub clean { # Obtain the belt # Return now after cleaning if we're not interested in the result # Clean the belt and turn the boxes into references my $belt = shift; return $belt->_clean unless wantarray; map {[Thread::Serialize::thaw( $_ )]} $belt->_clean; } #clean #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1..N references to data-structures in boxes sub clean_dontwait { # Obtain the belt # Make sure we're the only one handling the belt # Return the result of cleaning the belt if there are boxes, or an empty list my $belt = shift; lock( @$belt ); return @$belt ? $belt->clean : (); } #clean_dontwait #--------------------------------------------------------------------------- # IN: 1 instantiated object # 2 ordinal number in array to return (default: 0) # OUT: 1..N parameters returned from a box on the belt sub peek { # Obtain the object # Create an empty box my $belt = shift; my $box; # Make sure we're the only one working on the belt # Wait until someone else puts something on the belt # Copy the box off the belt # Wake up other worker threads again {lock( @$belt ); threads::shared::cond_wait( @$belt ) until @$belt; $box = $belt->[shift || 0]; threads::shared::cond_signal( @$belt ); } #@$belt # Thaw the contents of the box and return the result Thread::Serialize::thaw( $box ); } #peek #--------------------------------------------------------------------------- # IN: 1 instantiated object # 2 ordinal number in array to return (default: 0) # OUT: 1..N parameters returned from a box on the belt sub peek_dontwait { # Obtain the object # Make sure we're the only one handling the belt # Return the result of taking of a box if there is one, or an empty list my $belt = shift; lock( @$belt ); return @$belt ? $belt->peek( @_ ) : (); } #peek_dontwait #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1 number of boxes still on the belt sub onbelt { scalar(@{$_[0]}) } #onbelt #--------------------------------------------------------------------------- # IN: 1 instantiated object (ignored) sub maxboxes { die "Cannot change throttling on a belt that was created unthrottled"; } #maxboxes #--------------------------------------------------------------------------- # IN: 1 instantiated object (ignored) sub minboxes { die "Cannot change throttling on a belt that was created unthrottled"; } #minboxes #--------------------------------------------------------------------------- # IN: 1 instantiated object sub shutdown { undef } #shutdown #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1 thread object associated with belt (always undef) sub thread { undef } #thread #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1 thread id of thread object associated with belt (always undef) sub tid { undef } #tid #--------------------------------------------------------------------------- # Internal subroutines #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1..N all frozen boxes on the belt sub _clean { # Obtain the belt # Initialize the list of frozen boxes my $belt = shift; my @frozen; # Make sure we're the only one accessing the belt # Wait until there is something on the belt # Obtain the entire contents of the belt of we want it # Clean the belt # Notify the world again {lock( @$belt ); threads::shared::cond_wait( @$belt ) until @$belt; @frozen = @$belt if wantarray; @$belt = (); threads::shared::cond_broadcast( @$belt ); } #@$belt # Return the frozen goods @frozen; } #_clean #--------------------------------------------------------------------------- __END__ =head1 NAME Thread::Conveyor::Array - array implementation of Thread::Conveyor =head1 DESCRIPTION This class should not be called by itself, but only with a call to L. =head1 AUTHOR Elizabeth Mattijsen, . Please report bugs to . =head1 COPYRIGHT Copyright (c) 2002, 2003, 2004, 2007, 2010 Elizabeth Mattijsen . All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L. =cut Thread-Conveyor-0.21/lib/Thread/Conveyor/Tied.pm0000644000175000017500000001774014776764330020543 0ustar rockyrockypackage Thread::Conveyor::Tied; # Make sure we have version info for this module # Make sure we are a belt # Make sure we do everything by the book from now on $VERSION = '0.21'; @ISA = qw(Thread::Conveyor); use strict; # Make sure we only load stuff when we actually need it use load; # Satisfy -require- 1; #--------------------------------------------------------------------------- # The following subroutines are loaded only on demand __END__ #--------------------------------------------------------------------------- # Class methods #--------------------------------------------------------------------------- # IN: 1 class with which to bless the object # OUT: 1 instantiated object sub new { # Create the tied conveyor belt # And bless reference to belt + its semaphore as an object and return it tie my @array,'Thread::Tie'; bless [\@array,(tied @array)->semaphore],shift; } #new #--------------------------------------------------------------------------- # object methods #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1 shared item on which you can lock sub semaphore { shift->[1] } # semaphore #--------------------------------------------------------------------------- # Object methods #--------------------------------------------------------------------------- # IN: 1 instantiated object # 2..N parameters to be passed as a box onto the belt sub put { # Obtain the object # Return now if nothing to do my ($array,$semaphore) = @{shift()}; return unless @_; # Make sure we're the only one putting things on the belt # Freeze the parameters and put it in a box on the belt # Signal the other worker threads that there is a new box on the belt lock( $semaphore ); push( @$array,Thread::Serialize::freeze( @_ ) ); threads::shared::cond_signal( $semaphore ); } #put #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1..N parameters returned from a box on the belt sub take { # Obtain the belt and semaphore # Create an empty box my ($array,$semaphore) = @{shift()}; my $box; # Make sure we're the only one working on the belt # Wait until someone else puts something on the belt # Take the box off the belt # Wake up other worker threads if there are still boxes now {lock( $semaphore ); threads::shared::cond_wait( $semaphore ) until @$array; $box = shift( @$array ); threads::shared::cond_signal( $semaphore ) if @$array; } #$semaphore # Thaw the contents of the box and return the result Thread::Serialize::thaw( $box ); } #take #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1..N parameters returned from a box on the belt sub take_dontwait { # Obtain the object # Obtain belt and semaphore # Make sure we're the only one handling the belt # Return the result of taking of a box if there is one, or an empty list my $self = shift; my ($array,$semaphore) = @{$self}; lock( $semaphore ); return @$array ? $self->take : (); } #take_dontwait #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1..N references to data-structures in boxes sub clean { # Obtain the object # Return now after cleaning if we're not interested in the result # Clean the belt and turn the boxes into references my $self = shift; return $self->_clean unless wantarray; map {[Thread::Serialize::thaw( $_ )]} $self->_clean; } #clean #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1..N references to data-structures in boxes sub clean_dontwait { # Obtain the object # Obtain the belt and semaphore # Make sure we're the only one handling the belt # Return the result of cleaning the belt if there are boxes, or an empty list my $self = shift; my ($array,$semaphore) = @{$self}; lock( $semaphore ); return @$array ? $self->clean : (); } #clean_dontwait #--------------------------------------------------------------------------- # IN: 1 instantiated object # 2 ordinal number in array to return (default: 0) # OUT: 1..N parameters returned from a box on the belt sub peek { # Obtain the belt and the semaphore # Create an empty box my ($array,$semaphore) = @{shift()}; my $box; # Make sure we're the only one working on the belt # Wait until someone else puts something on the belt # Copy the box off the belt # Wake up other worker threads again {lock( $semaphore ); threads::shared::cond_wait( $semaphore ) until @$array; $box = $array->[shift || 0]; threads::shared::cond_signal( $semaphore ); } #$semaphore # Thaw the contents of the box and return the result Thread::Serialize::thaw( $box ); } #peek #--------------------------------------------------------------------------- # IN: 1 instantiated object # 2 ordinal number in array to return (default: 0) # OUT: 1..N parameters returned from a box on the belt sub peek_dontwait { # Obtain the object # Obtain the belt and the semaphore # Make sure we're the only one handling the belt # Return the result of taking of a box if there is one, or an empty list my $self = shift; my ($array,$semaphore) = @{$self}; lock( $semaphore ); return @$array ? $self->peek( @_ ) : (); } #peek_dontwait #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1 number of boxes still on the belt sub onbelt { scalar(@{$_[0]->[0]}) } #onbelt #--------------------------------------------------------------------------- # IN: 1 instantiated object (ignored) sub maxboxes { die "Cannot change throttling on a belt that was created unthrottled"; } #maxboxes #--------------------------------------------------------------------------- # IN: 1 instantiated object (ignored) sub minboxes { die "Cannot change throttling on a belt that was created unthrottled"; } #minboxes #--------------------------------------------------------------------------- # IN: 1 instantiated object sub shutdown { undef } #shutdown #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1 thread object associated with belt (always undef) sub thread { undef } #thread #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1 thread id of thread object associated with belt (always undef) sub tid { undef } #tid #--------------------------------------------------------------------------- # Internal subroutines #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1..N all frozen boxes on the belt sub _clean { # Obtain the belt # Initialize the list of frozen boxes my ($array,$semaphore) = @{shift()}; my @frozen; # Make sure we're the only one accessing the belt # Wait until there is something on the belt # Obtain the entire contents of the belt of we want it # Clean the belt # Notify the world again {lock( $semaphore ); threads::shared::cond_wait( $semaphore ) until @$array; @frozen = @$array if wantarray; @$array = (); threads::shared::cond_broadcast( $semaphore ); } #$semaphore # Return the frozen goods @frozen; } #_clean #--------------------------------------------------------------------------- __END__ =head1 NAME Thread::Conveyor::Tied - tied array implementation of Thread::Conveyor =head1 DESCRIPTION This class should not be called by itself, but only with a call to L. =head1 AUTHOR Elizabeth Mattijsen, . Please report bugs to . =head1 COPYRIGHT Copyright (c) 2002, 2003, 2004, 2007, 2010 Elizabeth Mattijsen . All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L. =cut Thread-Conveyor-0.21/lib/Thread/Conveyor/Throttled.pm0000644000175000017500000001732014776764316021625 0ustar rockyrockypackage Thread::Conveyor::Throttled; # Make sure we have version info for this module # Make sure we're a conveyor belt # Make sure we do everything by the book from now on $VERSION = '0.21'; @ISA = qw(Thread::Conveyor); use strict; # Make sure we only load stuff when we actually need it use load; # Satisfy -require- 1; #--------------------------------------------------------------------------- # The following subroutines are loaded only on demand __END__ #--------------------------------------------------------------------------- # Class methods #--------------------------------------------------------------------------- # IN: 1 class with which to bless the object # 2 parameter hash reference # OUT: 1 instantiated object sub new { # Obtain the class # Obtain the parameter hash # Create a conveyor belt of the right type and save its object # Create local copy of it's semaphore (save one indirection later on) # Return with a blessed object my $class = shift; my $self = shift; my $belt = $self->{'belt'} = $class->SUPER::_new( 'Thread::Conveyor::'.(qw(Tied Array)[($self->{'optimize'}||'') eq 'cpu']), @_ ); $self->{'semaphore'} = $belt->semaphore; bless $self,$class; } #new #--------------------------------------------------------------------------- # object methods #--------------------------------------------------------------------------- # IN: 1 instantiated object # 2..N parameters to be passed as a box onto the belt sub put { # Obtain the object # De-activate box putting if too many now # Go perform the ordinary method my $self = shift; $self->_red; $self->{'belt'}->put( @_ ); } #put #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1..N parameters returned from a box on the belt sub take { # Obtain the object # Activate box putting again if so allowed # Go perform the ordinary method my $self = shift; $self->_green; $self->{'belt'}->take( @_ ); } #take #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1..N parameters returned from a box on the belt sub take_dontwait { # Obtain the object # Activate box putting again if so allowed # Go perform the ordinary method my $self = shift; $self->_green; $self->{'belt'}->take_dontwait( @_ ); } #take_dontwait #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1..N references to contents of boxes sub clean { shift->{'belt'}->clean } #clean #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1..N references to contents of boxes sub clean_dontwait { shift->{'belt'}->clean_dontwait } #clean_dontwait #--------------------------------------------------------------------------- # IN: 1 instantiated object # 2 index into array at which to peek (default: 0) # OUT: 1..N parameters returned from a box on the belt sub peek { shift->{'belt'}->peek( @_ ) } #peek #--------------------------------------------------------------------------- # IN: 1 instantiated object # 2 index into array at which to peek (default: 0) # OUT: 1..N parameters returned from a box on the belt sub peek_dontwait { shift->{'belt'}->peek_dontwait( @_ ) } #peek_dontwait #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1 number of boxes on the belt sub onbelt { shift->{'belt'}->onbelt } #onbelt #--------------------------------------------------------------------------- # IN: 1 instantiated object # 2 new maxboxes value (default: no change) # OUT: 1 current maxboxes value sub maxboxes { # Obtain the object # Set the new maxboxes and minboxes value if new value specified # Return current value my $self = shift; $self->{'minboxes'} = ($self->{'maxboxes'} = shift) >> 1 if @_; $self->{'maxboxes'}; } #maxboxes #--------------------------------------------------------------------------- # IN: 1 instantiated object # 2 new minboxes value (default: no change) # OUT: 1 current minboxes value sub minboxes { # Obtain the object # Set the new minboxes value if new value specified # Return current value my $self = shift; $self->{'minboxes'} = shift if @_; $self->{'minboxes'}; } #minboxes #--------------------------------------------------------------------------- # IN: 1 instantiated object sub shutdown { undef } #shutdown #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1 thread object associated with belt (always undef) sub thread { undef } #thread #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1 thread id of thread object associated with belt (always undef) sub tid { undef } #tid #--------------------------------------------------------------------------- # internal methods #--------------------------------------------------------------------------- # IN: 1 instantiated object sub _red { # Obtain the object # Return now if there is no throttling anymore # Obtain local copy of the belt my $self = shift; return unless $self->{'maxboxes'}; my ($belt,$semaphore,$halted) = @$self{qw(belt semaphore halted)}; # Lock the belt # If were halted # Wait until the halt flag is reset # Notify the rest of the world again lock( $semaphore ); return unless $$halted; if ($$halted) { threads::shared::cond_wait( $semaphore ) while $$halted; threads::shared::cond_broadcast( $semaphore ); # Elseif there are now too many boxes in the belt # Set the box putting halted flag # Wake up any threads that are waiting for boxes to be handled # Wait until the halt flag is reset # Notify the rest of the world again } elsif ($belt->onbelt > $self->{'maxboxes'}) { $$halted = 1; threads::shared::cond_broadcast( $semaphore ); threads::shared::cond_wait( $semaphore ) while $$halted; threads::shared::cond_broadcast( $semaphore ); } } #_red #--------------------------------------------------------------------------- # IN: 1 instantiated object sub _green { # Obtain the object # Return now if we don't have throttling anymore # Get local copies of the stuff we need my $self = shift; return unless $self->{'maxboxes'}; my ($belt,$semaphore,$halted) = @$self{qw(belt semaphore halted)}; # Lock access to the belt # Return now if box putting is not halted # Return if current number boxes of is still more than minimum number of boxes lock( $semaphore ); return unless $$halted; return if $belt->onbelt > $belt->{'minboxes'}; # Reset the halted flag, allow box putting again # Wake up all of the other threads to allow them to submit again $$halted = 0; threads::shared::cond_broadcast( $semaphore ); } #_green #--------------------------------------------------------------------------- # IN: 1 instantiated object # OUT: 1..N references to frozen contents of boxes sub _clean { shift->{'belt'}->_clean } #_clean #--------------------------------------------------------------------------- __END__ =head1 NAME Thread::Conveyor::Throttled - helper class of Thread::Conveyor =head1 DESCRIPTION This class should not be called by itself, but only with a call to L. =head1 AUTHOR Elizabeth Mattijsen, . Please report bugs to . =head1 COPYRIGHT Copyright (c) 2002, 2003, 2004, 2007, 2010 Elizabeth Mattijsen . All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L. =cut Thread-Conveyor-0.21/lib/Thread/Conveyor.pm0000644000175000017500000003765214776764263017667 0ustar rockyrockypackage Thread::Conveyor; # Start the Thread::Tie thread now if not already started (as clean as possible) use Thread::Tie (); # Make sure we have version info for this module # Make sure we do everything by the book from now on $VERSION = '0.21'; use strict; # Make sure we only load stuff when we actually need it use load; # Set default optimization our $OPTIMIZE = $] > 5.008 ? 'cpu' : 'memory'; # Satisfy -require- 1; #--------------------------------------------------------------------------- # The following subroutines are loaded only on demand __END__ #--------------------------------------------------------------------------- # Class methods #--------------------------------------------------------------------------- # IN: 1 class with which to bless the object # 2 parameter hash reference # OUT: 1 instantiated object sub new { # Obtain the class # Obtain the parameter hash, or create an empty one my $class = shift; my $self = shift || {}; # Obtain the optimization to be used # Die now if unknown optimization my $optimize = $self->{'optimize'} || $OPTIMIZE; die "Don't know how to handle '$optimize' optimization" unless $optimize =~ m#^(?:cpu|memory)$#; # Set maximum number of boxes if applicable # Return now with an unthrottled array implementation if so required $self->{'maxboxes'} = 50 unless exists( $self->{'maxboxes'} ); return $class->_new( $class.'::'.(qw(Tied Array)[$optimize eq 'cpu']) ) if !$self->{'maxboxes'}; # Set minimum number of boxes if applicable # Initialize a shared halted flag # Safe a reference to it in the object # Use the ::Throttled implementation (which will figure which optimization) $self->{'minboxes'} ||= $self->{'maxboxes'} >> 1; my $halted : shared = 0; $self->{'halted'} = \$halted; $class->_new( $class.'::Throttled',$self ); } #new #--------------------------------------------------------------------------- # IN: 1 class (ignored) # 2 new default optimization type # OUT: 1 current default optimization type sub optimize { # Set new optimized value if specified # Return current optimized value $OPTIMIZE = $_[1] if @_ > 1; $OPTIMIZE; } #optimize #--------------------------------------------------------------------------- # Internal subroutines #--------------------------------------------------------------------------- # IN: 1 this class (ignored) # 2 class for which to create object # 3..N parameters to be passed to it # OUT: 1 blessed object sub _new { # Ignore our own class # Obtain the class # Create module name # Allow non-strict references # Make sure the sub-module is available # Return object created with give parameter shift; my $class = shift; (my $module = $class) =~ s#::#/#g; no strict 'refs'; require $module.'.pm' unless defined( ${$class.'::VERSION'} ); $class->new( @_ ); } #_new #--------------------------------------------------------------------------- __END__ =head1 NAME Thread::Conveyor - transport of any data-structure between threads =head1 VERSION This documentation describes version 0.21. =head1 SYNOPSIS use Thread::Conveyor; my $belt = Thread::Conveyor->new( { maxboxes => 50, minboxes => 25, optimize => 'memory', # or 'cpu' } ); $belt->put( "foo", ["bar"], {"zoo"} ); my ($foo,$bar,$zoo) = $belt->take; my ($foo,$bar,$zoo) = $belt->take_dontwait; my ($foo,$bar,$zoo) = $belt->peek; my ($foo,$bar,$zoo) = $belt->peek_dontwait; my $onbelt = $belt->onbelt; my @box = $belt->clean; my @box = $belt->clean_dontwait; my ($foo,$bar,$zoo) = @{$box[0]}; $belt->maxboxes( 100 ); $belt->minboxes( 50 ); $belt->shutdown; $belt->thread; $belt->tid; =head1 DESCRIPTION *** A note of CAUTION *** This module only functions on Perl versions 5.8.0 and later. And then only when threads are enabled with -Dusethreads. It is of no use with any version of Perl before 5.8.0 or without threads enabled. ************************* The Thread::Conveyor object is a thread-safe data structure that mimics the behaviour of a conveyor belt. One or more worker threads can put boxes with frozen values and references on one end of the belt to be taken off by one or more worker threads on the other end of the belt to be thawed and returned. A box may consist of any combination of scalars and references to scalars, arrays (lists) and hashes. Freezing and thawing is currently done with the L module, but that may change in the future. Objects and code references are currently B allowed. By default, the maximum number of boxes on the belt is limited to B<50>. Putting of boxes on the belt is halted if the maximum number of boxes is exceeded. This throttling feature was added because it was found that excessive memory usage could be caused by having the belt growing too large. Throttling can be disabled if so desired. =head1 CLASS METHODS =head2 new $belt = Thread::Conveyor->new( { maxboxes => 50, minboxes => 25, optimize => 'memory', # or 'cpu' } ); The "new" function creates a new empty belt. It returns the instantiated Thread::Conveyor object. The input parameter is a reference to a hash. The following fields are B in the hash reference: =over 2 =item maxboxes maxboxes => 50, maxboxes => undef, # disable throttling The "maxboxes" field specifies the B number of boxes that can be sitting on the belt to be handled (throttling). If a new L would exceed this amount, putting of boxes will be halted until the number of boxes waiting to be handled has become at least as low as the amount specified with the "minboxes" field. Fifty boxes will be assumed for the "maxboxes" field if it is not specified. If you do not want to have any throttling, you can specify the value "undef" for the field. But beware! If you do not have throttling active, you may wind up using excessive amounts of memory used for storing all of the boxes that have not been handled yet. The L method can be called to change the throttling settings during the lifetime of the object. =item minboxes minboxes => 25, # default: maxboxes / 2 The "minboxes" field specifies the B number of boxes that can be waiting on the belt to be handled before the Lting of boxes is allowed again (throttling). If throttling is active and the "minboxes" field is not specified, then half of the "maxboxes" value will be assumed. The L method can be called to change the throttling settings during the lifetime of the object. =item optimize optimize => 'cpu', # default: depends on Perl version The "optimize" field specifies which implementation of the belt will be selected. Currently there are two choices: 'cpu' and 'memory'. For Perl 5.8.0 the default is "memory". For higher versions of perl, the default optimization is "cpu". The reason for this was that Perl 5.8.0 has a severe memory leak with shared arrays, which is what is being used with the "cpu" optimization. You can call the class method L to change the default optimization. =back =head2 optimize Thread::Conveyor->optimize( 'cpu' ); $optimize = Thread::Conveyor->optimize; The "optimize" class method allows you to specify the default optimization type that will be used if no "optimize" field has been explicitely specified with a call to L. It returns the current default type of optimization. Currently two types of optimization can be selected: =over 2 =item memory Attempt to use as little memory as possible. Currently, this is achieved by starting a seperate thread which hosts an unshared array. This uses the "Thread::Conveyor::Thread" sub-class. =item cpu Attempt to use as little CPU as possible. Currently, this is achieved by using a shared array (using the "Thread::Conveyor::Array" sub-class), encapsulated in a hash reference if throttling is activated (then also using the "Thread::Conveyor::Throttled" sub-class). =back =head1 OBJECT METHODS The following methods operate on the instantiated Thread::Conveyor object. =head2 put $belt->put( 'string',$scalar,[],{} ); The "put" method freezes all the specified parameters together in a box and puts the box on the beginning of the belt. =head2 take ($string,$scalar,$listref,$hashref) = $belt->take; The "take" method waits for a box to become available at the end of the belt, removes that box from the belt, thaws the contents of the box and returns the resulting values and references. =head2 take_dontwait ($string,$scalar,$listref,$hashref) = $belt->take_dontwait; The "take_dontwait" method, like the L method, removes a box from the end of the belt if there is a box waiting at the end of the belt. If there is B box available, then the "take_dontwait" method will return immediately with an empty list. Otherwise the contents of the box will be thawed and the resulting values and references will be returned. =head2 clean @box = $belt->clean; ($string,$scalar,$listref,$hashref) = @{$box[0]}; The "clean" method waits for one or more boxes to become available at the end of the belt, removes B boxes from the belt, thaws the contents of the boxes and returns the resulting values and references as an array where each element is a reference to the original contents of each box. =head2 clean_dontwait @box = $belt->clean_dontwait; ($string,$scalar,$listref,$hashref) = @{$box[0]}; The "clean_dontwait" method, like the L method, removes all boxes from the end of the belt if there are any boxes waiting at the end of the belt. If there are B boxes available, then the "clean_dontwait" method will return immediately with an empty list. Otherwise the contents of the boxes will be thawed and the resulting values and references will be returned an an array where each element is a reference to the original contents of each box. =head2 peek ($string,$scalar,$listref,$hashref) = $belt->peek; @lookahead = $belt->peek( $index ); The "peek" method waits for a box to become availabe at the end of the belt, but does B remove it from the belt like the L method does. It does however thaw the contents and returns the resulting values and references. For advanced, and mostly internal, usages, it is possible to specify the ordinal number of the box in which to peek. Please note that there is B guarantee that "take" will give you the same data as which is returned with this method, as any other thread can have taken the boxes off of the belt in the meantime. =head2 peek_dontwait ($string,$scalar,$listref,$hashref) = $belt->peek_dontwait; @lookahead = $belt->peek_dontwait( $index ); The "peek_dontwait" method is like the L method, but does B remove the box from the belt if there is one available. If there is a box available, then the contents of the box will be thawed and the resulting values and references are returned. An empty list will be returned if there was no box available at the end of the belt. For advanced, and mostly internal, usages, it is possible to specify the ordinal number of the box in which to peek. Please note that there is B guarantee that "take" will give you the same data as which is returned with this method, as any other thread can have taken the boxes off of the belt in the meantime. =head2 onbelt $onbelt = $belt->onbelt; The "onbelt" method returns the number of boxes that are still in the belt. =head2 maxboxes $belt->maxboxes( 100 ); $maxboxes = $belt->maxboxes; The "maxboxes" method returns the maximum number of boxes that can be on the belt before throttling sets in. The input value, if specified, specifies the new maximum number of boxes that may be on the belt. Throttling will be switched off if the value B is specified. Specifying the "maxboxes" field when creating the object with L is equivalent to calling this method. The L method can be called to specify the minimum number of boxes that must be on the belt before the putting of boxes is allowed again after reaching the maximum number of boxes. By default, half of the "maxboxes" value is assumed. =head2 minboxes $belt->minboxes( 50 ); $minboxes = $belt->minboxes; The "minboxes" method returns the minimum number of boxes that must be on the belt before the putting of boxes is allowed again after reaching the maximum number of boxes. The input value, if specified, specifies the new minimum number of boxes that must be on the belt. Specifying the "minboxes" field when creating the object with L is equivalent to calling this method. The L method can be called to set the maximum number of boxes that may be on the belt before the putting of boxes will be halted. =head2 shutdown $belt->shutdown; The "shutdown" method performs an orderly shutdown of the belt. It waits until all of the boxes on the belt have been removed before it returns. =head2 thread $thread = $belt->thread; The "thread" method returns the thread object that is being used for the belt. It returns undef if no seperate thread is being used. =head2 tid $tid = $belt->tid; The "tid" method returns the thread id of the thread object that is being used for the belt. It returns undef if no seperate thread is being used. =head1 REQUIRED MODULES load (any) Thread::Serialize (any) Thread::Tie (0.09) =head1 OPTIMIZATIONS This module uses L to reduce memory and CPU usage. This causes subroutines only to be compiled in a thread when they are actually needed at the expense of more CPU when they need to be compiled. Simple benchmarks however revealed that the overhead of the compiling single routines is not much more (and sometimes a lot less) than the overhead of cloning a Perl interpreter with a lot of subroutines pre-loaded. =head1 CAVEATS Passing unshared values between threads is accomplished by serializing the specified values using L. Please see the CAVEATS section there for an up-to-date status of what can be passed around between threads. =head1 AUTHOR Elizabeth Mattijsen, . Maintained by LNATION Please report bugs to . =head1 HISTORY This module started life as L and as a sub-class of L. Using the conveyor belt metaphore seemed more appropriate and therefore the name was changed. To cut the cord with Thread::Queue completely, the belt mechanism was implemented from scratch. Why would you use Thread::Conveyor over Thread::Queue::Any? Well, Thread::Conveyor has the following extra features: =over 2 =item It works with Perl 5.8.0 Shared arrays leak memory very badly in Perl 5.8.0. Therefore, you cannot really use Thread::Queue in Perl 5.8.0, and consequently cannot use Thread::Queue::Any in any type of production environment. =item It provides throttling A thread that enqueues very many values quickly, can cause a large amount of memory to be used. With throttling, any thread that enqueues will have to wait until there is "room" on the belt again before continuing. See methods "minboxes" and "maxboxes". =item You can check for a new value without removing it from the belt Sometimes it can be nice to check whether there is a new value on the belt without actually removing it from the belt. See the "peek" and "peek_dontwait" methods. =item You can reset the entire belt Sometimes you want to be able to reset the contents of the belt. See the "clean" and "clean_dontwait" methods for that. =item You can get everything from the belt in one go Sometimes you want everything that's on the belt in one go. That can also ba accomplished with the "clean" and "clean_dontwait" methods. =back =head1 COPYRIGHT Copyright (c) 2002, 2003, 2004, 2007, 2010 Elizabeth Mattijsen . 2025 LNATION All rights reserved. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =head1 SEE ALSO L, L, L, L, L. =cut Thread-Conveyor-0.21/CHANGELOG0000644000175000017500000001607013561553541014733 0ustar rockyrocky0.20 9 November 2019 Adoption. 0.19 20 September 2010 Checking tool chain with perl.5.13.5. 0.18 3 October 2007 Hopefully fixed test-suite for none thread enabled Perls. Updated to use new VERSION feature of Devel::Required. 0.17 7 January 2004 Fixed some documentation inconsistencies. Added documentation on what is different from Thread::Queue::Any. Made default optimization dependent on the version of Perl used. Added test for it. Removed mention of Storable: replaced it with Thread::Serialize. Added Thread::Serialize as a dependency, just for documentation sake really. 0.16 28 December 2003 Added automatic required modules update using Devel::Required. Added dependency to load.pm. 0.15 9 November 2003 A problem in (threaded) 5.8.2 made Thread::Conveyor segfault in the test-suite. The problem was fortunately easy to circumvent: just don't use subroutines consisting of {} as an object method (in the case of Thread::Conveyor, the shutdown() method). 0.14 11 August 2003 Cleaned up Makefile.PL and updated copyright info. Verified everything works with 5.8.1. Updated dependency of Thread::Tie. 0.13 30 September 2002 Use "load.pm" instead of AutoLoader. Changed dependency on Thread::Tie to version 0.08 (which also uses load.pm). Added check for availability of methods again: load.pm does support that, whereas AutoLoader does not. 0.12 27 September 2002 Ask found another problem in T::C::Tied::clean_dontwait. Fixed. Also left warnings enabled in the test-suite last time, which caused warnings in the make test. Changed code so that the warnings are not emitted anymore. 0.11 26 September 2002 Fixed some warnings in T::C::Throttled, spotted by Ask Bjoern Hansen. Removed "our" from $VERSION and @ISA, should shave off some bytes in memory usage, as found from testing with Benchmark::Thread::Size. 0.10 1 September 2002 Replaced dependency on Thread::Serialize by dependency on Thread::Tie as the default, memory optimized implementation, now uses Thread::Tie. Changed Thread::Conveyor so that it uses T::C::Tied for unthrottled belts when optimizing for memory. Changed T::C::Throttled so that it makes its own decision on which belt implementation to be used, either T::C::Array (optimized for CPU) or T::C::Tied (optimized for memory). Added "semaphore" object method to T::C::Array for obtaining the lock() semaphore, needed by T::C::Throttled. Removed T::C::Thread from the distribution. This shaves about 1200 bytes off of the distribution package. Replaced Thread::Conveyor::Thread by Thread::Conveyor::Tied, which uses Thread::Tie as its shared array implementation. This has the side-effect to being almost twice as slow but saving 18% of memory (at least in the test-suite). So there is now a true CPU versus memory trade-off. Main difference in CPU is caused by the fact that whole array fetches aren't possible using the tie() interface (this is a loop with FETCH()), wherease T::C::Thread was optimized to deal with that case). Main difference in memory is caused by the fact that only one thread (the Thread::Tie default thread) is used for all belts, whereas before each belt had its own thread. So the savings in memory could in real world situations, be quite a lot more than the 18% seen in the test-suite. 0.09 30 August 2002 Changed all modules to use AutoLoader to defer loading of necessary subroutines to when they are actually needed. This should save memory and CPU for larger programs, or with large numbers of threads. The test-suite only marginally takes more memory at the same CPU usage: overhead of compiling is levelled out with the overhead of cloning pre-compiled routines. 0.08 20 August 2002 Dave Mitchell showed me the error of my ways with regards to client server thread programming. Fixed the handler optimized for memory so that no yield()s are necessary anymore. The whole thing now gets through the test suite more than 25% faster for that part. Scalability to many more threads should now be a lot better too. 0.07 14 August 2002 Removed (possibly premature) optimization from T::C::Thread _handler: it now doesn't zap the local threadspace anymore. 0.06 13 August 2002 Handed over freezing and thawing operations to Thread::Serialize. Added dependency to Thread::Serialize in Makefile.PL. 0.05 6 August 2002 Fixed "onbelt" in T::C::Thread so that it won't hang if the belt is shut down. Needed for Thread::Pool and in general useful. 5 August 2002 Added index functionality to "peek" and "peek_dontwait" to all sub-classes and added documentation for it. Needed for Thread::Pool. Finally got the T::C::Thread implementation getting through the test-suite reliably. Problem was caused by my misconception that cond_wait would always regain the lock() after being signalled. It does not. This should have been in big red letters in the threads::shared pod. Added methods "shutdown", "thread" and "tid" plus documentation. 3 August 2002 Adapted test-suite to use many more combinations of possible settings. 2 August 2002 Added new "optimize" field parameter to allow you to select an implementation optimized for speed (T::C::Array and T::C::Throttled) or for memory (T::C::Thread). Added new implementation of Thread::Conveyor based on using a seperate thread for keeping the belt: Thread::Conveyor::Thread. Move basic parts of Thread::Conveyor to Thread::Conveyor::Array. Which should allow for other implementations of the conveyor metaphor. 0.04 1 August 2002 Added internal method "_belt" to get at the actual belt, for both the normal and the throttled belt. 0.03 31 July 2002 Added internal methods "_freeze" and "_thaw" so that we can move to a different serialization scheme or other optimizations without having to change all the sub-classes as well. First user is Thread::Conveyor::Monitored. Added "maxjobs" and "minjobs" method in Thread::Conveyor that will die when they're called (throttling only takes place in Thread::Conveyor::Throttled). Fixed problem that would cause throttling to not be switched off when the "maxjobs" method was specified with an undef value. Added methods "clean" and "clean_dontwait" for cleaning the belt to both Thread::Conveyor and Thread::Conveyor::Throttled. Also added documentation for it. Added internal method "_clean" for obtaining frozen contents of the belt to both Thread::Conveyor and Thread::Conveyor::Throttled. This was needed for Thread::Conveyor::Monitored. 0.02 30 July 2002 Adapted Thread::Conveyor to default to a throttled conveyor belt automatically if no specific parameters specified. Now allows for specification of throttling settings in a parameter hash reference. If unthrottling is specifically specified, returns to the old unthrottled behaviour (where the object is just an array reference), thus keeping the old execution speed. Added helper class Thread::Conveyor::Throttled to allow for throttled conveyor belts that block if there are too many boxes on the belt. Fixed some documentation nits. 0.01 25 July 2002 First version of Thread::Conveyor, which started life as Thread::Queue::Any. Thread-Conveyor-0.21/META.yml0000644000175000017500000000114214776764346015004 0ustar rockyrocky--- abstract: 'transport of any data-structure' author: - 'Elizabeth Mattijsen (liz@dijkmat.nl)' build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.60, CPAN::Meta::Converter version 2.150010' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Thread-Conveyor no_index: directory: - t - inc requires: Thread::Serialize: '0' Thread::Tie: '0.09' load: '0' version: '0.21' x_serialization_backend: 'CPAN::Meta::YAML version 0.018' Thread-Conveyor-0.21/t/0000755000175000017500000000000014776764346014000 5ustar rockyrockyThread-Conveyor-0.21/t/Conveyor.t0000644000175000017500000000535510050423641015744 0ustar rockyrockyBEGIN { # Magic Perl CORE pragma if ($ENV{PERL_CORE}) { chdir 't' if -d 't'; @INC = '../lib'; } } use strict; use warnings; use Test::More tests => 2 + (2 * (16 + 3 * (3 * 4) ) ); BEGIN { use_ok('Thread::Conveyor') } my $default_optimize = $] > 5.008 ? 'cpu' : 'memory'; is( Thread::Conveyor->optimize,$default_optimize,"Check default optimization" ); foreach my $optimize (qw(cpu memory)) { diag( "test belt optimized for $optimize" ); my @base = (optimize => $optimize); my $belt = Thread::Conveyor->new( {@base} ); isa_ok( $belt, 'Thread::Conveyor', 'check object type' ); can_ok( $belt,qw( clean clean_dontwait maxboxes minboxes new onbelt peek peek_dontwait put take take_dontwait shutdown thread tid ) ); $belt->put( qw(a b c) ); $belt->put( [qw(a b c)] ); $belt->put( {a => 1, b => 2, c => 3} ); is( $belt->onbelt, 3, 'check number boxes on belt'); my @l = $belt->take; is( @l, 3, 'check # elements simple list' ); ok( ($l[0] eq 'a' and $l[1] eq 'b' and $l[2] eq 'c'), 'check simple list' ); my @lr = $belt->take_dontwait; cmp_ok( @lr, '==', 1, 'check # elements list ref' ); is( ref($lr[0]), 'ARRAY', 'check type of list ref' ); ok( ($lr[0]->[0] eq 'a' and $lr[0]->[1] eq 'b' and $lr[0]->[2] eq 'c'), 'check list ref' ); my @hr = $belt->peek_dontwait; cmp_ok( @hr, '==', 1, 'check # elements hash ref, #1' ); is( ref($hr[0]), 'HASH', 'check type of hash ref, #1' ); @hr = $belt->peek; cmp_ok( @hr, '==', 1, 'check # elements hash ref, #2' ); is( ref($hr[0]), 'HASH', 'check type of hash ref, #2' ); @hr = $belt->take; cmp_ok( @hr, '==', 1, 'check # elements hash ref, #3' ); is( ref($hr[0]), 'HASH', 'check type of hash ref, #3' ); ok( ($hr[0]->{a} == 1 and $hr[0]->{b} == 2 and $hr[0]->{c} == 3), 'check hash ref' ); my @e = $belt->take_dontwait; cmp_ok( @e, '==', 0, 'check # elements dontwait' ); $belt->shutdown; foreach my $times (10,100,1000) { foreach ( {@base}, {@base, maxboxes => undef}, {@base, maxboxes => 500, minboxes => 495}, ) { my $belt = Thread::Conveyor->new( $_ ); isa_ok( $belt,'Thread::Conveyor', 'check object type' ); my @n : shared = (); my $thread = threads->new( sub { while (1) { my ($n) = $belt->take; last unless defined( $n ); push( @n,$n ); } } ); isa_ok( $thread,'threads', 'check object type' ); foreach ((1..$times),undef) { $belt->put( $_ ); } ok( !defined( $thread->join ), 'check result of join()' ); my $check = ''; $check .= $_ foreach 1..$times; is( join('',@n),$check, 'check result of boxes on belt' ); } } } Thread-Conveyor-0.21/MANIFEST0000644000175000017500000000052313561553551014647 0ustar rockyrockyMANIFEST CHANGELOG README TODO VERSION Makefile.PL lib/Thread/Conveyor.pm lib/Thread/Conveyor/Array.pm lib/Thread/Conveyor/Tied.pm lib/Thread/Conveyor/Throttled.pm t/Conveyor.t META.yml Module meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker)