view release on metacpan or  search on metacpan

vendor/rocksdb/build_tools/gnu_parallel  view on Meta::CPAN

    if(not defined $self->{'control_path_dir'}) {
        -e $ENV{'HOME'}."/.parallel" or mkdir $ENV{'HOME'}."/.parallel";
        -e $ENV{'HOME'}."/.parallel/tmp" or mkdir $ENV{'HOME'}."/.parallel/tmp";
        $self->{'control_path_dir'} =
	    File::Temp::tempdir($ENV{'HOME'}
				. "/.parallel/tmp/control_path_dir-XXXX",
				CLEANUP => 1);
    }
    return $self->{'control_path_dir'};
}

sub rsync_transfer_cmd {
    # Command to run to transfer a file
    # Input:
    #   $file = filename of file to transfer
    #   $workdir = destination dir
    # Returns:
    #   $cmd = rsync command to run to transfer $file ("" if unreadable)
    my $self = shift;
    my $file = shift;
    my $workdir = shift;
    if(not -r $file) {
	::warning($file, " is not readable and will not be transferred.\n");
	return "true";
    }
    my $rsync_destdir;
    if($file =~ m:^/:) {
	# rsync /foo/bar /
	$rsync_destdir = "/";
    } else {
	$rsync_destdir = ::shell_quote_file($workdir);
    }
    $file = ::shell_quote_file($file);
    my $sshcmd = $self->sshcommand();
    my $rsync_opt = "-rlDzR -e" . ::shell_quote_scalar($sshcmd);
    my $serverlogin = $self->serverlogin();
    # Make dir if it does not exist
    return "( $sshcmd $serverlogin mkdir -p $rsync_destdir;" .
	rsync()." $rsync_opt $file $serverlogin:$rsync_destdir )";
}

sub cleanup_cmd {
    # Command to run to remove the remote file
    # Input:
    #   $file = filename to remove
    #   $workdir = destination dir
    # Returns:
    #   $cmd = ssh command to run to remove $file and empty parent dirs
    my $self = shift;
    my $file = shift;
    my $workdir = shift;
    my $f = $file;
    if($f =~ m:/\./:) {
	# foo/bar/./baz/quux => workdir/baz/quux
	# /foo/bar/./baz/quux => workdir/baz/quux
	$f =~ s:.*/\./:$workdir/:;
    } elsif($f =~ m:^[^/]:) {
	# foo/bar => workdir/foo/bar
	$f = $workdir."/".$f;
    }
    my @subdirs = split m:/:, ::dirname($f);
    my @rmdir;
    my $dir = "";
    for(@subdirs) {
	$dir .= $_."/";
	unshift @rmdir, ::shell_quote_file($dir);
    }
    my $rmdir = @rmdir ? "rmdir @rmdir 2>/dev/null;" : "";
    if(defined $opt::workdir and $opt::workdir eq "...") {
	$rmdir .= "rm -rf " . ::shell_quote_file($workdir).';';
    }

    $f = ::shell_quote_file($f);
    my $sshcmd = $self->sshcommand();
    my $serverlogin = $self->serverlogin();
    return "$sshcmd $serverlogin ".::shell_quote_scalar("(rm -f $f; $rmdir)");
}

{
    my $rsync;

    sub rsync {
	# rsync 3.1.x uses protocol 31 which is unsupported by 2.5.7.
	# If the version >= 3.1.0: downgrade to protocol 30
	if(not $rsync) {
	    my @out = `rsync --version`;
	    for (@out) {
		if(/version (\d+.\d+)(.\d+)?/) {
		    if($1 >= 3.1) {
			# Version 3.1.0 or later: Downgrade to protocol 30
			$rsync = "rsync --protocol 30";
		    } else {
			$rsync = "rsync";
		    }
		}
	    }
	    $rsync or ::die_bug("Cannot figure out version of rsync: @out");
	}
	return $rsync;
    }
}


package JobQueue;

sub new {
    my $class = shift;
    my $commandref = shift;
    my $read_from = shift;
    my $context_replace = shift;
    my $max_number_of_args = shift;
    my $return_files = shift;
    my $commandlinequeue = CommandLineQueue->new
	($commandref, $read_from, $context_replace, $max_number_of_args,
	 $return_files);
    my @unget = ();
    return bless {
        'unget' => \@unget,
        'commandlinequeue' => $commandlinequeue,
        'total_jobs' => undef,
    }, ref($class) || $class;