mirror of
https://git.savannah.gnu.org/git/parallel.git
synced 2024-11-22 05:57:54 +00:00
parallel: --rpl implemented.
This commit is contained in:
Ole Tange
parent
f2dfb82a40
commit
0725d2e2f5
641
src/parallel
641
src/parallel
|
|
@ -97,7 +97,7 @@ if($opt::header and not $opt::pipe) {
|
|||
::debug("Colname: '$s'");
|
||||
# Replace {colname} with {2}
|
||||
# TODO accept configurable short hands
|
||||
# TODO how to deal with headers in {{...}}
|
||||
# TODO how to deal with headers in {=...=}
|
||||
for(@command) {
|
||||
s:\{$s(|/|//|\.|/\.)\}:\{$id$1\}:g;
|
||||
}
|
||||
|
|
@ -607,6 +607,7 @@ sub options_hash {
|
|||
"null|0" => \$opt::0,
|
||||
"quote|q" => \$opt::q,
|
||||
# Replacement strings
|
||||
"rpl=s" => \@opt::rpl,
|
||||
"I=s" => \$opt::I,
|
||||
"extensionreplace|er=s" => \$opt::U,
|
||||
"U=s" => \$opt::retired,
|
||||
|
|
@ -770,16 +771,20 @@ sub parse_options {
|
|||
#$Global::replace{'{/.}'} = '{/.}';
|
||||
#$Global::replace{'{#}'} = '{#}';
|
||||
#$Global::replace{'{%}'} = '{%}';
|
||||
|
||||
# Read only table with default --rpl values
|
||||
%Global::replace =
|
||||
(
|
||||
'{}' => '{{ $_=$_ }}',
|
||||
'{#}' => '{{ $_=$self->seq() }}',
|
||||
'{%}' => '{{ $_=$self->slot() }}',
|
||||
'{/}' => '{{ s:.*/:: }}',
|
||||
'{//}' => '{{ s:/[^/]+$:: }}',
|
||||
'{/.}' => '{{ s:.*/::; s:\.[^/.]+$::; }}',
|
||||
'{.}' => '{{ s:\.[^/.]+$:: }}',
|
||||
'{}' => '{= $_=$_ =}',
|
||||
'{#}' => '{= $_=$self->seq() =}',
|
||||
'{%}' => '{= $_=$self->slot() =}',
|
||||
'{/}' => '{= s:.*/:: =}',
|
||||
'{//}' => '{= s:/[^/]+$:: =}',
|
||||
'{/.}' => '{= s:.*/::; s:\.[^/.]+$::; =}',
|
||||
'{.}' => '{= s:\.[^/.]+$:: =}',
|
||||
);
|
||||
# Modifiable copy of %Global::replace
|
||||
%Global::rpl = %Global::replace;
|
||||
$/="\n";
|
||||
$Global::ignore_empty = 0;
|
||||
$Global::interactive = 0;
|
||||
|
|
@ -808,24 +813,21 @@ sub parse_options {
|
|||
if(defined $opt::q) { $Global::quoting = 1; }
|
||||
if(defined $opt::r) { $Global::ignore_empty = 1; }
|
||||
if(defined $opt::verbose) { $Global::stderr_verbose = 1; }
|
||||
if(defined $opt::I) { @Global::replace{$opt::I} = ($Global::replace{'{}'}) }
|
||||
if(defined $opt::U) { $Global::replace{'{.}'} = $opt::U; }
|
||||
if(defined $opt::i) {
|
||||
$Global::replace{'{}'} = $opt::i eq "" ? "{}" : $opt::i;
|
||||
}
|
||||
if(defined $opt::basenamereplace) { $Global::replace{'{/}'} = $opt::basenamereplace; }
|
||||
if(defined $opt::dirnamereplace) { $Global::replace{'{//}'} = $opt::dirnamereplace; }
|
||||
if(defined $opt::I) { rpl('{}',$opt::I); }
|
||||
if(defined $opt::U) { rpl('{.}',$opt::U); }
|
||||
if(defined $opt::i and $opt::i) { rpl('{}',$opt::i); }
|
||||
if(defined $opt::basenamereplace) { rpl('{/}',$opt::basenamereplace); }
|
||||
if(defined $opt::dirnamereplace) { rpl('{//}',$opt::dirnamereplace); }
|
||||
if(defined $opt::seqreplace) { rpl('{#}',$opt::seqreplace); }
|
||||
if(defined $opt::I) { rpl('{}',$opt::I); }
|
||||
if(defined $opt::slotreplace) { rpl('{%}',$opt::slotreplace); }
|
||||
if(defined $opt::basenameextensionreplace) {
|
||||
$Global::replace{'{/.}'} = $opt::basenameextensionreplace;
|
||||
}
|
||||
if(defined $opt::seqreplace) {
|
||||
$Global::replace{'{#}'} = $opt::seqreplace;
|
||||
}
|
||||
if(defined $opt::I) { @Global::replace{$opt::I} = ($Global::replace{'{}'}) }
|
||||
if(defined $opt::slotreplace) {
|
||||
$Global::replace{$opt::slotreplace} = $Global::replace{'%'};
|
||||
# TODO $Global::replace{'%'} = undef unless $opt::slotreplace == %
|
||||
rpl('{/.}',$opt::basenameextensionreplace);
|
||||
}
|
||||
for(@opt::rpl) {
|
||||
my ($shorthand,$long) = split/ /,$_,2;
|
||||
$Global::rpl{$shorthand} = $long;
|
||||
}
|
||||
if(defined $opt::E) { $Global::end_of_file_string = $opt::E; }
|
||||
if(defined $opt::max_args) { $Global::max_number_of_args = $opt::max_args; }
|
||||
if(defined $opt::timeout) { $Global::timeoutq = TimeoutQueue->new($opt::timeout); }
|
||||
|
|
@ -942,7 +944,7 @@ sub parse_options {
|
|||
# for (keys %Global::replace) {
|
||||
# $Global::replace{$_} = ::maybe_quote($Global::replace{$_});
|
||||
# }
|
||||
%Global::replace_rev = reverse %Global::replace;
|
||||
# %Global::replace_rev = reverse %Global::replace;
|
||||
if(defined $opt::tag and not defined $opt::tagstring) {
|
||||
$opt::tagstring = $Global::replace{'{}'};
|
||||
}
|
||||
|
|
@ -1014,6 +1016,14 @@ sub parse_options {
|
|||
open_joblog();
|
||||
}
|
||||
|
||||
sub rpl {
|
||||
# Modify %Global::rpl
|
||||
# Replace $old with $new
|
||||
my ($old,$new) = @_;
|
||||
$Global::rpl{$new} = $Global::rpl{$old};
|
||||
delete $Global::rpl{$old};
|
||||
}
|
||||
|
||||
sub env_quote {
|
||||
my $v = $_[0];
|
||||
$v =~ s/([\\])/\\$1/g;
|
||||
|
|
@ -1799,7 +1809,7 @@ sub progress {
|
|||
$eta = sprintf("ETA: %ds Left: %d AVG: %.2fs ", $this_eta, $left, $avgtime);
|
||||
if($opt::bar) {
|
||||
my $arg = $Global::newest_job ?
|
||||
$Global::newest_job->{'commandline'}->simple_replace_placeholders($Global::replace{"{}"}) : "";
|
||||
$Global::newest_job->{'commandline'}->replace_placeholders([$Global::replace{"{}"}],0) : "";
|
||||
my $bar_text = sprintf("%d%% %d:%d=%ds %s",
|
||||
$pctcomplete*100, $completed, $left, $this_eta, $arg);
|
||||
my $rev = '[7m';
|
||||
|
|
@ -4997,8 +5007,8 @@ sub returnsize {
|
|||
}
|
||||
|
||||
sub sshreturn {
|
||||
# Returns for each return-file:
|
||||
# rsync remote:$workdir/$file .
|
||||
# Returns for each return-file:
|
||||
# rsync remote:$workdir/$file .
|
||||
my $self = shift;
|
||||
my $sshlogin = $self->sshlogin();
|
||||
my $sshcmd = $sshlogin->sshcommand();
|
||||
|
|
@ -5574,13 +5584,14 @@ sub new {
|
|||
my $max_number_of_args = shift; # for -N and normal (-n1)
|
||||
my $return_files = shift;
|
||||
my $replacecount_ref = shift;
|
||||
my $len_ref = shift;
|
||||
my %replacecount = %$replacecount_ref;
|
||||
my $len = {
|
||||
my %len = %$len_ref;
|
||||
for (keys %$replacecount_ref) {
|
||||
# Total length of this replacement string {} replaced with all args
|
||||
(map { $_ => 0 } keys %$replacecount_ref),
|
||||
'no_args' => undef, # Length of command w/ all replacement args removed
|
||||
'context' => undef, # Length of context of an additional arg
|
||||
};
|
||||
$len{$_} = 0;
|
||||
}
|
||||
|
||||
# my($sum);
|
||||
# ($sum,$len->{'no_args'},$len->{'context'},$len->{'contextgroups'},
|
||||
# %replacecount) = number_of_replacements($command,$context_replace);
|
||||
|
|
@ -5627,7 +5638,7 @@ sub new {
|
|||
return bless {
|
||||
'command' => $commandref,
|
||||
'seq' => $seq,
|
||||
'len' => $len,
|
||||
'len' => \%len,
|
||||
'arg_list' => [],
|
||||
'arg_queue' => $arg_queue,
|
||||
'max_number_of_args' => $max_number_of_args,
|
||||
|
|
@ -5736,6 +5747,37 @@ sub push {
|
|||
#::my_dump($record);
|
||||
my $arg_no = ($self->number_of_args()-1) * ($#$record+1);
|
||||
|
||||
for my $arg (@$record) {
|
||||
$arg_no++;
|
||||
if(defined $arg) {
|
||||
if($self->{'positional_replace'}{$arg_no}) {
|
||||
# TODO probably bug here if both {1.} and {1} are used
|
||||
for my $used (keys %{$self->{'replacecount'}}) {
|
||||
# {} {/} {//} {.} or {/.}
|
||||
my $replacementfunction =
|
||||
$self->{'positional_replace'}{$arg_no};
|
||||
# Find the single replacements
|
||||
$self->{'len'}{$used} +=
|
||||
length $arg->replace($replacementfunction,1);
|
||||
}
|
||||
}
|
||||
for my $used (keys %{$self->{'replacecount'}}) {
|
||||
# Add to the multireplacement
|
||||
$self->{'len'}{$used} += length $arg->replace($used,1);
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub _push {
|
||||
# Add one or more records as arguments
|
||||
# Returns: N/A
|
||||
my $self = shift;
|
||||
my $record = shift;
|
||||
push @{$self->{'arg_list'}}, $record;
|
||||
#::my_dump($record);
|
||||
my $arg_no = ($self->number_of_args()-1) * ($#$record+1);
|
||||
|
||||
for my $arg (@$record) {
|
||||
$arg_no++;
|
||||
if(defined $arg) {
|
||||
|
|
@ -5892,39 +5934,46 @@ sub len {
|
|||
my $self = shift;
|
||||
my $len = 0;
|
||||
# Add length of the original command with no args
|
||||
$len += $self->{'len'}{'no_args'};
|
||||
# Length of command w/ all replacement args removed
|
||||
$len += $self->{'len'}{'noncontext'} + @{$self->{'command'}};
|
||||
if($self->{'context_replace'}) {
|
||||
$len += $self->number_of_args()*$self->{'len'}{'context'};
|
||||
for my $replstring (keys %{$self->{'replacecount'}}) {
|
||||
if(defined $self->{'len'}{$replstring}) {
|
||||
$len += $self->{'len'}{$replstring} *
|
||||
$self->{'replacecount'}{$replstring};
|
||||
} else {
|
||||
die;
|
||||
}
|
||||
}
|
||||
$len += ($self->number_of_args()-1) * $self->{'len'}{'contextgroups'};
|
||||
# Add space between context groups
|
||||
$len += ($self->number_of_args()-1) * ($self->{'len'}{'contextgroups'});
|
||||
# warn $len;
|
||||
} else {
|
||||
# Each replacement string may occur several times
|
||||
# Add the length for each time
|
||||
$len += 1*$self->{'len'}{'context'};
|
||||
for my $replstring (keys %{$self->{'replacecount'}}) {
|
||||
if(defined $self->{'len'}{$replstring}) {
|
||||
$len += $self->{'len'}{$replstring} *
|
||||
$self->{'replacecount'}{$replstring};
|
||||
}
|
||||
if($Global::replace{$replstring}) {
|
||||
# This is a multi replacestring ({} {/} {//} {.} {/.})
|
||||
# Add each space between two arguments
|
||||
my $number_of_args = ($#{$self->{'arg_list'}[0]}+1) *
|
||||
$self->number_of_args();
|
||||
$len += ($number_of_args-1) *
|
||||
$self->{'replacecount'}{$replstring};
|
||||
} else {
|
||||
die;
|
||||
}
|
||||
}
|
||||
# Add space between context groups
|
||||
$len += ($self->number_of_args()-1) * ($self->{'len'}{'contextgroups'});
|
||||
}
|
||||
if($opt::nice) {
|
||||
# Pessimistic length if --nice is set
|
||||
# Worse than worst case: every char needs to be quoted with \
|
||||
$len *= 2;
|
||||
}
|
||||
if($Global::quoting) {
|
||||
# Pessimistic length if -q is set
|
||||
# Worse than worst case: every char needs to be quoted with \
|
||||
$len *= 2;
|
||||
}
|
||||
if($opt::shellquote) {
|
||||
# Pessimistic length if --shellquote is set
|
||||
# Worse than worst case: every char needs to be quoted with \ twice
|
||||
|
|
@ -5935,81 +5984,132 @@ sub len {
|
|||
return $len;
|
||||
}
|
||||
|
||||
sub multi_regexp {
|
||||
if(not $CommandLine::multi_regexp) {
|
||||
$CommandLine::multi_regexp =
|
||||
"(?:".
|
||||
join("|",map {my $a=$_; $a =~ s/(\W)/\\$1/g; $a}
|
||||
($Global::replace{"{}"},
|
||||
$Global::replace{"{.}"},
|
||||
$Global::replace{"{/}"},
|
||||
$Global::replace{"{//}"},
|
||||
$Global::replace{"{/.}"})
|
||||
).")";
|
||||
}
|
||||
return $CommandLine::multi_regexp;
|
||||
}
|
||||
# sub _len {
|
||||
# # The length of the command line with args substituted
|
||||
# my $self = shift;
|
||||
# my $len = 0;
|
||||
# # Add length of the original command with no args
|
||||
# $len += $self->{'len'}{'no_args'};
|
||||
# if($self->{'context_replace'}) {
|
||||
# $len += $self->number_of_args()*$self->{'len'}{'context'};
|
||||
# for my $replstring (keys %{$self->{'replacecount'}}) {
|
||||
# if(defined $self->{'len'}{$replstring}) {
|
||||
# $len += $self->{'len'}{$replstring} *
|
||||
# $self->{'replacecount'}{$replstring};
|
||||
# }
|
||||
# }
|
||||
# $len += ($self->number_of_args()-1) * $self->{'len'}{'contextgroups'};
|
||||
# } else {
|
||||
# # Each replacement string may occur several times
|
||||
# # Add the length for each time
|
||||
# for my $replstring (keys %{$self->{'replacecount'}}) {
|
||||
# if(defined $self->{'len'}{$replstring}) {
|
||||
# $len += $self->{'len'}{$replstring} *
|
||||
# $self->{'replacecount'}{$replstring};
|
||||
# }
|
||||
# if($Global::replace{$replstring}) {
|
||||
# # This is a multi replacestring ({} {/} {//} {.} {/.})
|
||||
# # Add each space between two arguments
|
||||
# my $number_of_args = ($#{$self->{'arg_list'}[0]}+1) *
|
||||
# $self->number_of_args();
|
||||
# $len += ($number_of_args-1) *
|
||||
# $self->{'replacecount'}{$replstring};
|
||||
# }
|
||||
# }
|
||||
# }
|
||||
# if($opt::nice) {
|
||||
# # Pessimistic length if --nice is set
|
||||
# # Worse than worst case: every char needs to be quoted with \
|
||||
# $len *= 2;
|
||||
# }
|
||||
# if($opt::shellquote) {
|
||||
# # Pessimistic length if --shellquote is set
|
||||
# # Worse than worst case: every char needs to be quoted with \ twice
|
||||
# $len *= 4;
|
||||
# }
|
||||
# # If we are using --env, add the prefix for that, too.
|
||||
# $len += $Global::envvarlen;
|
||||
# return $len;
|
||||
# }
|
||||
|
||||
sub number_of_replacements {
|
||||
# Returns:
|
||||
# sum_of_count, length_of_command_with_no_args,
|
||||
# length_of_context { 'replacementstring' => count }
|
||||
my $command = shift;
|
||||
my $context_replace = shift;
|
||||
my %count = ();
|
||||
my $sum = 0;
|
||||
my $cmd = $command;
|
||||
my $multi_regexp = multi_regexp();
|
||||
my $replacement_regexp =
|
||||
"(?:". ::maybe_quote('\{') .
|
||||
'-?\d+(?:|\.|/\.|/|//)?' . # {n} {n.} {n/.} {n/} {n//} {-n} {-n.} {-n/.} {-n/} {-n//}
|
||||
::maybe_quote('\}') .
|
||||
'|'.
|
||||
join("|",map {$a=$_;$a=~s/(\W)/\\$1/g; $a} values %Global::replace).
|
||||
")";
|
||||
my %c = ();
|
||||
$cmd =~ s/($replacement_regexp)/$c{$1}++;"\0"/ogex;
|
||||
for my $k (keys %c) {
|
||||
if(defined $Global::replace_rev{$k}) {
|
||||
$count{$Global::replace_rev{$k}} = $c{$k};
|
||||
} else {
|
||||
$count{::maybe_unquote($k)} = $c{$k};
|
||||
}
|
||||
$sum += $c{$k};
|
||||
}
|
||||
my $number_of_context_groups = 0;
|
||||
my $no_args;
|
||||
my $context;
|
||||
if($context_replace) {
|
||||
$cmd = $command;
|
||||
while($cmd =~ s/\S*$multi_regexp\S*//o) {
|
||||
$number_of_context_groups++;
|
||||
}
|
||||
$no_args = length $cmd;
|
||||
$context = length($command) - $no_args;
|
||||
} else {
|
||||
$cmd = $command;
|
||||
$cmd =~ s/$multi_regexp//go;
|
||||
$cmd =~ s/$replacement_regexp//go;
|
||||
$no_args = length($cmd);
|
||||
$context = length($command) - $no_args;
|
||||
}
|
||||
for my $k (keys %count) {
|
||||
if(defined $Global::replace{$k}) {
|
||||
# {} {/} {//} {.} {/.} {#} {%}
|
||||
$context -= (length $Global::replace{$k}) * $count{$k};
|
||||
} else {
|
||||
# {n}
|
||||
$context -= (length $k) * $count{$k};
|
||||
}
|
||||
}
|
||||
return ($sum,$no_args,$context,$number_of_context_groups,%count);
|
||||
}
|
||||
# sub _multi_regexp {
|
||||
# if(not $CommandLine::multi_regexp) {
|
||||
# $CommandLine::multi_regexp =
|
||||
# "(?:".
|
||||
# join("|",map {my $a=$_; $a =~ s/(\W)/\\$1/g; $a}
|
||||
# ($Global::replace{"{}"},
|
||||
# $Global::replace{"{.}"},
|
||||
# $Global::replace{"{/}"},
|
||||
# $Global::replace{"{//}"},
|
||||
# $Global::replace{"{/.}"})
|
||||
# ).")";
|
||||
# }
|
||||
# return $CommandLine::multi_regexp;
|
||||
# }
|
||||
#
|
||||
# sub _number_of_replacements {
|
||||
# # Returns:
|
||||
# # sum_of_count, length_of_command_with_no_args,
|
||||
# # length_of_context { 'replacementstring' => count }
|
||||
# my $command = shift;
|
||||
# my $context_replace = shift;
|
||||
# my %count = ();
|
||||
# my $sum = 0;
|
||||
# my $cmd = $command;
|
||||
# my $multi_regexp = multi_regexp();
|
||||
# my $replacement_regexp =
|
||||
# "(?:". ::maybe_quote('\{') .
|
||||
# '-?\d+(?:|\.|/\.|/|//)?' . # {n} {n.} {n/.} {n/} {n//} {-n} {-n.} {-n/.} {-n/} {-n//}
|
||||
# ::maybe_quote('\}') .
|
||||
# '|'.
|
||||
# join("|",map {$a=$_;$a=~s/(\W)/\\$1/g; $a} values %Global::replace).
|
||||
# ")";
|
||||
# my %c = ();
|
||||
# $cmd =~ s/($replacement_regexp)/$c{$1}++;"\0"/ogex;
|
||||
# for my $k (keys %c) {
|
||||
# if(defined $Global::replace_rev{$k}) {
|
||||
# $count{$Global::replace_rev{$k}} = $c{$k};
|
||||
# } else {
|
||||
# $count{::maybe_unquote($k)} = $c{$k};
|
||||
# }
|
||||
# $sum += $c{$k};
|
||||
# }
|
||||
# my $number_of_context_groups = 0;
|
||||
# my $no_args;
|
||||
# my $context;
|
||||
# if($context_replace) {
|
||||
# $cmd = $command;
|
||||
# while($cmd =~ s/\S*$multi_regexp\S*//o) {
|
||||
# $number_of_context_groups++;
|
||||
# }
|
||||
# $no_args = length $cmd;
|
||||
# $context = length($command) - $no_args;
|
||||
# } else {
|
||||
# $cmd = $command;
|
||||
# $cmd =~ s/$multi_regexp//go;
|
||||
# $cmd =~ s/$replacement_regexp//go;
|
||||
# $no_args = length($cmd);
|
||||
# $context = length($command) - $no_args;
|
||||
# }
|
||||
# for my $k (keys %count) {
|
||||
# if(defined $Global::replace{$k}) {
|
||||
# # {} {/} {//} {.} {/.} {#} {%}
|
||||
# $context -= (length $Global::replace{$k}) * $count{$k};
|
||||
# } else {
|
||||
# # {n}
|
||||
# $context -= (length $k) * $count{$k};
|
||||
# }
|
||||
# }
|
||||
# return ($sum,$no_args,$context,$number_of_context_groups,%count);
|
||||
# }
|
||||
|
||||
sub replaced {
|
||||
my $self = shift;
|
||||
if(not defined $self->{'replaced'}) {
|
||||
my $cmdstring = $self->replace_placeholders($self->{'command'},$Global::quoting);
|
||||
if (length($cmdstring) > $self->len()-1) {
|
||||
die(length($cmdstring)." != ".($self->len()-1) ." ". $cmdstring);
|
||||
}
|
||||
if($opt::cat) {
|
||||
# Prepend 'cat > {};'
|
||||
# Append '_EXIT=$?;(rm {};exit $_EXIT)'
|
||||
|
|
@ -6056,143 +6156,6 @@ sub replaced {
|
|||
return $self->{'replaced'};
|
||||
}
|
||||
|
||||
# sub _replace_placeholders {
|
||||
# my $self = shift;
|
||||
# my $targetref = shift;
|
||||
# my $quote = shift;
|
||||
# my $context_replace = $self->{'context_replace'};
|
||||
# my $replaced;
|
||||
# if($self->{'context_replace'}) {
|
||||
# $replaced = $self->context_replace_placeholders($targetref,$quote,1);
|
||||
# } else {
|
||||
# $replaced = $self->context_replace_placeholders($targetref,$quote,0);
|
||||
# # $replaced = $self->simple_replace_placeholders($targetref,$quote);
|
||||
# }
|
||||
# return $replaced;
|
||||
# }
|
||||
|
||||
# sub _context_replace_placeholders {
|
||||
# # Replace foo{}bar with fooargbar
|
||||
# # Input:
|
||||
# # target = foo{}bar
|
||||
# # quote = should this be quoted?
|
||||
# # Returns: $target
|
||||
# my $self = shift;
|
||||
# my $target = shift;
|
||||
# my $quote = shift;
|
||||
# # -X = context replace
|
||||
# # maybe multiple input sources
|
||||
# # maybe --xapply
|
||||
# # $self->{'arg_list'} = [ [Arg11, Arg12], [Arg21, Arg22], [Arg31, Arg32] ]
|
||||
#
|
||||
# my @args=();
|
||||
# my @used_multi;
|
||||
# my %replace;
|
||||
#
|
||||
# for my $record (@{$self->{'arg_list'}}) {
|
||||
# # Merge arguments from records into args for easy access
|
||||
# CORE::push @args, @$record;
|
||||
# }
|
||||
#
|
||||
# # Replacement functions
|
||||
# my @rep = qw({} {/} {//} {.} {/.});
|
||||
# # Inner part of replacement functions
|
||||
# my @rep_inner = ('', '/', '//', '.', '/.');
|
||||
# # Regexp for replacement functions
|
||||
# my $rep_regexp = "(?:". join('|', map { my $s = $_; $s =~ s/(\W)/\\$1/g; $s } @rep) . ")";
|
||||
# # Regexp for inner replacement functions
|
||||
# my $rep_inner_regexp = "(?:". join('|', map { my $s = $_; $s =~ s/(\W)/\\$1/g; $s } @rep_inner) . ")";
|
||||
# # Seq replace string: {#}
|
||||
# my $rep_seq_regexp = '(?:'.::maybe_quote('\{\#\}').")";
|
||||
# # Slot replace string: {%}
|
||||
# my $rep_slot_regexp = '(?:'.::maybe_quote('\{\%\}').")";
|
||||
# # Normal replace strings
|
||||
# my $rep_str_regexp = multi_regexp();
|
||||
# # Positional replace strings
|
||||
# my $rep_str_pos_regexp = ::maybe_quote('\{').'-?\d+'.$rep_inner_regexp.::maybe_quote('\}');
|
||||
#
|
||||
# # Fish out the words that have replacement strings in them
|
||||
# my $tt = $target;
|
||||
# my %word;
|
||||
# while($tt =~ s/(\S*(?:$rep_str_regexp|$rep_str_pos_regexp|$rep_seq_regexp|$rep_slot_regexp)\S*)/\0/o) {
|
||||
# $word{$1} ||= 1;
|
||||
# }
|
||||
# if(not %word) {
|
||||
# # The line did no contain any replacement strings => return unchanged
|
||||
# return $target;
|
||||
# }
|
||||
# # For each word: Generate the replacement string for that word.
|
||||
# for my $origword (keys %word) {
|
||||
# my @pos_replacements=();
|
||||
# my @replacements=();
|
||||
# my $w;
|
||||
# my $word = $origword; # Make a local modifyable copy
|
||||
#
|
||||
# # replace {#} if it exists
|
||||
# $word =~ s/$rep_seq_regexp/$self->seq()/geo;
|
||||
# # replace {%} if it exists
|
||||
# $word =~ s/$rep_slot_regexp/$self->slot()/geo;
|
||||
# if($word =~ /$rep_str_pos_regexp/o) {
|
||||
# # There are positional replacement strings
|
||||
# my @argset;
|
||||
# if($#{$self->{'arg_list'}->[0]} == 0) {
|
||||
# # Only one input source: Treat it as a set
|
||||
# @argset = [ @args ];
|
||||
# } else {
|
||||
# # Multiple input sources
|
||||
# @argset = @{$self->{'arg_list'}};
|
||||
# }
|
||||
# # Match -n..-1,1..n where n = max args in a argset
|
||||
# my $n = $#{$argset[0]}+1;
|
||||
# my $pos_regexp = "(?:".join("|", -$n..-1, 1..$n).")";
|
||||
# my $pos_inner_regexp = ::maybe_quote('\{') .
|
||||
# "($pos_regexp)($rep_inner_regexp)" .
|
||||
# ::maybe_quote('\}');
|
||||
# for my $argset (@argset) {
|
||||
# # Replace all positional arguments - e.g. {7/.}
|
||||
# # with the replacement function - e.g. {/.}
|
||||
# # of that argument
|
||||
# if(defined $self->{'max_number_of_args'}) {
|
||||
# # Fill up if we have a half completed line, so {n} will be empty
|
||||
# while($#$argset < $self->{'max_number_of_args'}) {
|
||||
# CORE::push @$argset, Arg->new("");
|
||||
# }
|
||||
# }
|
||||
# $w = $word;
|
||||
# # Replace positive replacement strings with arg[$1-1]
|
||||
# # Replace negative replacement strings with arg[$n+$1]
|
||||
# $w =~ s/$pos_inner_regexp/$argset->[$1 > 0 ? $1-1 : $n+$1]->replace('{'.$2.'}',$quote)/geo;
|
||||
# CORE::push @pos_replacements, $w;
|
||||
# }
|
||||
# }
|
||||
# if(not @pos_replacements) {
|
||||
# @pos_replacements = ($word);
|
||||
# }
|
||||
#
|
||||
# if($word =~ m:$rep_str_regexp:) {
|
||||
# # There are normal replacement strings
|
||||
# for my $w (@pos_replacements) {
|
||||
# for my $arg (@args) {
|
||||
# my $wmulti = $w;
|
||||
# $wmulti =~ s/($rep_str_regexp)/$arg->replace($Global::replace_rev{$1},$quote)/geo;
|
||||
# CORE::push @replacements, $wmulti;
|
||||
# }
|
||||
# }
|
||||
# }
|
||||
# if(@replacements) {
|
||||
# CORE::push @{$replace{$origword}}, @replacements;
|
||||
# } else {
|
||||
# CORE::push @{$replace{$origword}}, @pos_replacements;
|
||||
# }
|
||||
# }
|
||||
# # Substitute the replace strings with the replacement values
|
||||
# # Must be sorted by length if a short word is a substring of a long word
|
||||
# my $regexp = join('|', map { my $s = $_; $s =~ s/(\W)/\\$1/g; $s }
|
||||
# sort { length $b <=> length $a } keys %word);
|
||||
# $target =~ s/($regexp)/join(" ",@{$replace{$1}})/ge;
|
||||
# return $target;
|
||||
# }
|
||||
|
||||
sub replace_placeholders {
|
||||
# Replace foo{}bar with fooargbar
|
||||
# Input:
|
||||
|
|
@ -6209,18 +6172,21 @@ sub replace_placeholders {
|
|||
# maybe multiple input sources
|
||||
# maybe --xapply
|
||||
# $self->{'arg_list'} = [ [Arg11, Arg12], [Arg21, Arg22], [Arg31, Arg32] ]
|
||||
|
||||
if(not @target) {
|
||||
# @target is empty: Return empty array
|
||||
return @target;
|
||||
}
|
||||
# Fish out the words that have replacement strings in them
|
||||
my %word;
|
||||
for (@target) {
|
||||
my $tt = $_;
|
||||
# warn $tt;
|
||||
if($context_replace) {
|
||||
while($tt =~ s/( (?:\S* \{\{([^{].*?|)\}\})+ \S*)/\0/ox) {
|
||||
while($tt =~ s/( (?:\S* \{=(.*?)=\})+ \S*)/\0/ox) {
|
||||
$word{$1} ||= 1;
|
||||
}
|
||||
} else {
|
||||
while($tt =~ s/( (?: \{\{([^{].*?|)\}\})+ )/\0/ox) {
|
||||
while($tt =~ s/( (?: \{=(.*?)=\})+ )/\0/ox) {
|
||||
$word{$1} ||= 1;
|
||||
}
|
||||
}
|
||||
|
|
@ -6241,20 +6207,22 @@ sub replace_placeholders {
|
|||
# warn($w);
|
||||
|
||||
# Replace positional arguments
|
||||
# \000 makes it easier to see where a {{...}} starts and ends
|
||||
$w =~ s/\{\{/\000\{/g;
|
||||
$w =~ s/\}\}/\000\}/g;
|
||||
$w =~ s/ ([^\s\000]*) # before {{
|
||||
\000\{ # {{
|
||||
# \000 makes it easier to see where a {= perl expr =} starts and ends
|
||||
# as \000 will never entered on the command line
|
||||
$w =~ s/\{=/\000\{/g;
|
||||
$w =~ s/=\}/\000\}/g;
|
||||
$w =~ s/ ([^\s\000]*) # before {=
|
||||
\000\{ # {=
|
||||
(-?\d+) # Position (eg. -2 or 3)
|
||||
([^\000]*?) # The perl expression
|
||||
\000\} # }}
|
||||
([^\s\000]*) # after }}
|
||||
\000\} # =}
|
||||
([^\s\000]*) # after =}
|
||||
/ $_=$_[$2 > 0 ? $2-1 : $n+$2]; # Set $_ to the argument at the position
|
||||
eval("$3"); # evaluate the perl expression
|
||||
$1.$_.$4 /egx;# Prepend and append context
|
||||
$w =~ s/\000\{/\{\{/g;
|
||||
$w =~ s/\000\}/\}\}/g;
|
||||
# Get the {= and =} back
|
||||
$w =~ s/\000\{/\{=/g;
|
||||
$w =~ s/\000\}/=\}/g;
|
||||
# for each arg:
|
||||
# compute replacement for each string
|
||||
# replace replacement strings with replacement in the word value
|
||||
|
|
@ -6262,8 +6230,8 @@ sub replace_placeholders {
|
|||
for my $arg (@_) {
|
||||
my $val = $w;
|
||||
for my $rplstr (keys %{$self->{'replacecount'}}) {
|
||||
# Replace {{perlexp}} with value for each arg
|
||||
$val =~ s/\Q{{$rplstr}}\E/$_=$arg;eval("$rplstr");$_/eg;
|
||||
# Replace {= perl expr =} with value for each arg
|
||||
$val =~ s/\Q{=$rplstr=}\E/$_=$arg;eval("$rplstr");$_/eg;
|
||||
# warn($val," ; ",$rplstr);
|
||||
}
|
||||
my $ww = $word;
|
||||
|
|
@ -6276,8 +6244,8 @@ sub replace_placeholders {
|
|||
if(not @_) {
|
||||
my $val = $w;
|
||||
for my $rplstr (keys %{$self->{'replacecount'}}) {
|
||||
# Replace {{perlexp}} with value for each arg
|
||||
$val =~ s/\Q{{$rplstr}}\E/$_="";eval("$rplstr");$_/eg;
|
||||
# Replace {= perl expr =} with value for each arg
|
||||
$val =~ s/\Q{=$rplstr=}\E/$_="";eval("$rplstr");$_/eg;
|
||||
# warn($val," ; ",$rplstr);
|
||||
}
|
||||
my $ww = $word;
|
||||
|
|
@ -6304,98 +6272,6 @@ sub replace_placeholders {
|
|||
return ("@target");
|
||||
}
|
||||
|
||||
# sub __simple_replace_placeholders {
|
||||
# # no context (no -X)
|
||||
# # maybe multiple input sources
|
||||
# # maybe --xapply
|
||||
# my $self = shift;
|
||||
# my $targetref = shift;
|
||||
# my $quote = shift;
|
||||
# my @target = @$targetref;
|
||||
#
|
||||
# for my $record (@{$self->{'arg_list'}}) {
|
||||
# # Merge arguments from records into @_ for easy access
|
||||
# CORE::push @_, map { $_->replace('{}',$quote) } @$record;
|
||||
# }
|
||||
# die @_;
|
||||
# my $n = $#_+1;
|
||||
# # Replace positional {{-n perlexp}} with value for {-n}
|
||||
# for (@target) {
|
||||
# s/ (\{\{ (-?\d+)(.*?) \}\}) / $_=$_[$2 > 0 ? $2-1 : $n+$2]; eval("$3"); $_ /egx;
|
||||
# }
|
||||
# for my $arg (@_) {
|
||||
# # Replace {{perlexp}} with value for each arg
|
||||
# for my $t (@target) {
|
||||
# $t =~ s/(\{\{([^{].*?|)\}\})/$_=$arg;eval("$2");$_." ".$1/eg;
|
||||
# warn($t);
|
||||
# }
|
||||
# }
|
||||
#
|
||||
# for(@target) {
|
||||
# s/( \{\{(.*?)\}\})//g;
|
||||
# }
|
||||
# die"".::shell_quote(@target);
|
||||
# return @target;
|
||||
# }
|
||||
#
|
||||
# sub _simple_replace_placeholders {
|
||||
# # no context (no -X)
|
||||
# # maybe multiple input sources
|
||||
# # maybe --xapply
|
||||
# my $self = shift;
|
||||
# my $target = shift;
|
||||
# my $quote = shift;
|
||||
# my @args=();
|
||||
# my @used_multi;
|
||||
# my %replace;
|
||||
#
|
||||
# for my $record (@{$self->{'arg_list'}}) {
|
||||
# # Merge arguments from records into args for easy access
|
||||
# CORE::push @args, @$record;
|
||||
# }
|
||||
# my $n = $#args+1;
|
||||
# # Which replace strings are used?
|
||||
# # {#} {%} {} {/} {//} {.} {/.} {n} {n/} {n//} {n.} {n/.}
|
||||
# for my $used (keys %{$self->{'replacecount'}}) {
|
||||
# # What are the replacement values for the replace strings?
|
||||
# if(grep { $used eq $_ } qw({} {/} {//} {.} {/.})) {
|
||||
# # {} {/} {//} {.} {/.}
|
||||
# $replace{$Global::replace{$used}} =
|
||||
# join(" ", map { $_->replace($used,$quote) } @args);
|
||||
# } elsif($used =~ /^\{(-?\d+)(|\/|\/\/|\.|\/\.)\}$/) {
|
||||
# # {n} {n/} {n//} {n.} {n/.} {-n} {-n/} {-n//} {-n.} {-n/.}
|
||||
# my $positional = $1 > 0 ? $1 : $n+$1+1;
|
||||
# my $replacementfunction = "{".::undef_as_empty($2)."}"; # {} {/} {//} {.} or {/.}
|
||||
# # If -q then the replacementstrings will be quoted, too
|
||||
# # {1.} -> \{1.\}
|
||||
# $Global::replace{$used} ||= ::maybe_quote($used);
|
||||
# if(defined $args[$positional-1]) {
|
||||
# # we have a matching argument for {n}
|
||||
# $replace{$Global::replace{$used}} =
|
||||
# $args[$positional-1]->replace($replacementfunction,$quote);
|
||||
# } else {
|
||||
# if($positional <= $self->{'max_number_of_args'}) {
|
||||
# # Fill up if we have a half completed line
|
||||
# $replace{$Global::replace{$used}} = "";
|
||||
# }
|
||||
# }
|
||||
# } elsif($used eq "{#}") {
|
||||
# # {#}
|
||||
# $replace{$Global::replace{$used}} = $self->seq();
|
||||
# } elsif($used eq "{%}") {
|
||||
# # {%}
|
||||
# $replace{$Global::replace{$used}} = $self->slot();
|
||||
# } else {
|
||||
# ::die_bug('simple_replace_placeholders_20110530');
|
||||
# }
|
||||
# }
|
||||
# # Substitute the replace strings with the replacement values
|
||||
# my $regexp = join('|', map { my $s = $_; $s =~ s/(\W)/\\$1/g; $s } keys %replace);
|
||||
# if($regexp) {
|
||||
# $target =~ s/($regexp)/$replace{$1}/g;
|
||||
# }
|
||||
# return $target;
|
||||
# }
|
||||
|
||||
package CommandLineQueue;
|
||||
|
||||
|
|
@ -6407,45 +6283,60 @@ sub new {
|
|||
my $max_number_of_args = shift;
|
||||
my $return_files = shift;
|
||||
my @unget = ();
|
||||
my ($count,%replacecount,$posrpl,$perlexpr);
|
||||
my ($count,%replacecount,$posrpl,$perlexpr,%len);
|
||||
my @command = @$commandref;
|
||||
# Replace replacement strings with {{perl expr}}
|
||||
# Protect matching inside {{...}} by replacing {{ and }} with forbidden chars
|
||||
# Replace replacement strings with {= perl expr =}
|
||||
# Protect matching inside {= perl expr =} by replacing {= and =} with forbidden chars
|
||||
for(@command) {
|
||||
s/ \{\{([^{].*?|)\}\} / \000\001$1\000\002 /gx;
|
||||
s/ \{=(.*?)=\} /\000\001$1\000\002/gx;
|
||||
}
|
||||
for my $rpl (keys %Global::replace) {
|
||||
# Replace the short hand string with the {{perl expr}} in $command
|
||||
for my $rpl (keys %Global::rpl) {
|
||||
# Replace the short hand string with the {= perl expr =} in $command
|
||||
for(@command) {
|
||||
s/\Q$rpl\E/$Global::replace{$rpl}/g;
|
||||
s/\Q$rpl\E/$Global::rpl{$rpl}/g;
|
||||
}
|
||||
# Do the same for the positional replacement strings
|
||||
# A bit harder as we have to put in a number
|
||||
$posrpl = $rpl;
|
||||
$posrpl =~ s/^\{//; # Remove the first {
|
||||
$perlexpr = $Global::replace{$rpl};
|
||||
$perlexpr =~ s/^\{\{//; # Remove the first {{
|
||||
$perlexpr = $Global::rpl{$rpl};
|
||||
$perlexpr =~ s/^\{=//; # Remove the first {=
|
||||
for(@command) {
|
||||
s/\{(-?\d+)\Q$posrpl\E/{{$1 $perlexpr/g;
|
||||
s/\{(-?\d+)\Q$posrpl\E/{=$1 $perlexpr/g;
|
||||
}
|
||||
}
|
||||
# Get the {{ and }} back
|
||||
# Get the {= and =} back
|
||||
for(@command) {
|
||||
s/ \000\001(.*?)\000\002 / \{\{$1\}\} /gx;
|
||||
s/ \000\001(.*?)\000\002 /{=$1=}/gx;
|
||||
}
|
||||
my $sum = 0;
|
||||
while($sum == 0) {
|
||||
# Count how many times each replacement string is used
|
||||
my @cmd = @command;
|
||||
my $contextlen = 0;
|
||||
my $noncontextlen = 0;
|
||||
my $contextgroups = 0;
|
||||
for my $c (@cmd) {
|
||||
while($c =~ s/ \{\{([^{].*?|)\}\} / \000 /x) {
|
||||
while($c =~ s/ \{=(.*?)=\} /\000/x) {
|
||||
# %replacecount = { "perlexpr" => number of times seen }
|
||||
# e.g { "$_++" => 2 }
|
||||
$replacecount{$1} ++;
|
||||
$sum++;
|
||||
}
|
||||
# Measure the length of the context around the {= perl expr =}
|
||||
# Use that {=...=} has been replaced with \000
|
||||
while($c =~ s/ ([^\s\000]*)\000([^\s\000]*) //x) {
|
||||
$contextlen += length($1) + length($2);
|
||||
$contextgroups++;
|
||||
}
|
||||
# All {= perl expr =} have been removed: The rest is non-context
|
||||
$noncontextlen += length $c;
|
||||
}
|
||||
|
||||
$len{'context'} = $contextlen;
|
||||
$len{'noncontext'} = $noncontextlen;
|
||||
$len{'contextgroups'} = $contextgroups;
|
||||
$len{'noncontextgroups'} = @cmd-$contextgroups;
|
||||
# warn("Context: $contextlen, Non: $noncontextlen Ctxgrp: $contextgroups Groups: ".@cmd);
|
||||
if($sum == 0) {
|
||||
# Default command = {}
|
||||
# If not replacement string: append {}
|
||||
|
|
@ -6457,7 +6348,7 @@ sub new {
|
|||
# With --pipe / --pipe-part you can have no replacement
|
||||
last;
|
||||
} else {
|
||||
# Append {} to the command if there are no {...}'s and no {{...}}
|
||||
# Append {} to the command if there are no {...}'s and no {=...=}
|
||||
push @command, $Global::replace{'{}'};
|
||||
}
|
||||
}
|
||||
|
|
@ -6469,6 +6360,7 @@ sub new {
|
|||
'replacecount' => \%replacecount,
|
||||
'arg_queue' => RecordQueue->new($read_from,$opt::colsep),
|
||||
'context_replace' => $context_replace,
|
||||
'len' => \%len,
|
||||
'max_number_of_args' => $max_number_of_args,
|
||||
'size' => undef,
|
||||
'return_files' => $return_files,
|
||||
|
|
@ -6490,6 +6382,7 @@ sub get {
|
|||
$self->{'max_number_of_args'},
|
||||
$self->{'return_files'},
|
||||
$self->{'replacecount'},
|
||||
$self->{'len'},
|
||||
);
|
||||
$cmd_line->populate();
|
||||
::debug("cmd_line->number_of_args ".$cmd_line->number_of_args()."\n");
|
||||
|
|
@ -6962,7 +6855,7 @@ sub read_arg_from_fh {
|
|||
redo;
|
||||
}
|
||||
}
|
||||
}} while (1 == 0); # Dummy loop for redo
|
||||
}} while (1 == 0); # Dummy loop {{}} for redo
|
||||
if(defined $arg) {
|
||||
return Arg->new($arg);
|
||||
} else {
|
||||
|
|
|
|||
Loading…
Reference in a new issue