mirror of
https://git.savannah.gnu.org/git/parallel.git
synced 2024-11-22 14:07:55 +00:00
Added sem - semaphore for executing shell command lines in parallel
This commit is contained in:
parent
48c89d6929
commit
422578c103
|
@ -64,8 +64,8 @@
|
||||||
'AM_SET_LEADING_DOT' => 1,
|
'AM_SET_LEADING_DOT' => 1,
|
||||||
'AM_SET_DEPDIR' => 1,
|
'AM_SET_DEPDIR' => 1,
|
||||||
'_AM_DEPENDENCIES' => 1,
|
'_AM_DEPENDENCIES' => 1,
|
||||||
'm4_include' => 1,
|
|
||||||
'AM_PROG_INSTALL_SH' => 1,
|
'AM_PROG_INSTALL_SH' => 1,
|
||||||
|
'm4_include' => 1,
|
||||||
'_AC_AM_CONFIG_HEADER_HOOK' => 1,
|
'_AC_AM_CONFIG_HEADER_HOOK' => 1,
|
||||||
'AU_DEFUN' => 1,
|
'AU_DEFUN' => 1,
|
||||||
'AM_MAKE_INCLUDE' => 1
|
'AM_MAKE_INCLUDE' => 1
|
||||||
|
@ -83,25 +83,25 @@
|
||||||
'configure.ac'
|
'configure.ac'
|
||||||
],
|
],
|
||||||
{
|
{
|
||||||
'AM_PROG_F77_C_O' => 1,
|
|
||||||
'_LT_AC_TAGCONFIG' => 1,
|
'_LT_AC_TAGCONFIG' => 1,
|
||||||
'AC_INIT' => 1,
|
'AM_PROG_F77_C_O' => 1,
|
||||||
'm4_pattern_forbid' => 1,
|
'm4_pattern_forbid' => 1,
|
||||||
'AC_CANONICAL_TARGET' => 1,
|
'AC_INIT' => 1,
|
||||||
'_AM_COND_IF' => 1,
|
'_AM_COND_IF' => 1,
|
||||||
'AC_CONFIG_LIBOBJ_DIR' => 1,
|
'AC_CANONICAL_TARGET' => 1,
|
||||||
'AC_SUBST' => 1,
|
'AC_SUBST' => 1,
|
||||||
'AC_CANONICAL_HOST' => 1,
|
'AC_CONFIG_LIBOBJ_DIR' => 1,
|
||||||
'AC_FC_SRCEXT' => 1,
|
'AC_FC_SRCEXT' => 1,
|
||||||
|
'AC_CANONICAL_HOST' => 1,
|
||||||
'AC_PROG_LIBTOOL' => 1,
|
'AC_PROG_LIBTOOL' => 1,
|
||||||
'AM_INIT_AUTOMAKE' => 1,
|
'AM_INIT_AUTOMAKE' => 1,
|
||||||
'AC_CONFIG_SUBDIRS' => 1,
|
'AC_CONFIG_SUBDIRS' => 1,
|
||||||
'AM_AUTOMAKE_VERSION' => 1,
|
'AM_AUTOMAKE_VERSION' => 1,
|
||||||
'LT_CONFIG_LTDL_DIR' => 1,
|
'LT_CONFIG_LTDL_DIR' => 1,
|
||||||
'AC_CONFIG_LINKS' => 1,
|
|
||||||
'AC_REQUIRE_AUX_FILE' => 1,
|
'AC_REQUIRE_AUX_FILE' => 1,
|
||||||
'LT_SUPPORTED_TAG' => 1,
|
'AC_CONFIG_LINKS' => 1,
|
||||||
'm4_sinclude' => 1,
|
'm4_sinclude' => 1,
|
||||||
|
'LT_SUPPORTED_TAG' => 1,
|
||||||
'AM_MAINTAINER_MODE' => 1,
|
'AM_MAINTAINER_MODE' => 1,
|
||||||
'AM_GNU_GETTEXT_INTL_SUBDIR' => 1,
|
'AM_GNU_GETTEXT_INTL_SUBDIR' => 1,
|
||||||
'_m4_warn' => 1,
|
'_m4_warn' => 1,
|
||||||
|
@ -114,17 +114,17 @@
|
||||||
'include' => 1,
|
'include' => 1,
|
||||||
'AM_GNU_GETTEXT' => 1,
|
'AM_GNU_GETTEXT' => 1,
|
||||||
'AC_LIBSOURCE' => 1,
|
'AC_LIBSOURCE' => 1,
|
||||||
'AC_CANONICAL_BUILD' => 1,
|
|
||||||
'AM_PROG_FC_C_O' => 1,
|
'AM_PROG_FC_C_O' => 1,
|
||||||
|
'AC_CANONICAL_BUILD' => 1,
|
||||||
'AC_FC_FREEFORM' => 1,
|
'AC_FC_FREEFORM' => 1,
|
||||||
'AH_OUTPUT' => 1,
|
'AH_OUTPUT' => 1,
|
||||||
'AC_CONFIG_AUX_DIR' => 1,
|
|
||||||
'_AM_SUBST_NOTMAKE' => 1,
|
'_AM_SUBST_NOTMAKE' => 1,
|
||||||
'AM_PROG_CC_C_O' => 1,
|
'AC_CONFIG_AUX_DIR' => 1,
|
||||||
'm4_pattern_allow' => 1,
|
|
||||||
'sinclude' => 1,
|
'sinclude' => 1,
|
||||||
'AM_CONDITIONAL' => 1,
|
'm4_pattern_allow' => 1,
|
||||||
|
'AM_PROG_CC_C_O' => 1,
|
||||||
'AC_CANONICAL_SYSTEM' => 1,
|
'AC_CANONICAL_SYSTEM' => 1,
|
||||||
|
'AM_CONDITIONAL' => 1,
|
||||||
'AC_CONFIG_HEADERS' => 1,
|
'AC_CONFIG_HEADERS' => 1,
|
||||||
'AC_DEFINE_TRACE_LITERAL' => 1,
|
'AC_DEFINE_TRACE_LITERAL' => 1,
|
||||||
'm4_include' => 1,
|
'm4_include' => 1,
|
||||||
|
|
|
@ -1,14 +1,11 @@
|
||||||
Added --sshloginfile .. or -S .. means use ~/.parallel/sshloginfile
|
# sem -j+0
|
||||||
|
# sem gzip foo ";" echo done
|
||||||
Changed .parallelrc to .parallel/config to avoid having two files in ~/
|
|
||||||
|
|
||||||
|
|
||||||
# Allow 7 to run. After then 7th is started, block untill one is dead
|
# Allow 7 to run. After then 7th is started, block untill one is dead
|
||||||
parallel --mutex uniqidentifier -j7 command
|
parallel --mutex uniqidentifier -j7 command
|
||||||
parallel --automutex -j7 command
|
parallel --automutex -j7 command
|
||||||
mdm.screen find dir -execdir mdm-run cmd {} \;
|
mdm.screen find dir -execdir mdm-run cmd {} \;
|
||||||
find dir -execdir parallel --automutex cmd {} \;
|
find dir -execdir parallel --automutex cmd {} \;
|
||||||
getppid
|
|
||||||
|
|
||||||
fex syntax for splitting fields
|
fex syntax for splitting fields
|
||||||
http://www.semicomplete.com/projects/fex/
|
http://www.semicomplete.com/projects/fex/
|
||||||
|
|
|
@ -93,6 +93,8 @@ New in this release:
|
||||||
|
|
||||||
* --trim can remove white space around arguments.
|
* --trim can remove white space around arguments.
|
||||||
|
|
||||||
|
* NixOS package. Thanks to Ludovic Courtès <ludo at gnu dot org>
|
||||||
|
|
||||||
* Zero install package. Thanks to Tim Cuthbertson <tim3d dot junk at
|
* Zero install package. Thanks to Tim Cuthbertson <tim3d dot junk at
|
||||||
gmail dot com>
|
gmail dot com>
|
||||||
|
|
||||||
|
|
|
@ -1,14 +1,22 @@
|
||||||
bin_SCRIPTS = parallel
|
bin_SCRIPTS = parallel sem
|
||||||
man_MANS = parallel.1
|
man_MANS = parallel.1 sem.1
|
||||||
doc_DATA = parallel.html
|
doc_DATA = parallel.html sem.html
|
||||||
|
|
||||||
parallel.1: parallel Makefile
|
parallel.1: parallel Makefile
|
||||||
pod2man --release='$(PACKAGE_VERSION)' --center='$(PACKAGE_NAME)' \
|
pod2man --release='$(PACKAGE_VERSION)' --center='$(PACKAGE_NAME)' \
|
||||||
--section=1 $(srcdir)/parallel > $(srcdir)/parallel.1
|
--section=1 $(srcdir)/parallel > $(srcdir)/parallel.1
|
||||||
|
|
||||||
|
sem.1: sem Makefile
|
||||||
|
pod2man --release='$(PACKAGE_VERSION)' --center='$(PACKAGE_NAME)' \
|
||||||
|
--section=1 $(srcdir)/sem > $(srcdir)/sem.1
|
||||||
|
|
||||||
parallel.html: parallel Makefile
|
parallel.html: parallel Makefile
|
||||||
pod2html $(srcdir)/parallel > $(srcdir)/parallel.html
|
pod2html $(srcdir)/parallel > $(srcdir)/parallel.html
|
||||||
rm $(srcdir)/pod2htm*
|
rm $(srcdir)/pod2htm*
|
||||||
|
|
||||||
DISTCLEANFILES = parallel.1 parallel.html
|
sem.html: sem Makefile
|
||||||
EXTRA_DIST = parallel parallel.1 parallel.html
|
pod2html $(srcdir)/sem > $(srcdir)/sem.html
|
||||||
|
rm $(srcdir)/pod2htm*
|
||||||
|
|
||||||
|
DISTCLEANFILES = parallel.1 sem.1 parallel.html sem.html
|
||||||
|
EXTRA_DIST = parallel sem parallel.1 sem.1 parallel.html sem.html
|
||||||
|
|
|
@ -146,11 +146,11 @@ target_alias = @target_alias@
|
||||||
top_build_prefix = @top_build_prefix@
|
top_build_prefix = @top_build_prefix@
|
||||||
top_builddir = @top_builddir@
|
top_builddir = @top_builddir@
|
||||||
top_srcdir = @top_srcdir@
|
top_srcdir = @top_srcdir@
|
||||||
bin_SCRIPTS = parallel
|
bin_SCRIPTS = parallel sem
|
||||||
man_MANS = parallel.1
|
man_MANS = parallel.1 sem.1
|
||||||
doc_DATA = parallel.html
|
doc_DATA = parallel.html sem.html
|
||||||
DISTCLEANFILES = parallel.1 parallel.html
|
DISTCLEANFILES = parallel.1 sem.1 parallel.html sem.html
|
||||||
EXTRA_DIST = parallel parallel.1 parallel.html
|
EXTRA_DIST = parallel sem parallel.1 sem.1 parallel.html sem.html
|
||||||
all: all-am
|
all: all-am
|
||||||
|
|
||||||
.SUFFIXES:
|
.SUFFIXES:
|
||||||
|
@ -447,10 +447,18 @@ parallel.1: parallel Makefile
|
||||||
pod2man --release='$(PACKAGE_VERSION)' --center='$(PACKAGE_NAME)' \
|
pod2man --release='$(PACKAGE_VERSION)' --center='$(PACKAGE_NAME)' \
|
||||||
--section=1 $(srcdir)/parallel > $(srcdir)/parallel.1
|
--section=1 $(srcdir)/parallel > $(srcdir)/parallel.1
|
||||||
|
|
||||||
|
sem.1: sem Makefile
|
||||||
|
pod2man --release='$(PACKAGE_VERSION)' --center='$(PACKAGE_NAME)' \
|
||||||
|
--section=1 $(srcdir)/sem > $(srcdir)/sem.1
|
||||||
|
|
||||||
parallel.html: parallel Makefile
|
parallel.html: parallel Makefile
|
||||||
pod2html $(srcdir)/parallel > $(srcdir)/parallel.html
|
pod2html $(srcdir)/parallel > $(srcdir)/parallel.html
|
||||||
rm $(srcdir)/pod2htm*
|
rm $(srcdir)/pod2htm*
|
||||||
|
|
||||||
|
sem.html: sem Makefile
|
||||||
|
pod2html $(srcdir)/sem > $(srcdir)/sem.html
|
||||||
|
rm $(srcdir)/pod2htm*
|
||||||
|
|
||||||
# Tell versions [3.59,3.63) of GNU make to not export all variables.
|
# Tell versions [3.59,3.63) of GNU make to not export all variables.
|
||||||
# Otherwise a system limit (for SysV at least) may be exceeded.
|
# Otherwise a system limit (for SysV at least) may be exceeded.
|
||||||
.NOEXPORT:
|
.NOEXPORT:
|
||||||
|
|
424
src/sem
Executable file
424
src/sem
Executable file
|
@ -0,0 +1,424 @@
|
||||||
|
#!/usr/bin/perl -w
|
||||||
|
|
||||||
|
=head1 NAME
|
||||||
|
|
||||||
|
sem - semaphore for executing shell command lines in parallel
|
||||||
|
|
||||||
|
=head1 SYNOPSIS
|
||||||
|
|
||||||
|
B<sem> [--fg] [--id <id>] [--timeout <secs>] [--count <num>] [--wait] command
|
||||||
|
|
||||||
|
=head1 DESCRIPTION
|
||||||
|
|
||||||
|
GNU B<sem> is a tool for executing shell commands in parallel. GNU
|
||||||
|
B<sem> acts as a counting semaphore. When GNU B<sem> is called with
|
||||||
|
command it will start the command in the background. When I<num>
|
||||||
|
number of commands are running in the background, GNU B<sem> will wait
|
||||||
|
for one of these to complete before starting another command.
|
||||||
|
|
||||||
|
GNU B<sem> is a supplement to GNU B<parallel> and can be used if the
|
||||||
|
loop is too complex to put into a GNU B<parallel> command.
|
||||||
|
|
||||||
|
Before looking at the options you may want to check out the examples
|
||||||
|
after the list of options. That will give you an idea of what GNU
|
||||||
|
B<sem> is capable of.
|
||||||
|
|
||||||
|
=head1 OPTIONS
|
||||||
|
|
||||||
|
=over 9
|
||||||
|
|
||||||
|
=item I<command>
|
||||||
|
|
||||||
|
Command to execute. The command may be followed by arguments for the command.
|
||||||
|
|
||||||
|
|
||||||
|
=item B<--count> I<N>
|
||||||
|
|
||||||
|
=item B<-j> I<N>
|
||||||
|
|
||||||
|
Run up to N commands in parallel. Default is 9.
|
||||||
|
|
||||||
|
|
||||||
|
=item B<--id> I<id>
|
||||||
|
|
||||||
|
=item B<-i> I<id>
|
||||||
|
|
||||||
|
Use B<id> as the name of the semaphore. Default is the name of the
|
||||||
|
controlling tty (output from B<tty>).
|
||||||
|
|
||||||
|
The default normally works as expected when used interactively, but
|
||||||
|
when used in a script I<id> should be set. $$ is often a good value.
|
||||||
|
|
||||||
|
|
||||||
|
=item B<--fg>
|
||||||
|
|
||||||
|
Do not put command in background.
|
||||||
|
|
||||||
|
|
||||||
|
=item B<--timeout> I<secs> (not implemented)
|
||||||
|
|
||||||
|
=item B<-t> I<secs> (not implemented)
|
||||||
|
|
||||||
|
If the semaphore is not released within I<secs> seconds, take it anyway.
|
||||||
|
|
||||||
|
|
||||||
|
=item B<--wait>
|
||||||
|
|
||||||
|
=item B<-w>
|
||||||
|
|
||||||
|
Wait for all commands to complete.
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
=head1 EXAMPLE: Gzipping *.log
|
||||||
|
|
||||||
|
for i in `ls *.log` ; do
|
||||||
|
echo $i
|
||||||
|
sem gzip $i ";" echo done
|
||||||
|
done
|
||||||
|
sem -w
|
||||||
|
|
||||||
|
|
||||||
|
=head1 BUGS
|
||||||
|
|
||||||
|
Quoting and composed commands are not working.
|
||||||
|
|
||||||
|
|
||||||
|
=head1 REPORTING BUGS
|
||||||
|
|
||||||
|
Report bugs to <bug-parallel@gnu.org>.
|
||||||
|
|
||||||
|
|
||||||
|
=head1 AUTHOR
|
||||||
|
|
||||||
|
Copyright (C) 2007-10-18 Ole Tange, http://ole.tange.dk
|
||||||
|
|
||||||
|
Copyright (C) 2008,2009,2010 Ole Tange, http://ole.tange.dk
|
||||||
|
|
||||||
|
Copyright (C) 2010 Ole Tange, http://ole.tange.dk and Free Software
|
||||||
|
Foundation, Inc.
|
||||||
|
|
||||||
|
Parts of the manual concerning B<xargs> compatibility is inspired by
|
||||||
|
the manual of B<xargs> from GNU findutils 4.4.2.
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
=head1 LICENSE
|
||||||
|
|
||||||
|
Copyright (C) 2007,2008,2009,2010 Free Software Foundation, Inc.
|
||||||
|
|
||||||
|
This program is free software; you can redistribute it and/or modify
|
||||||
|
it under the terms of the GNU General Public License as published by
|
||||||
|
the Free Software Foundation; either version 3 of the License, or
|
||||||
|
at your option any later version.
|
||||||
|
|
||||||
|
This program is distributed in the hope that it will be useful,
|
||||||
|
but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
GNU General Public License for more details.
|
||||||
|
|
||||||
|
You should have received a copy of the GNU General Public License
|
||||||
|
along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
|
=head2 Documentation license I
|
||||||
|
|
||||||
|
Permission is granted to copy, distribute and/or modify this documentation
|
||||||
|
under the terms of the GNU Free Documentation License, Version 1.3 or
|
||||||
|
any later version published by the Free Software Foundation; with no
|
||||||
|
Invariant Sections, with no Front-Cover Texts, and with no Back-Cover
|
||||||
|
Texts. A copy of the license is included in the file fdl.txt.
|
||||||
|
|
||||||
|
=head2 Documentation license II
|
||||||
|
|
||||||
|
You are free:
|
||||||
|
|
||||||
|
=over 9
|
||||||
|
|
||||||
|
=item B<to Share>
|
||||||
|
|
||||||
|
to copy, distribute and transmit the work
|
||||||
|
|
||||||
|
=item B<to Remix>
|
||||||
|
|
||||||
|
to adapt the work
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
Under the following conditions:
|
||||||
|
|
||||||
|
=over 9
|
||||||
|
|
||||||
|
=item B<Attribution>
|
||||||
|
|
||||||
|
You must attribute the work in the manner specified by the author or
|
||||||
|
licensor (but not in any way that suggests that they endorse you or
|
||||||
|
your use of the work).
|
||||||
|
|
||||||
|
=item B<Share Alike>
|
||||||
|
|
||||||
|
If you alter, transform, or build upon this work, you may distribute
|
||||||
|
the resulting work only under the same, similar or a compatible
|
||||||
|
license.
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
With the understanding that:
|
||||||
|
|
||||||
|
=over 9
|
||||||
|
|
||||||
|
=item B<Waiver>
|
||||||
|
|
||||||
|
Any of the above conditions can be waived if you get permission from
|
||||||
|
the copyright holder.
|
||||||
|
|
||||||
|
=item B<Public Domain>
|
||||||
|
|
||||||
|
Where the work or any of its elements is in the public domain under
|
||||||
|
applicable law, that status is in no way affected by the license.
|
||||||
|
|
||||||
|
=item B<Other Rights>
|
||||||
|
|
||||||
|
In no way are any of the following rights affected by the license:
|
||||||
|
|
||||||
|
=over 2
|
||||||
|
|
||||||
|
=item *
|
||||||
|
|
||||||
|
Your fair dealing or fair use rights, or other applicable
|
||||||
|
copyright exceptions and limitations;
|
||||||
|
|
||||||
|
=item *
|
||||||
|
|
||||||
|
The author's moral rights;
|
||||||
|
|
||||||
|
=item *
|
||||||
|
|
||||||
|
Rights other persons may have either in the work itself or in
|
||||||
|
how the work is used, such as publicity or privacy rights.
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
=over 9
|
||||||
|
|
||||||
|
=item B<Notice>
|
||||||
|
|
||||||
|
For any reuse or distribution, you must make clear to others the
|
||||||
|
license terms of this work.
|
||||||
|
|
||||||
|
=back
|
||||||
|
|
||||||
|
A copy of the full license is included in the file as cc-by-sa.txt.
|
||||||
|
|
||||||
|
=head1 DEPENDENCIES
|
||||||
|
|
||||||
|
GNU B<sem> uses Perl, and the Perl modules Getopt::Long,
|
||||||
|
Symbol, Fcntl.
|
||||||
|
|
||||||
|
|
||||||
|
=head1 SEE ALSO
|
||||||
|
|
||||||
|
B<parallel>(1)
|
||||||
|
|
||||||
|
=cut
|
||||||
|
|
||||||
|
use Symbol qw(gensym);
|
||||||
|
#use strict;
|
||||||
|
use Getopt::Long;
|
||||||
|
use Fcntl 'LOCK_EX', 'LOCK_NB';
|
||||||
|
|
||||||
|
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 = 9; # Default 9
|
||||||
|
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(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 @_;
|
||||||
|
}
|
||||||
|
|
||||||
|
package Semaphore;
|
||||||
|
|
||||||
|
sub new {
|
||||||
|
my $class = shift;
|
||||||
|
my $id = shift;
|
||||||
|
my $count = shift;
|
||||||
|
my $parallel_locks = $ENV{'HOME'}."/.parallel/locks";
|
||||||
|
-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");
|
||||||
|
}
|
Loading…
Reference in a new issue