Result:
found more than 817 distributions - search limited to the first 2001 files matching your query
( run in 1.920 )
Parallel-ForkManager-Scaled
view release on metacpan or search on metacpan
examples/dummyload.pl view on Meta::CPAN
my $start = time;
srand($$);
my $lifespan = 5+int(rand(10));
# Keep the CPU busy until it's time to exit
while (time - $start < $lifespan) {
my $a = time;
my $b = $a^time/3;
}
Parallel-MPM-Prefork
view release on metacpan or search on metacpan
lib/Parallel/MPM/Prefork.pm view on Meta::CPAN
qw(
pf_init
pf_done
pf_whip_kids
pf_kid_new
pf_kid_busy
pf_kid_yell
pf_kid_idle
pf_kid_exit
);
lib/Parallel/MPM/Prefork.pm view on Meta::CPAN
my $child_sigh;
my $dhook_in_main;
my $dhook_pid;
my $num_busy;
my $num_idle;
my %busy;
my %idle;
my $sigset_bak = POSIX::SigSet->new();
my $sigset_all = POSIX::SigSet->new();
$sigset_all->fillset();
lib/Parallel/MPM/Prefork.pm view on Meta::CPAN
eval {
setpgrp();
$pgid = getpgrp();
$timeout = $am_parent = 1;
$dhook_pid = $done = $num_busy = $num_idle = 0;
$child_fds = $child_stat_fd = $child_data_fd = $error = '';
undef %busy;
undef %idle;
$debug = $opts{debug};
# Just like Apache, we allow start_servers to be larger than
lib/Parallel/MPM/Prefork.pm view on Meta::CPAN
}
return -1;
}
sub pf_kid_busy {
syswrite $parent_stat_fh, "R$$\n" if ! $am_parent;
}
sub pf_kid_idle {
syswrite $parent_stat_fh, "S$$\n" if ! $am_parent;
lib/Parallel/MPM/Prefork.pm view on Meta::CPAN
sub _spawn {
my $code = shift;
my $args = shift;
if ($num_idle + $num_busy >= $max_servers) {
warn "Server seems busy, consider increasing max_servers.\n";
_log_child_status();
return -1;
}
# Temporarily block signal delivery until child has installed all handlers
lib/Parallel/MPM/Prefork.pm view on Meta::CPAN
if ($pid == $dhook_pid) {
warn "ERROR: data_hook_helper exited, forking new one.\n";
$dhook_pid = _fork_data_hook_helper($parent_data_fh, $child_data_fh);
}
else {
delete $busy{$pid} and $num_busy--;
delete $idle{$pid} and $num_idle--;
warn "PID $pid exited.\n" if $debug;
}
$ct++;
}
lib/Parallel/MPM/Prefork.pm view on Meta::CPAN
sub _read_child_status {
sigprocmask(SIG_BLOCK, $sigset_all, $sigset_bak);
while (<$child_stat_fh>) {
my ($status, $pid) = unpack 'aA*';
# Ignore delayed status messages from no longer existing children
next unless $busy{$pid} or $idle{$pid};
if ($status eq 'R') {
delete $idle{$pid} and $num_idle--;
$busy{$pid}++ or $num_busy++;
}
elsif ($status eq 'S') {
delete $busy{$pid} and $num_busy--;
$idle{$pid}++ or $num_idle++;
}
elsif ($status ne '0') { # 0 = Jeffries tube. cg use only!
warn "ERROR: Dubious status: $_";
}
lib/Parallel/MPM/Prefork.pm view on Meta::CPAN
my ($what, $count, @more) = @_;
warn "$what $count child", $count == 1 ? ".\n" : "ren.\n", @more;
}
sub _log_child_status {
warn "busy:$num_busy idle:$num_idle\n";
}
1;
__END__
lib/Parallel/MPM/Prefork.pm view on Meta::CPAN
# A simple echo server.
sub echo_server {
my $sock = shift;
CONN: while (accept my $conn, $sock) {
pf_kid_busy(); # tell parent we're busy
/^quit/ ? last CONN : syswrite $conn, $_ while <$conn>;
pf_kid_yell({ foo => 'bar' }, 1); # send data to parent
pf_kid_idle(); # tell parent we're idle again
}
}
lib/Parallel/MPM/Prefork.pm view on Meta::CPAN
1 while pf_whip_kids(\&echo_server, [$SOCK]);
=head3 $code
Code reference to be called in the child processes. Must make sure it calls
pf_kid_busy() and pf_kid_idle() as needed. If it returns, the child will exit
via C<exit(0)>.
=head3 $args (optional)
Array reference holding arguments to be passed when $code is called (C<<
lib/Parallel/MPM/Prefork.pm view on Meta::CPAN
As a special case it always returns -1 immediately if pf_done() has already
been called.
The newly created child is considered idle by the parent. It should call
pf_kid_busy() as soon as it starts working and pf_kid_idle() when it is
available again so that the parent can arrange for enough available child
processes.
Typical code:
lib/Parallel/MPM/Prefork.pm view on Meta::CPAN
while (1) {
my $pid = pf_kid_new() // die "Could not fork: $!";
last if $pid < 0; # pf_done()
next if $pid; # parent
# child:
pf_kid_busy();
# do some rocket science
pf_kid_idle();
pf_kid_exit();
}
END {
pf_done();
}
=head2 pf_kid_busy ()
To be called by a child process to tell the main process it is busy.
=head2 pf_kid_idle ()
To be called by a child process to tell the main process it is idle.
lib/Parallel/MPM/Prefork.pm view on Meta::CPAN
=head2 Difference to Parallel::ForkManager
With Parallel::ForkManager, the main process decides in advance how much work
there is to do, how to split it up and how many child processes will work in
parallel. A child is always considered busy.
With Parallel::MPM::Prefork, the child processes take on work automatically as
it arrives. A child may be busy or idle. The main process only makes sure
there are always enough child processes available without too many idling
around.
Keep in mind that these are completely different use cases.
Parallel-MapReduce
view release on metacpan or search on metacpan
lib/Parallel/MapReduce.pm view on Meta::CPAN
my @keys; # this will be filled in the map phase below
MAPPHASE:
while (my $sl4ws = _slices ([ keys %$slices ], $self->{_workers}) ) { # compute unresolved slices versus operational workers
if (my ($k) = keys %$slices) { # there is one unhandled
if (my ($w) = grep { ! defined $_->{thread} } # find a non-busy worker
@{ $self->{_workers}} ) { # from the operational workers
#warn "found free ".$w->{host};
$w->{slice} = delete $slices->{$k}; # task it with slice, take it off the list for now
my @chunks = threads->create ({'context' => 'list'},
'chunk_n_store',
lib/Parallel/MapReduce.pm view on Meta::CPAN
my @chunks;
REDUCEPHASE:
while (my $rs4ws = _slices ([ keys %$Rs ], $self->{_workers}) ) {
if (my ($r) = keys %$Rs) {
if (my ($w) = grep { ! defined $_->{thread} } # find a non-busy worker
@{ $self->{_workers}} ) { # from the operational workers
#warn "reduce: found free ".$w->{host};
$w->{slice} = delete $Rs->{$r};
$w->{thread} = threads->create (ref ($w).'::reduce',
Parallel-PreForkManager
view release on metacpan or search on metacpan
t/01-process-count.t view on Meta::CPAN
sub WorkHandler {
my ( $Self, $Thing ) = @_;
my $Val = $Thing->{'Value'};
$Self->ProgressCallback( 'Log', "WorkHandler:ProgressCallback:$PID" );
# sleep such that this process is busy resulting in more even
# spread across the available children during the test.
sleep 1;
return "WorkHandler:Return:$PID";
}
Parallel-Pvm-Scheduler
view release on metacpan or search on metacpan
Scheduler.pm view on Meta::CPAN
my $FREEHOSTS = scalar(@CONF);
my %HOSTS;
my @TID;
my %TIDcmd;
# Map host id to hostname and set busy flag to zero
foreach my $node (@CONF) {
my $hostid = $node->{'hi_tid'};
$HOSTS{$hostid}{'name'} = $node->{'hi_name'};
$HOSTS{$hostid}{'busy'} = 0;
}
my $self = {CONF => \@CONF, FREEHOSTS => $FREEHOSTS, HOSTS => \%HOSTS, TID => \@TID, TIDCMD => \%TIDcmd};
bless $self;
return $self;
Scheduler.pm view on Meta::CPAN
foreach my $node (@$CONF_ref) {
my $hostid = $node->{'hi_tid'};
my $hostname = $node->{'hi_name'};
if ($HOSTS_ref->{$hostid}{'busy'} != 0) {
print STDERR "$hostname is not free\n";
}
}
}
}
Scheduler.pm view on Meta::CPAN
# Locate a free host, allocate it, return it.
# First available algorithm
foreach my $hostid (keys %$HOSTS_ref) {
if ($HOSTS_ref->{$hostid}{'busy'} == 0) {
my $hostname = $HOSTS_ref->{$hostid}{'name'};
print STDERR "Allocating host $hostname\n";
$HOSTS_ref->{$hostid}{'busy'} = 1;
$self->{FREEHOSTS}--;
return $hostname;
}
}
Scheduler.pm view on Meta::CPAN
sub _deallocateHost {
my ($self, $hostid) = @_;
my $HOSTS_ref = $self->{HOSTS};
if ($HOSTS_ref->{$hostid}{'busy'} == 0) {
die "Host not allocated: ". $HOSTS_ref->{$hostid}{'name'} ."!\n";
}
print STDERR "Deallocating host ". $HOSTS_ref->{$hostid}{'name'} ."\n";
$HOSTS_ref->{$hostid}{'busy'} = 0;
$self->{FREEHOSTS}++;
}
1;
__END__
Parallel-TaskExecutor
view release on metacpan or search on metacpan
lib/Parallel/TaskExecutor.pm view on Meta::CPAN
=back
=cut
Readonly::Scalar my $busy_loop_wait_time_us => 1000;
sub run {
my ($this, $sub, %options) = @_;
%options = (%{$this->{options}}, %options);
# TODO: add an option to always call _remove_done_tasks here, to cleanup.
while (!$options{forced} && $this->{current_tasks} >= $this->{max_parallel_tasks}) {
$this->_remove_done_tasks();
usleep($busy_loop_wait_time_us);
}
return $this->_fork_and_run($sub, %options);
}
=pod
ParallelUserAgent
view release on metacpan or search on metacpan
lib/LWP/Parallel/RobotUA.pm view on Meta::CPAN
my($failed_connections, $remember_failures, $ordpend_connections, $rules) =
@{$self}{qw(failed_connections remember_failures
ordpend_connections rules)};
my ($entry, @queue, %busy);
# get first entry from pending connections
while ( $entry = shift @$ordpend_connections ) {
my $request = $entry->request;
my $netloc = eval { local $SIG{__DIE__}; $request->url->host_port; };
lib/LWP/Parallel/RobotUA.pm view on Meta::CPAN
# simulate immediate response from server
$self->on_failure ($entry->request, $response, $entry);
next;
}
push (@queue, $entry), next if $busy{$netloc};
# Do we try to access a new server?
my $allowed = $rules->allowed($request->url);
# PS: pending Robots.txt requests are always allowed! (hopefully)
if ($allowed < 0) {
LWP::Debug::debug("Host not visited before, or robots.".
"txt expired: ($allowed) ".$request->url);
my $checking = $self->_checking_robots_txt ($netloc);
# let's see if we're already busy checkin' this host
if ( $checking > 0 ) {
LWP::Debug::debug("Already busy checking here. Request queued");
push (@queue, $entry);
} elsif ( $checking < 0 ) {
# We already checked here. Seems the robots.txt
# expired afterall. Pretend we're allowed
LWP::Debug::debug("Checked this host before. robots.txt".
lib/LWP/Parallel/RobotUA.pm view on Meta::CPAN
$rules->parse($robot_url, "", $fresh_until);
}
},
};
# immediately try to connect (if bandwith available)
push (@queue, $robot_entry), $busy{$netloc}++
unless $self->_check_bandwith($robot_entry);
# mark this host as being checked
$self->_checking_robots_txt ($netloc, 1);
# don't forget to queue the entry that triggered this request
push (@queue, $entry);
lib/LWP/Parallel/RobotUA.pm view on Meta::CPAN
# requests to this server, but have finally waited
# long enough when the x+1 request comes off the
# queue, and then we would connect to the x+1
# request before any of the first x requests
# (which is not what we want!)
$busy{$netloc}++;
} else {
LWP::Debug::debug("'use_sleep' disabled, generating response");
my $res = new HTTP::Response
&HTTP::Status::RC_SERVICE_UNAVAILABLE, 'Please, slow down';
$res->header('Retry-After', time2str(time + $wait));
lib/LWP/Parallel/RobotUA.pm view on Meta::CPAN
} else { # check bandwith
unless ( $self->_check_bandwith($entry) ) {
# if _check_bandwith returns a value, it means that
# no bandwith is available: push $entry on queue
push (@queue, $entry);
$busy{$netloc}++;
} else {
$rules->visit($netloc);
}
}
}
lib/LWP/Parallel/RobotUA.pm view on Meta::CPAN
if ($allowed < 0) {
LWP::Debug::debug("Host not visited before, or robots.".
"txt expired: ".$request->url);
my $checking = $self->_checking_robots_txt
($request->url->host_port);
# let's see if we're already busy checkin' this host
if ( $checking > 0 ) {
# if so, don't register yet another robots.txt request!
LWP::Debug::debug("Already busy checking here. ".
"Request queued");
unshift (@$queue, $entry);
next SERVER;
} elsif ( $checking < 0 ) {
# We already checked here. Seems the robots.txt
( run in 1.920 second using v1.01-cache-2.11-cpan-600a1bdf6e4 )