r43730 - in /branches/upstream/libthread-pool-simple-perl/current: Changes META.yml Simple.pm
jawnsy-guest at users.alioth.debian.org
jawnsy-guest at users.alioth.debian.org
Sat Sep 5 03:01:20 UTC 2009
Author: jawnsy-guest
Date: Sat Sep 5 03:00:44 2009
New Revision: 43730
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=43730
Log:
[svn-upgrade] Integrating new upstream version, libthread-pool-simple-perl (0.24)
Modified:
branches/upstream/libthread-pool-simple-perl/current/Changes
branches/upstream/libthread-pool-simple-perl/current/META.yml
branches/upstream/libthread-pool-simple-perl/current/Simple.pm
Modified: branches/upstream/libthread-pool-simple-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libthread-pool-simple-perl/current/Changes?rev=43730&op=diff
==============================================================================
--- branches/upstream/libthread-pool-simple-perl/current/Changes (original)
+++ branches/upstream/libthread-pool-simple-perl/current/Changes Sat Sep 5 03:00:44 2009
@@ -1,4 +1,9 @@
Revision history for Perl extension Thread::Pool::Simple.
+
+0.24 3 SEP 2009
+ - used a workaround to avoid a rare problem when running under
+ perl debuger (thanks to Kevin Brintnall)
+ - removed redundant ``:locked method''
0.23 24 MAY 2007
- only calling ``sleep'' when not busy to avoid 1 sec delay
Modified: branches/upstream/libthread-pool-simple-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libthread-pool-simple-perl/current/META.yml?rev=43730&op=diff
==============================================================================
--- branches/upstream/libthread-pool-simple-perl/current/META.yml (original)
+++ branches/upstream/libthread-pool-simple-perl/current/META.yml Sat Sep 5 03:00:44 2009
@@ -1,10 +1,13 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
-name: Thread-Pool-Simple
-version: 0.23
-version_from: Simple.pm
-installdirs: site
-requires:
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.30
+--- #YAML:1.0
+name: Thread-Pool-Simple
+version: 0.24
+abstract: ~
+license: ~
+author:
+ - Jianyuan Wu <jwu at cpan.org>
+generated_by: ExtUtils::MakeMaker version 6.42
+distribution_type: module
+requires:
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.3.html
+ version: 1.3
Modified: branches/upstream/libthread-pool-simple-perl/current/Simple.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libthread-pool-simple-perl/current/Simple.pm?rev=43730&op=diff
==============================================================================
--- branches/upstream/libthread-pool-simple-perl/current/Simple.pm (original)
+++ branches/upstream/libthread-pool-simple-perl/current/Simple.pm Sat Sep 5 03:00:44 2009
@@ -9,7 +9,7 @@
use Thread::Queue;
use Thread::Semaphore;
-our $VERSION = '0.23';
+our $VERSION = '0.24';
sub new {
my ($class, %arg) = @_;
@@ -37,14 +37,16 @@
$self->{shutdown_lock} = Thread::Semaphore->new();
bless $self, $class;
$self->{shutdown_lock}->down();
- async {
- $self->_run(\%handler);
- $self->{shutdown_lock}->up();
- }->detach();
+ my $thr = threads->new(
+ sub {
+ $self->_run(\%handler);
+ $self->{shutdown_lock}->up();
+ }) or croak "fail to create new thread";
+ $thr->detach();
return $self;
}
-sub _run : locked method {
+sub _run {
my ($self, $handler) = @_;
while (1) {
last if $self->terminating();
@@ -63,7 +65,7 @@
}
}
-sub _increase : locked method {
+sub _increase {
my ($self, $handler) = @_;
my $max = do { lock %{$self->{config}}; $self->{config}{max} };
my $worker = do { lock ${$self->{worker}}; ${$self->{worker}} };
@@ -171,7 +173,7 @@
}
}
-sub _state : locked method {
+sub _state {
my $self = shift;
my $state = $self->{state};
lock $$state;
@@ -181,7 +183,7 @@
return $s;
}
-sub join : locked method {
+sub join {
my ($self, $nb) = @_;
$self->_state(-1);
my $max = do { lock %{$self->{config}}; $self->{config}{max} };
@@ -191,12 +193,12 @@
sleep 1; # cool down, otherwise may coredump while run tests
}
-sub detach : locked method {
+sub detach {
my ($self) = @_;
$self->join(1);
}
-sub busy : locked method {
+sub busy {
my ($self) = @_;
my $worker = do { lock ${$self->{worker}}; ${$self->{worker}} };
my ($min, $max, $load) = do { lock %{$self->{config}}; @{$self->{config}}{'min', 'max', 'load'} };
@@ -207,7 +209,7 @@
return $worker < $min || $pending > $worker * $load;
}
-sub terminating : locked method {
+sub terminating {
my ($self) = @_;
my $state = $self->_state();
my $job = do { lock %{$self->{submitted}}; keys %{$self->{submitted}} };
@@ -216,7 +218,7 @@
return;
}
-sub config : locked method {
+sub config {
my $self = shift;
my $config = $self->{config};
lock %$config;
@@ -225,7 +227,7 @@
return %$config;
}
-sub add : locked method {
+sub add {
my $self = shift;
my $context = wantarray;
$context = 2 unless defined $context; # void context = 2
@@ -252,25 +254,25 @@
return $id;
}
-sub job_exists : locked method {
+sub job_exists {
my ($self, $id) = @_;
lock %{$self->{submitted}};
return $self->{submitted}{$id};
}
-sub job_done : locked method {
+sub job_done {
my ($self, $id) = @_;
lock %{$self->{done}};
return $self->{done}{$id};
}
-sub _drop : locked method {
+sub _drop {
my ($self, $id) = @_;
lock %{$self->{submitted}};
delete $self->{submitted}{$id};
}
-sub _remove : locked method {
+sub _remove {
my ($self, $id, $nb) = @_;
return if $id % 3 == 2;
return unless $self->job_exists($id);
@@ -292,19 +294,19 @@
return ($exist, $ret->[0]);
}
-sub remove : locked method {
+sub remove {
my ($self, $id) = @_;
my ($exist, @ret) = $self->_remove($id);
return @ret;
}
-sub remove_nb : locked method {
+sub remove_nb {
my ($self, $id) = @_;
return $self->_remove($id, 1);
}
-sub cancel : locked method {
+sub cancel {
my ($self, $id) = @_;
my ($exist) = eval { $self->remove_nb($id) };
if (!$exist) {
@@ -313,7 +315,7 @@
}
}
-sub cancel_all : locked method {
+sub cancel_all {
my ($self) = @_;
my @id = do { lock %{$self->{submitted}}; keys %{$self->{submitted}} };
for (@id) {
More information about the Pkg-perl-cvs-commits
mailing list