mirror of
https://git.savannah.gnu.org/git/parallel.git
synced 2024-11-22 14:07:55 +00:00
christmastree: Initial version
parallel: use $0 as parallel command
This commit is contained in:
Ole Tange
parent
b511c409ad
commit
a800b4e3d6
313
src/christmastree
Normal file
313
src/christmastree
Normal file
|
|
@ -0,0 +1,313 @@
|
|||
#!/usr/bin/perl -w
|
||||
|
||||
# Copyright (C) 2007,2008,2009,2010,2011 Ole Tange and 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/>
|
||||
# or write to the Free Software Foundation, Inc., 51 Franklin St,
|
||||
# Fifth Floor, Boston, MA 02110-1301 USA
|
||||
|
||||
=head1 NAME
|
||||
|
||||
christmastree - use memory similar to a christmas tree profile
|
||||
|
||||
=head1 SYNOPSIS
|
||||
|
||||
B<christmastree> [-s I<per_second>] [-m I<min>] <max>
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
GNU B<christmastree> is a test script that increases and decreases its
|
||||
memory usage. The increase and descrease will happen at random, but
|
||||
the memory usage will grow on average.
|
||||
|
||||
=over 9
|
||||
|
||||
=item I<max>
|
||||
|
||||
The maximal amount of memory to use before exitting.
|
||||
|
||||
|
||||
=item B<-s> I<per_second>
|
||||
|
||||
The amount of memory it should grow per second on average. Default to max/10.
|
||||
|
||||
|
||||
=item B<-m> I<min>
|
||||
|
||||
The minimal amount of memory to use before exitting.
|
||||
|
||||
=back
|
||||
|
||||
|
||||
=head1 EXAMPLES
|
||||
|
||||
|
||||
|
||||
=head1 REPORTING BUGS
|
||||
|
||||
B<christmastree> is part of GNU B<parallel>. Report bugs to <bug-parallel@gnu.org>.
|
||||
|
||||
|
||||
=head1 AUTHOR
|
||||
|
||||
Copyright (C) 2011 Ole Tange, http://ole.tange.dk and Free
|
||||
Software Foundation, Inc.
|
||||
|
||||
=head1 LICENSE
|
||||
|
||||
Copyright (C) 2011 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 9
|
||||
|
||||
=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
|
||||
|
||||
=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
|
||||
|
||||
B<christmastree> uses Perl.
|
||||
|
||||
|
||||
=head1 SEE ALSO
|
||||
|
||||
B<parallel>(1)
|
||||
|
||||
=cut
|
||||
|
||||
use Getopt::Long;
|
||||
|
||||
parse_options();
|
||||
my $start_time = time;
|
||||
my $max = multiply_binary_prefix(shift);
|
||||
my $min = (multiply_binary_prefix($::opt_m) or $max);
|
||||
my $target_max = int(rand($max - $min)) + $min;
|
||||
my $per_second = (multiply_binary_prefix($::opt_s) or $target_max/10);
|
||||
my ($memusage,@a,$target,$this_round);
|
||||
|
||||
do {
|
||||
$memusage = my_memory_usage();
|
||||
$target = (time - $start_time)*int($per_second);
|
||||
$this_round = $target - my_memory_usage();
|
||||
if($this_round > 0) {
|
||||
my $a = "x"x(rand($this_round*3));
|
||||
push @a,$a;
|
||||
} else {
|
||||
pop @a;
|
||||
}
|
||||
debug("memusage $memusage target $target this_round $this_round target_max $target_max\n");
|
||||
usleep(500);
|
||||
} while($memusage < $target_max);
|
||||
|
||||
|
||||
sub debug {
|
||||
# Returns: N/A
|
||||
$Global::debug or return;
|
||||
@_ = grep { defined $_ ? $_ : "" } @_;
|
||||
if($Global::original_stdout) {
|
||||
print $Global::original_stdout @_;
|
||||
} else {
|
||||
print @_;
|
||||
}
|
||||
}
|
||||
|
||||
sub parse_options {
|
||||
$Global::version = 20110822;
|
||||
$Global::progname = 'christmastree';
|
||||
|
||||
Getopt::Long::Configure ("bundling","require_order");
|
||||
GetOptions("s=s" => \$::opt_s,
|
||||
"m=s" => \$::opt_m,
|
||||
"r=s" => \$::opt_r,
|
||||
"debug" => \$::opt_debug,
|
||||
# GNU requirements
|
||||
"help|h" => \$::opt_help,
|
||||
"version|V" => \$::opt_version,
|
||||
) || die_usage();
|
||||
|
||||
if(defined $::opt_r) { srand($::opt_r); }
|
||||
if(defined $::opt_help) { die_usage(); }
|
||||
if(defined $::opt_version) { version(); exit(0); }
|
||||
$Global::debug = $::opt_debug;
|
||||
}
|
||||
|
||||
sub usleep {
|
||||
# Sleep this many milliseconds.
|
||||
my $secs = shift;
|
||||
::debug("Sleeping ",$secs," millisecs\n");
|
||||
select(undef, undef, undef, $secs/1000);
|
||||
if($::opt_timeout) {
|
||||
::debug(my_dump($Global::timeoutq));
|
||||
$Global::timeoutq->process_timeouts();
|
||||
}
|
||||
}
|
||||
|
||||
sub undef_as_zero {
|
||||
my $a = shift;
|
||||
return $a ? $a : 0;
|
||||
}
|
||||
|
||||
sub undef_as_empty {
|
||||
my $a = shift;
|
||||
return $a ? $a : "";
|
||||
}
|
||||
|
||||
sub my_memory_usage {
|
||||
# Returns:
|
||||
# memory usage if found
|
||||
# 0 otherwise
|
||||
use strict;
|
||||
use FileHandle;
|
||||
|
||||
my $pid = $$;
|
||||
if(-e "/proc/$pid/stat") {
|
||||
my $fh = FileHandle->new("</proc/$pid/stat");
|
||||
|
||||
my $data = <$fh>;
|
||||
chomp $data;
|
||||
$fh->close;
|
||||
|
||||
my @procinfo = split(/\s+/,$data);
|
||||
|
||||
return undef_as_zero($procinfo[22]);
|
||||
} else {
|
||||
return 0;
|
||||
}
|
||||
}
|
||||
|
||||
sub multiply_binary_prefix {
|
||||
# Evalualte numbers with binary prefix
|
||||
# k=10^3, m=10^6, g=10^9, t=10^12, p=10^15, e=10^18, z=10^21, y=10^24
|
||||
# K=2^10, M=2^20, G=2^30, T=2^40, P=2^50, E=2^70, Z=2^80, Y=2^80
|
||||
# Ki=2^10, Mi=2^20, Gi=2^30, Ti=2^40, Pi=2^50, Ei=2^70, Zi=2^80, Yi=2^80
|
||||
# ki=2^10, mi=2^20, gi=2^30, ti=2^40, pi=2^50, ei=2^70, zi=2^80, yi=2^80
|
||||
# 13G = 13*1024*1024*1024 = 13958643712
|
||||
my $s = undef_as_empty(shift);
|
||||
$s =~ s/k/*1000/g;
|
||||
$s =~ s/M/*1000*1000/g;
|
||||
$s =~ s/G/*1000*1000*1000/g;
|
||||
$s =~ s/T/*1000*1000*1000*1000/g;
|
||||
$s =~ s/P/*1000*1000*1000*1000*1000/g;
|
||||
$s =~ s/E/*1000*1000*1000*1000*1000*1000/g;
|
||||
$s =~ s/Z/*1000*1000*1000*1000*1000*1000*1000/g;
|
||||
$s =~ s/Y/*1000*1000*1000*1000*1000*1000*1000*1000/g;
|
||||
$s =~ s/X/*1000*1000*1000*1000*1000*1000*1000*1000*1000/g;
|
||||
|
||||
$s =~ s/Ki?/*1024/gi;
|
||||
$s =~ s/Mi?/*1024*1024/gi;
|
||||
$s =~ s/Gi?/*1024*1024*1024/gi;
|
||||
$s =~ s/Ti?/*1024*1024*1024*1024/gi;
|
||||
$s =~ s/Pi?/*1024*1024*1024*1024*1024/gi;
|
||||
$s =~ s/Ei?/*1024*1024*1024*1024*1024*1024/gi;
|
||||
$s =~ s/Zi?/*1024*1024*1024*1024*1024*1024*1024/gi;
|
||||
$s =~ s/Yi?/*1024*1024*1024*1024*1024*1024*1024*1024/gi;
|
||||
$s =~ s/Xi?/*1024*1024*1024*1024*1024*1024*1024*1024*1024/gi;
|
||||
$s = eval $s;
|
||||
return $s;
|
||||
}
|
||||
|
||||
|
|
@ -98,9 +98,10 @@ if($::opt_nonall or $::opt_onall) {
|
|||
((defined $::opt_D) ? "-D" : ""),
|
||||
);
|
||||
::debug("| parallel");
|
||||
open(PARALLEL,"| parallel $options") || die;
|
||||
open(PARALLEL,"| $0 $options") ||
|
||||
::die_bug("This does not run GNU Parallel: $0 $options");
|
||||
for my $sshlogin (values %Global::host) {
|
||||
print PARALLEL "parallel $suboptions -j1 -S ".
|
||||
print PARALLEL "$0 $suboptions -j1 -S ".
|
||||
shell_quote_scalar($sshlogin->string())." ".
|
||||
shell_quote_scalar($command)." :::: @argfiles\n";
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in a new issue