mirror of
https://git.savannah.gnu.org/git/parallel.git
synced 2024-11-25 15:37:56 +00:00
parallel: pod-file now separated (it became too big).
niceload: rewritten to GetOpt and first testsuite.
This commit is contained in:
parent
6979e62916
commit
3b3c344097
20
configure
vendored
20
configure
vendored
|
@ -1,6 +1,6 @@
|
|||
#! /bin/sh
|
||||
# Guess values for system-dependent variables and create Makefiles.
|
||||
# Generated by GNU Autoconf 2.67 for parallel 20101202.
|
||||
# Generated by GNU Autoconf 2.67 for parallel 20101206.
|
||||
#
|
||||
# Report bugs to <bug-parallel@gnu.org>.
|
||||
#
|
||||
|
@ -551,8 +551,8 @@ MAKEFLAGS=
|
|||
# Identity of this package.
|
||||
PACKAGE_NAME='parallel'
|
||||
PACKAGE_TARNAME='parallel'
|
||||
PACKAGE_VERSION='20101202'
|
||||
PACKAGE_STRING='parallel 20101202'
|
||||
PACKAGE_VERSION='20101206'
|
||||
PACKAGE_STRING='parallel 20101206'
|
||||
PACKAGE_BUGREPORT='bug-parallel@gnu.org'
|
||||
PACKAGE_URL=''
|
||||
|
||||
|
@ -1168,7 +1168,7 @@ if test "$ac_init_help" = "long"; then
|
|||
# Omit some internal or obsolete options to make the list less imposing.
|
||||
# This message is too long to be a string in the A/UX 3.1 sh.
|
||||
cat <<_ACEOF
|
||||
\`configure' configures parallel 20101202 to adapt to many kinds of systems.
|
||||
\`configure' configures parallel 20101206 to adapt to many kinds of systems.
|
||||
|
||||
Usage: $0 [OPTION]... [VAR=VALUE]...
|
||||
|
||||
|
@ -1234,7 +1234,7 @@ fi
|
|||
|
||||
if test -n "$ac_init_help"; then
|
||||
case $ac_init_help in
|
||||
short | recursive ) echo "Configuration of parallel 20101202:";;
|
||||
short | recursive ) echo "Configuration of parallel 20101206:";;
|
||||
esac
|
||||
cat <<\_ACEOF
|
||||
|
||||
|
@ -1301,7 +1301,7 @@ fi
|
|||
test -n "$ac_init_help" && exit $ac_status
|
||||
if $ac_init_version; then
|
||||
cat <<\_ACEOF
|
||||
parallel configure 20101202
|
||||
parallel configure 20101206
|
||||
generated by GNU Autoconf 2.67
|
||||
|
||||
Copyright (C) 2010 Free Software Foundation, Inc.
|
||||
|
@ -1318,7 +1318,7 @@ cat >config.log <<_ACEOF
|
|||
This file contains any messages produced by compilers while
|
||||
running configure, to aid debugging if configure makes a mistake.
|
||||
|
||||
It was created by parallel $as_me 20101202, which was
|
||||
It was created by parallel $as_me 20101206, which was
|
||||
generated by GNU Autoconf 2.67. Invocation command line was
|
||||
|
||||
$ $0 $@
|
||||
|
@ -2133,7 +2133,7 @@ fi
|
|||
|
||||
# Define the identity of the package.
|
||||
PACKAGE='parallel'
|
||||
VERSION='20101202'
|
||||
VERSION='20101206'
|
||||
|
||||
|
||||
cat >>confdefs.h <<_ACEOF
|
||||
|
@ -2684,7 +2684,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1
|
|||
# report actual input values of CONFIG_FILES etc. instead of their
|
||||
# values after options handling.
|
||||
ac_log="
|
||||
This file was extended by parallel $as_me 20101202, which was
|
||||
This file was extended by parallel $as_me 20101206, which was
|
||||
generated by GNU Autoconf 2.67. Invocation command line was
|
||||
|
||||
CONFIG_FILES = $CONFIG_FILES
|
||||
|
@ -2746,7 +2746,7 @@ _ACEOF
|
|||
cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1
|
||||
ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`"
|
||||
ac_cs_version="\\
|
||||
parallel config.status 20101202
|
||||
parallel config.status 20101206
|
||||
configured by $0, generated by GNU Autoconf 2.67,
|
||||
with options \\"\$ac_cs_config\\"
|
||||
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
AC_INIT([parallel], [20101202], [bug-parallel@gnu.org])
|
||||
AC_INIT([parallel], [20101206], [bug-parallel@gnu.org])
|
||||
AM_INIT_AUTOMAKE([-Wall -Werror foreign])
|
||||
AC_CONFIG_HEADERS([config.h])
|
||||
AC_CONFIG_FILES([
|
||||
|
|
|
@ -140,6 +140,9 @@ New in this release:
|
|||
* Implemented --load to wait until the load is below a limit before
|
||||
starting another job on that computer.
|
||||
|
||||
* Implemented --nice set the niceness of jobs running both locally and
|
||||
remotely.
|
||||
|
||||
* Review with focus on clusters. Thanks to Taylor Gillespie
|
||||
http://www.unixpronews.com/unixpronews-49-20101019GNUParallelSpeedUpProcessingWithMulticoresClusters.html
|
||||
|
||||
|
|
|
@ -2,9 +2,9 @@ bin_SCRIPTS = parallel sem sql niceload
|
|||
man_MANS = parallel.1 sem.1 sql.1 niceload.1
|
||||
doc_DATA = parallel.html sem.html sql.html niceload.html
|
||||
|
||||
parallel.1: parallel Makefile
|
||||
parallel.1: parallel.pod Makefile
|
||||
pod2man --release='$(PACKAGE_VERSION)' --center='$(PACKAGE_NAME)' \
|
||||
--section=1 $(srcdir)/parallel > $(srcdir)/parallel.1
|
||||
--section=1 $(srcdir)/parallel.pod > $(srcdir)/parallel.1
|
||||
|
||||
sem.1: sem.pod Makefile
|
||||
pod2man --release='$(PACKAGE_VERSION)' --center='$(PACKAGE_NAME)' \
|
||||
|
@ -38,4 +38,7 @@ sem: parallel
|
|||
ln -fs parallel sem
|
||||
|
||||
DISTCLEANFILES = parallel.1 sem.1 sql.1 niceload.1 parallel.html sem.html sql.html niceload.html
|
||||
EXTRA_DIST = parallel sem sql niceload parallel.1 sem.1 sql.1 niceload.1 parallel.html sem.html sem.pod sql.html niceload.html
|
||||
EXTRA_DIST = parallel sem sql niceload \
|
||||
parallel.1 sem.1 sql.1 niceload.1 \
|
||||
parallel.html sem.html sql.html niceload.html \
|
||||
sem.pod parallel.pod
|
||||
|
|
|
@ -150,7 +150,11 @@ bin_SCRIPTS = parallel sem sql niceload
|
|||
man_MANS = parallel.1 sem.1 sql.1 niceload.1
|
||||
doc_DATA = parallel.html sem.html sql.html niceload.html
|
||||
DISTCLEANFILES = parallel.1 sem.1 sql.1 niceload.1 parallel.html sem.html sql.html niceload.html
|
||||
EXTRA_DIST = parallel sem sql niceload parallel.1 sem.1 sql.1 niceload.1 parallel.html sem.html sem.pod sql.html niceload.html
|
||||
EXTRA_DIST = parallel sem sql niceload \
|
||||
parallel.1 sem.1 sql.1 niceload.1 \
|
||||
parallel.html sem.html sql.html niceload.html \
|
||||
sem.pod parallel.pod
|
||||
|
||||
all: all-am
|
||||
|
||||
.SUFFIXES:
|
||||
|
@ -443,9 +447,9 @@ uninstall-man: uninstall-man1
|
|||
uninstall-man1
|
||||
|
||||
|
||||
parallel.1: parallel Makefile
|
||||
parallel.1: parallel.pod Makefile
|
||||
pod2man --release='$(PACKAGE_VERSION)' --center='$(PACKAGE_NAME)' \
|
||||
--section=1 $(srcdir)/parallel > $(srcdir)/parallel.1
|
||||
--section=1 $(srcdir)/parallel.pod > $(srcdir)/parallel.1
|
||||
|
||||
sem.1: sem.pod Makefile
|
||||
pod2man --release='$(PACKAGE_VERSION)' --center='$(PACKAGE_NAME)' \
|
||||
|
|
159
src/niceload
159
src/niceload
|
@ -1,4 +1,4 @@
|
|||
#!/usr/bin/perl -sw
|
||||
#!/usr/bin/perl -w
|
||||
|
||||
=head1 NAME
|
||||
|
||||
|
@ -6,9 +6,9 @@ niceload - run a program when the load is below a certain limit
|
|||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
B<niceload> [-v] [-n=nice] [-l=load] [-t=time] [-s=time|-f=factor] command
|
||||
B<niceload> [-v] [-n nice] [-l load] [-t time] [-s time|-f factor] command
|
||||
|
||||
B<niceload> [-v] [-n=nice] [-l=load] [-t=time] [-s=time|-f=factor] -p=PID
|
||||
B<niceload> [-v] [-n nice] [-l load] [-t time] [-s time|-f factor] -p=PID
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
|
@ -27,30 +27,30 @@ run 1 second, suspend (3.00-1.00) seconds, run 1 second, suspend
|
|||
|
||||
=over 9
|
||||
|
||||
=item B<-n>=I<niceness>
|
||||
=item B<-n> I<niceness>
|
||||
|
||||
Sets niceness. See B<nice>(1).
|
||||
|
||||
=item B<-l>=I<maxload>
|
||||
=item B<-l> I<maxload>
|
||||
|
||||
Max load. The maximal load average before suspending command. Default
|
||||
is 1.00.
|
||||
|
||||
=item B<-t>=I<SEC>
|
||||
=item B<-t> I<SEC>
|
||||
|
||||
Recheck load time. Sleep SEC seconds before checking load
|
||||
again. Default is 1 second.
|
||||
|
||||
=item B<-s>=I<SEC>
|
||||
=item B<-s> I<SEC>
|
||||
|
||||
Suspend time. Suspend the command this many seconds when the max load
|
||||
average is reached.
|
||||
|
||||
=item B<-f>=I<FACTOR>
|
||||
=item B<-f> I<FACTOR>
|
||||
|
||||
Suspend time factor. Dynamically set B<-s> as max load average over limit * factor. Default is 1.
|
||||
|
||||
=item B<-p>=I<PID>
|
||||
=item B<-p> I<PID>
|
||||
|
||||
Process ID of process to suspend.
|
||||
|
||||
|
@ -67,7 +67,7 @@ In terminal 1 run: top
|
|||
|
||||
In terminal 2 run:
|
||||
|
||||
B<niceload perl -e '$|=1;do{$l==$r or print "."; $l=$r}until(($r=time-$^T)>50)'>
|
||||
B<niceload perl -e '$|=1;do{$l==$r or print "."; $l=$r}until(($r=time-$^T)>>B<50)'>
|
||||
|
||||
This will print a '.' every second for 50 seconds and eat a lot of
|
||||
CPU. When the load rises to 1.0 the process is suspended.
|
||||
|
@ -233,39 +233,46 @@ B<parallel>(1), B<nice>(1)
|
|||
|
||||
=cut
|
||||
|
||||
sub help {
|
||||
print q{
|
||||
Usage:
|
||||
niceload [-v] [-n=nice] [-l=load] [-t=time] [-s=time|-f=factor] command
|
||||
niceload [-v] [-n=nice] [-l=load] [-t=time] [-s=time|-f=factor] -p=PID
|
||||
};
|
||||
|
||||
use strict;
|
||||
use Getopt::Long;
|
||||
$Global::progname="niceload";
|
||||
$Global::version = 20101206;
|
||||
Getopt::Long::Configure("bundling","require_order");
|
||||
get_options_from_array(\@ARGV) || die_usage();
|
||||
if($::opt_version) {
|
||||
version();
|
||||
exit 0;
|
||||
}
|
||||
|
||||
if($f and $s) {
|
||||
# You cannot have -s and -f
|
||||
if($::opt_help) {
|
||||
help();
|
||||
exit 0;
|
||||
}
|
||||
if($::opt_factor and $::opt_suspend) {
|
||||
# You cannot have --suspend and --factor
|
||||
help();
|
||||
exit;
|
||||
}
|
||||
|
||||
my $nice = $n || 0; # -n=0 Nice level (Default: 0)
|
||||
my $max_load = $l || 1; # -l=1 Max acceptable load average (Default: 1)
|
||||
my $check_time = $t || 1; # -t=1 Seconds between checking load average (Default: 1)
|
||||
my $nice = $::opt_nice || 0; # -n=0 Nice level (Default: 0)
|
||||
my $max_load = $::opt_load || 1; # -l=1 Max acceptable load average (Default: 1)
|
||||
my $check_time = $::opt_recheck || 1; # -t=1 Seconds between checking load average (Default: 1)
|
||||
my $wait_factor;
|
||||
my $wait_time;
|
||||
if($s) {
|
||||
$wait_time = $s; # -s=sec Seconds to suspend process when load average is too high
|
||||
if($::opt_suspend) {
|
||||
# --suspend=sec Seconds to suspend process when load average is too high
|
||||
$wait_time = $::opt_suspend;
|
||||
} else {
|
||||
$wait_factor=$f || 1; # -f=1 compute wait_time dynamically as (load - limit) * factor
|
||||
# --factor=1 compute wait_time dynamically as (load - limit) * factor
|
||||
$wait_factor=$::opt_factor || 1;
|
||||
}
|
||||
my $processid = $p; # Control this PID (Default: control the command)
|
||||
my $verbose = $v || $debug;
|
||||
|
||||
@program = @ARGV;
|
||||
my $processid = $::opt_pid; # Control this PID (Default: control the command)
|
||||
my $verbose = $::opt_verbose || $::opt_debug;
|
||||
my @program = @ARGV;
|
||||
$SIG{CHLD} = \&REAPER;
|
||||
|
||||
if($processid) {
|
||||
$Child::fork = $processid;
|
||||
$::opt_verbose and print STDERR "Control $processid\n";
|
||||
init_signal_handling_attached_child();
|
||||
my $child_pgrp = getpgrp $Child::fork;
|
||||
suspend_resume($max_load,$check_time,$wait_time,$wait_factor,$child_pgrp);
|
||||
|
@ -277,13 +284,13 @@ if($processid) {
|
|||
suspend_resume($max_load,$check_time,$wait_time,$wait_factor,$child_pgrp);
|
||||
} else {
|
||||
setpgrp(0,0);
|
||||
$debug and debug("Child pid: $$, pgrp: ",getpgrp $$,"\n");
|
||||
debug("Child pid: $$, pgrp: ",getpgrp $$,"\n");
|
||||
if($nice) {
|
||||
unshift(@program,"nice","-n",$nice);
|
||||
}
|
||||
$debug and debug("@program\n");
|
||||
debug("@program\n");
|
||||
system(@program);
|
||||
$debug and debug("Child exit\n");
|
||||
debug("Child exit\n");
|
||||
exit;
|
||||
}
|
||||
} else {
|
||||
|
@ -291,10 +298,74 @@ if($processid) {
|
|||
exit;
|
||||
}
|
||||
|
||||
sub debug {
|
||||
print STDERR @_;
|
||||
sub get_options_from_array {
|
||||
# Run GetOptions on @array
|
||||
# Returns:
|
||||
# true if parsing worked
|
||||
# false if parsing failed
|
||||
# @array is changed
|
||||
my $array_ref = shift;
|
||||
# A bit of shuffling of @ARGV needed as GetOptionsFromArray is not
|
||||
# supported everywhere
|
||||
my @save_argv;
|
||||
my $this_is_ARGV = (\@::ARGV == $array_ref);
|
||||
if(not $this_is_ARGV) {
|
||||
@save_argv = @::ARGV;
|
||||
@::ARGV = @{$array_ref};
|
||||
}
|
||||
my @retval = GetOptions
|
||||
("debug|D" => \$::opt_debug,
|
||||
"load|l=s" => \$::opt_load,
|
||||
"factor|f=s" => \$::opt_factor,
|
||||
"suspend|s=s" => \$::opt_suspend,
|
||||
"recheck|t=s" => \$::opt_recheck,
|
||||
"nice|n=i" => \$::opt_nice,
|
||||
"help|h" => \$::opt_help,
|
||||
"process|pid|p=s" => \$::opt_pid,
|
||||
"verbose|v" => \$::opt_verbose,
|
||||
"version|V" => \$::opt_version,
|
||||
);
|
||||
if(not $this_is_ARGV) {
|
||||
@{$array_ref} = @::ARGV;
|
||||
@::ARGV = @save_argv;
|
||||
}
|
||||
return @retval;
|
||||
}
|
||||
|
||||
sub die_usage {
|
||||
help();
|
||||
exit 1;
|
||||
}
|
||||
|
||||
sub help {
|
||||
print q{
|
||||
Usage:
|
||||
niceload [-v] [-n=niceness] [-l=loadavg] [-t=recheck_sec] [-s=suspend_sec|-f=factor] command
|
||||
niceload [-v] [-n=niceness] [-l=loadavg] [-t=recheck_sec] [-s=suspend_sec|-f=factor] command
|
||||
};
|
||||
}
|
||||
|
||||
|
||||
|
||||
sub debug {
|
||||
if($::opt_debug) {
|
||||
print STDERR @_;
|
||||
}
|
||||
}
|
||||
|
||||
sub version {
|
||||
# Returns: N/A
|
||||
print join("\n",
|
||||
"GNU $Global::progname $Global::version",
|
||||
"Copyright (C) 2004,2005,2006,2007,2008,2009 Ole Tange",
|
||||
"Copyright (C) 2010 Ole Tange and Free Software Foundation, Inc.",
|
||||
"License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>",
|
||||
"This is free software: you are free to change and redistribute it.",
|
||||
"GNU $Global::progname comes with no warranty.",
|
||||
"",
|
||||
"Web site: http://www.gnu.org/software/parallel\n"
|
||||
);
|
||||
}
|
||||
|
||||
sub init_signal_handling_attached_child {
|
||||
$SIG{INT}=\&sigint_attached_child;
|
||||
|
@ -323,38 +394,38 @@ sub REAPER {
|
|||
}
|
||||
|
||||
sub kill_child_CONT {
|
||||
$debug and debug("SIGCONT received. Killing $Child::fork\n");
|
||||
debug("SIGCONT received. Killing $Child::fork\n");
|
||||
kill CONT => -getpgrp($Child::fork);
|
||||
}
|
||||
|
||||
sub kill_child_TSTP {
|
||||
$debug and debug("SIGTSTP received. Killing $Child::fork and self\n");
|
||||
debug("SIGTSTP received. Killing $Child::fork and self\n");
|
||||
kill TSTP => -getpgrp($Child::fork);
|
||||
kill STOP => -$$;
|
||||
}
|
||||
|
||||
sub kill_child_INT {
|
||||
$debug and debug("SIGINT received. Killing $Child::fork Exit\n");
|
||||
debug("SIGINT received. Killing $Child::fork Exit\n");
|
||||
kill INT => -getpgrp($Child::fork);
|
||||
exit;
|
||||
}
|
||||
|
||||
sub suspend_resume {
|
||||
my ($max_load,$check_time,$wait_time,$wait_factor,@pids) = @_;
|
||||
$debug and debug("suspend_resume these @pids\n");
|
||||
debug("suspend_resume these @pids\n");
|
||||
resume_pids(@pids);
|
||||
while (pids_exist(@pids)) {
|
||||
if ( loadavg() > $max_load ) {
|
||||
if($wait_factor) {
|
||||
$wait_time = (loadavg()-$max_load) * $wait_factor;
|
||||
}
|
||||
$verbose and debug("suspending for $wait_time seconds\n");
|
||||
$::opt_verbose and print STDERR "suspending for $wait_time seconds\n";
|
||||
suspend_pids(@pids);
|
||||
sleep 1; # for some reason this statement is skipped
|
||||
sleep $wait_time;
|
||||
resume_pids(@pids);
|
||||
}
|
||||
$verbose and debug("running for $check_time second(s)\n");
|
||||
$::opt_verbose and print STDERR "running for $check_time second(s)\n";
|
||||
sleep($check_time);
|
||||
}
|
||||
}
|
||||
|
@ -362,7 +433,7 @@ sub suspend_resume {
|
|||
sub pids_exist {
|
||||
my (@pids) = @_;
|
||||
my ($exists) = 0;
|
||||
for $pid (@pids) {
|
||||
for my $pid (@pids) {
|
||||
if(-e "/proc/".$pid) { $exists++ }
|
||||
#if(kill 0 => $Child::fork) { $exists++ }
|
||||
}
|
||||
|
@ -406,9 +477,7 @@ sub signal_pids {
|
|||
my ($signal,@pids) = @_;
|
||||
|
||||
# local $SIG{$signal} = 'IGNORE';
|
||||
for $pid (@pids) {
|
||||
for my $pid (@pids) {
|
||||
kill $signal => -$pid; # stop PID group
|
||||
}
|
||||
}
|
||||
|
||||
$v=$f=$l=$h=$n=$t=$s=$p=$h=$processid; # Ignore perl -w
|
||||
|
|
2520
src/parallel
2520
src/parallel
File diff suppressed because it is too large
Load diff
2518
src/parallel.pod
Normal file
2518
src/parallel.pod
Normal file
File diff suppressed because it is too large
Load diff
214
src/sem.pod
214
src/sem.pod
|
@ -217,217 +217,3 @@ Symbol, Fcntl.
|
|||
B<parallel>(1)
|
||||
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
use Symbol qw(gensym);
|
||||
use Getopt::Long;
|
||||
|
||||
Getopt::Long::Configure ("bundling","require_order");
|
||||
GetOptions("debug|D" => \$::opt_D,
|
||||
"id|i=s" => \$::opt_id,
|
||||
"count|j=i" => \$::opt_count,
|
||||
"fg" => \$::opt_fg,
|
||||
"timeout|t=i" => \$::opt_timeout,
|
||||
"version" => \$::opt_version,
|
||||
"wait|w" => \$::opt_wait,
|
||||
) || die_usage();
|
||||
$Global::debug = $::opt_D;
|
||||
$Global::version = 20100814;
|
||||
$Global::progname = 'sem';
|
||||
|
||||
my $count = 1; # Default 1 = mutex
|
||||
if($::opt_count) {
|
||||
$count = $::opt_count + 1;
|
||||
}
|
||||
if($::opt_wait) {
|
||||
$count = 1;
|
||||
}
|
||||
my $id = $::opt_id;
|
||||
my $fg = $::opt_fg || $::opt_wait;
|
||||
$::opt_timeout = $::opt_timeout;
|
||||
if(defined $::opt_version) {
|
||||
version();
|
||||
}
|
||||
|
||||
if(not defined $id) {
|
||||
# $id = getppid();
|
||||
# does not work with:
|
||||
# find . -name '*linux*' -exec sem -j1000 "sleep 3; echo `tty` '{}'" \; ; sem --wait echo done
|
||||
$id = `tty`;
|
||||
}
|
||||
$id = "id-$id";
|
||||
$id=~s/([^-_a-z0-9])/unpack("H*",$1)/ige; # Convert non-word chars to hex
|
||||
my $sem = Semaphore->new($id,$count);
|
||||
$sem->acquire();
|
||||
debug("run");
|
||||
if($fg) {
|
||||
system @ARGV;
|
||||
$sem->release();
|
||||
} else {
|
||||
# If run in the background, the PID will change
|
||||
# therefore release and re-acquire the semaphore
|
||||
$sem->release();
|
||||
if(not fork()) {
|
||||
# child
|
||||
# Get a semaphore for this pid
|
||||
my $child_sem = Semaphore->new($id,$count);
|
||||
$child_sem->acquire();
|
||||
system @ARGV;
|
||||
$child_sem->release();
|
||||
}
|
||||
}
|
||||
|
||||
sub version {
|
||||
# Returns: N/A
|
||||
print join("\n",
|
||||
"GNU $Global::progname $Global::version",
|
||||
"Copyright (C) 2010 Ole Tange and Free Software Foundation, Inc.",
|
||||
"License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>",
|
||||
"This is free software: you are free to change and redistribute it.",
|
||||
"GNU $Global::progname comes with no warranty.",
|
||||
"",
|
||||
"Web site: http://www.gnu.org/software/parallel\n"
|
||||
);
|
||||
}
|
||||
|
||||
sub usage {
|
||||
# Returns: N/A
|
||||
print "Usage:\n";
|
||||
print "$Global::progname [options] [command [arguments]] < list_of_arguments)\n";
|
||||
print "$Global::progname [options] [command [arguments]] ::: arguments\n";
|
||||
print "$Global::progname [options] [command [arguments]] :::: argfile(s)\n";
|
||||
print "\n";
|
||||
print "See 'man $Global::progname' for the options\n";
|
||||
}
|
||||
|
||||
sub die_usage {
|
||||
usage();
|
||||
exit(255);
|
||||
}
|
||||
|
||||
sub debug {
|
||||
# Returns: N/A
|
||||
$Global::debug or return;
|
||||
@_ = grep { defined $_ ? $_ : "" } @_;
|
||||
print map {$_,"\n" } @_;
|
||||
}
|
||||
|
||||
package Semaphore;
|
||||
|
||||
# This package provides a counting semaphore
|
||||
#
|
||||
# If a process dies without releasing the semaphore the next process
|
||||
# that needs that entry will clean up dead semaphores
|
||||
#
|
||||
# The semaphores are stored in ~/.parallel/semaphores/id-<name> Each
|
||||
# file in ~/.parallel/semaphores/id-<name>/ is the process ID of the
|
||||
# process holding the entry. If the process dies, the entry can be
|
||||
# taken by another process.
|
||||
|
||||
use Fcntl qw(:DEFAULT :flock);
|
||||
|
||||
sub new {
|
||||
my $class = shift;
|
||||
my $id = shift;
|
||||
my $count = shift;
|
||||
my $parallel_locks = $ENV{'HOME'}."/.parallel/semaphores";
|
||||
-d $parallel_locks or mkdir $parallel_locks;
|
||||
my $lockdir = "$parallel_locks/$id";
|
||||
my $lockfile = $lockdir.".lock";
|
||||
return bless {
|
||||
'lockfile' => $lockfile,
|
||||
'lockfh' => Symbol::gensym(),
|
||||
'lockdir' => $lockdir,
|
||||
'id' => $id,
|
||||
'idfile' => $lockdir."/".$id,
|
||||
'pid' => $$,
|
||||
'pidfile' => $lockdir."/".$$,
|
||||
'count' => $count
|
||||
}, ref($class) || $class;
|
||||
}
|
||||
|
||||
sub acquire {
|
||||
my $self = shift;
|
||||
while(1) {
|
||||
$self->atomic_link_if_count_less_than() and last;
|
||||
::debug("Remove dead locks");
|
||||
my $lockdir = $self->{'lockdir'};
|
||||
for my $d (<$lockdir/*>) {
|
||||
$d =~ m:$lockdir/([0-9]+):o or next;
|
||||
if(not kill 0, $1) {
|
||||
::debug("Dead: $d");
|
||||
unlink $d;
|
||||
} else {
|
||||
::debug("Alive: $d");
|
||||
}
|
||||
}
|
||||
# try again
|
||||
$self->atomic_link_if_count_less_than() and last;
|
||||
sleep 1;
|
||||
# TODO if timeout: last
|
||||
}
|
||||
::debug("got $self->{'pid'}");
|
||||
}
|
||||
|
||||
sub release {
|
||||
my ($self) = shift;
|
||||
unlink $self->{'pidfile'};
|
||||
if($self->nlinks() == 1) {
|
||||
# This is the last link, so atomic cleanup
|
||||
$self->lock();
|
||||
if($self->nlinks() == 1) {
|
||||
unlink $self->{'idfile'};
|
||||
rmdir $self->{'lockdir'};
|
||||
}
|
||||
$self->unlock();
|
||||
}
|
||||
::debug("released $self->{'pid'}");
|
||||
}
|
||||
|
||||
|
||||
sub atomic_link_if_count_less_than {
|
||||
# Link $file1 to $file2 if nlinks to $file1 < $count
|
||||
my ($self) = shift;
|
||||
my ($retval) = 0;
|
||||
$self->lock();
|
||||
if($self->nlinks() < $count) {
|
||||
-d $self->{'lockdir'} || mkdir $self->{'lockdir'};
|
||||
if(not -e $self->{'idfile'}) {
|
||||
open (A, ">", $self->{'idfile'}) or die ">$self->{'idfile'}";
|
||||
close A;
|
||||
}
|
||||
$retval = link $self->{'idfile'}, $self->{'pidfile'};
|
||||
}
|
||||
$self->unlock();
|
||||
::debug("atomic $retval");
|
||||
return $retval;
|
||||
}
|
||||
|
||||
sub nlinks {
|
||||
my $self = shift;
|
||||
if(-e $self->{'idfile'}) {
|
||||
return (stat(_))[3];
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
sub lock {
|
||||
my ($self) = shift;
|
||||
open $self->{'lockfh'}, ">", $self->{'lockfile'}
|
||||
or die "Can't open semaphore file $self->{'lockfile'}: $!";
|
||||
chmod 0666, $self->{'lockfile'}; # assuming you want it a+rw
|
||||
while(not flock $self->{'lockfh'}, LOCK_EX()|LOCK_NB()) {
|
||||
::debug("Cannot lock $self->{'lockfile'}");
|
||||
# TODO if timeout: last
|
||||
sleep 1;
|
||||
}
|
||||
::debug("locked $self->{'lockfile'}");
|
||||
}
|
||||
|
||||
sub unlock {
|
||||
my $self = shift;
|
||||
unlink $self->{'lockfile'};
|
||||
close $self->{'lockfh'};
|
||||
::debug("unlocked");
|
||||
}
|
||||
|
|
2
src/sql
2
src/sql
|
@ -528,7 +528,7 @@ $Global::Initfile && unlink $Global::Initfile;
|
|||
exit ($err);
|
||||
|
||||
sub parse_options {
|
||||
$Global::version = 20101202;
|
||||
$Global::version = 20101206;
|
||||
$Global::progname = 'sql';
|
||||
|
||||
# This must be done first as this may exec myself
|
||||
|
|
11
testsuite/tests-to-run/niceload01.sh
Normal file
11
testsuite/tests-to-run/niceload01.sh
Normal file
|
@ -0,0 +1,11 @@
|
|||
#!/bin/bash
|
||||
|
||||
echo '### Test niceload'
|
||||
niceload -s 1 perl -e '$|=1;do{$l==$r or print "."; $l=$r}until(($r=time-$^T)>10)'
|
||||
echo
|
||||
|
||||
#echo '### Test niceload -p'
|
||||
#sleep 3 &
|
||||
#nice-load -v -p $!
|
||||
|
||||
|
25
testsuite/tests-to-run/test43.sh
Normal file
25
testsuite/tests-to-run/test43.sh
Normal file
|
@ -0,0 +1,25 @@
|
|||
#!/bin/bash
|
||||
|
||||
# Assume /dev/shm is easy to fill up
|
||||
mkdir -p /dev/shm/parallel
|
||||
|
||||
echo '### Test $TMPDIR'
|
||||
TMPDIR=/dev/shm/parallel stdout timeout -k 1 6 parallel head -c 2000m '<'{} >/dev/null ::: /dev/zero &
|
||||
seq 1 20 | parallel -j1 "df /dev/shm | parallel -k --colsep ' +' echo {4}|tail -n 1;sleep 1" \
|
||||
| stdout timeout -k 1 10 perl -ne 'BEGIN{$a=<>} $b=<>; if ($a-1000 > $b) { die "More than 1 MB gone. Good!" }'
|
||||
wait
|
||||
sleep 1
|
||||
|
||||
echo '### Test --tmpdir'
|
||||
stdout timeout -k 1 6 parallel --tmpdir /dev/shm/parallel head -c 2000m '<'{} >/dev/null ::: /dev/zero &
|
||||
seq 1 20 | parallel -j1 "df /dev/shm | parallel -k --colsep ' +' echo {4}|tail -n 1;sleep 1" \
|
||||
| stdout timeout -k 1 10 perl -ne 'BEGIN{$a=<>} $b=<>; if ($a-1000 > $b) { die "More than 1 MB gone. Good!" }'
|
||||
wait
|
||||
sleep 1
|
||||
|
||||
echo '### Test $TMPDIR and --tmpdir'
|
||||
TMPDIR=/tmp stdout timeout -k 1 6 parallel --tmpdir /dev/shm/parallel head -c 2000m '<'{} >/dev/null ::: /dev/zero &
|
||||
seq 1 20 | parallel -j1 "df /dev/shm | parallel -k --colsep ' +' echo {4}|tail -n 1;sleep 1" \
|
||||
| stdout timeout -k 1 10 perl -ne 'BEGIN{$a=<>} $b=<>; if ($a-1000 > $b) { die "More than 1 MB gone. Good!" }'
|
||||
wait
|
||||
sleep 1
|
|
@ -1,6 +1,5 @@
|
|||
#!/bin/bash
|
||||
|
||||
|
||||
SERVER1=parallel-server3
|
||||
SERVER2=parallel-server2
|
||||
|
||||
|
|
6
testsuite/wanted-results/test43
Normal file
6
testsuite/wanted-results/test43
Normal file
|
@ -0,0 +1,6 @@
|
|||
### Test $TMPDIR
|
||||
More than 1 MB gone. Good! at -e line 1, <> line 3.
|
||||
### Test --tmpdir
|
||||
More than 1 MB gone. Good! at -e line 1, <> line 3.
|
||||
### Test $TMPDIR and --tmpdir
|
||||
More than 1 MB gone. Good! at -e line 1, <> line 3.
|
Loading…
Reference in a new issue