mirror of
https://git.savannah.gnu.org/git/parallel.git
synced 2024-11-29 17:37:55 +00:00
parallel: --rpl implemented.
This commit is contained in:
parent
f2dfb82a40
commit
0725d2e2f5
635
src/parallel
635
src/parallel
|
@ -97,7 +97,7 @@ if($opt::header and not $opt::pipe) {
|
||||||
::debug("Colname: '$s'");
|
::debug("Colname: '$s'");
|
||||||
# Replace {colname} with {2}
|
# Replace {colname} with {2}
|
||||||
# TODO accept configurable short hands
|
# TODO accept configurable short hands
|
||||||
# TODO how to deal with headers in {{...}}
|
# TODO how to deal with headers in {=...=}
|
||||||
for(@command) {
|
for(@command) {
|
||||||
s:\{$s(|/|//|\.|/\.)\}:\{$id$1\}:g;
|
s:\{$s(|/|//|\.|/\.)\}:\{$id$1\}:g;
|
||||||
}
|
}
|
||||||
|
@ -607,6 +607,7 @@ sub options_hash {
|
||||||
"null|0" => \$opt::0,
|
"null|0" => \$opt::0,
|
||||||
"quote|q" => \$opt::q,
|
"quote|q" => \$opt::q,
|
||||||
# Replacement strings
|
# Replacement strings
|
||||||
|
"rpl=s" => \@opt::rpl,
|
||||||
"I=s" => \$opt::I,
|
"I=s" => \$opt::I,
|
||||||
"extensionreplace|er=s" => \$opt::U,
|
"extensionreplace|er=s" => \$opt::U,
|
||||||
"U=s" => \$opt::retired,
|
"U=s" => \$opt::retired,
|
||||||
|
@ -770,16 +771,20 @@ sub parse_options {
|
||||||
#$Global::replace{'{/.}'} = '{/.}';
|
#$Global::replace{'{/.}'} = '{/.}';
|
||||||
#$Global::replace{'{#}'} = '{#}';
|
#$Global::replace{'{#}'} = '{#}';
|
||||||
#$Global::replace{'{%}'} = '{%}';
|
#$Global::replace{'{%}'} = '{%}';
|
||||||
|
|
||||||
|
# Read only table with default --rpl values
|
||||||
%Global::replace =
|
%Global::replace =
|
||||||
(
|
(
|
||||||
'{}' => '{{ $_=$_ }}',
|
'{}' => '{= $_=$_ =}',
|
||||||
'{#}' => '{{ $_=$self->seq() }}',
|
'{#}' => '{= $_=$self->seq() =}',
|
||||||
'{%}' => '{{ $_=$self->slot() }}',
|
'{%}' => '{= $_=$self->slot() =}',
|
||||||
'{/}' => '{{ s:.*/:: }}',
|
'{/}' => '{= s:.*/:: =}',
|
||||||
'{//}' => '{{ s:/[^/]+$:: }}',
|
'{//}' => '{= s:/[^/]+$:: =}',
|
||||||
'{/.}' => '{{ s:.*/::; s:\.[^/.]+$::; }}',
|
'{/.}' => '{= s:.*/::; s:\.[^/.]+$::; =}',
|
||||||
'{.}' => '{{ s:\.[^/.]+$:: }}',
|
'{.}' => '{= s:\.[^/.]+$:: =}',
|
||||||
);
|
);
|
||||||
|
# Modifiable copy of %Global::replace
|
||||||
|
%Global::rpl = %Global::replace;
|
||||||
$/="\n";
|
$/="\n";
|
||||||
$Global::ignore_empty = 0;
|
$Global::ignore_empty = 0;
|
||||||
$Global::interactive = 0;
|
$Global::interactive = 0;
|
||||||
|
@ -808,23 +813,20 @@ sub parse_options {
|
||||||
if(defined $opt::q) { $Global::quoting = 1; }
|
if(defined $opt::q) { $Global::quoting = 1; }
|
||||||
if(defined $opt::r) { $Global::ignore_empty = 1; }
|
if(defined $opt::r) { $Global::ignore_empty = 1; }
|
||||||
if(defined $opt::verbose) { $Global::stderr_verbose = 1; }
|
if(defined $opt::verbose) { $Global::stderr_verbose = 1; }
|
||||||
if(defined $opt::I) { @Global::replace{$opt::I} = ($Global::replace{'{}'}) }
|
if(defined $opt::I) { rpl('{}',$opt::I); }
|
||||||
if(defined $opt::U) { $Global::replace{'{.}'} = $opt::U; }
|
if(defined $opt::U) { rpl('{.}',$opt::U); }
|
||||||
if(defined $opt::i) {
|
if(defined $opt::i and $opt::i) { rpl('{}',$opt::i); }
|
||||||
$Global::replace{'{}'} = $opt::i eq "" ? "{}" : $opt::i;
|
if(defined $opt::basenamereplace) { rpl('{/}',$opt::basenamereplace); }
|
||||||
}
|
if(defined $opt::dirnamereplace) { rpl('{//}',$opt::dirnamereplace); }
|
||||||
if(defined $opt::basenamereplace) { $Global::replace{'{/}'} = $opt::basenamereplace; }
|
if(defined $opt::seqreplace) { rpl('{#}',$opt::seqreplace); }
|
||||||
if(defined $opt::dirnamereplace) { $Global::replace{'{//}'} = $opt::dirnamereplace; }
|
if(defined $opt::I) { rpl('{}',$opt::I); }
|
||||||
|
if(defined $opt::slotreplace) { rpl('{%}',$opt::slotreplace); }
|
||||||
if(defined $opt::basenameextensionreplace) {
|
if(defined $opt::basenameextensionreplace) {
|
||||||
$Global::replace{'{/.}'} = $opt::basenameextensionreplace;
|
rpl('{/.}',$opt::basenameextensionreplace);
|
||||||
}
|
}
|
||||||
if(defined $opt::seqreplace) {
|
for(@opt::rpl) {
|
||||||
$Global::replace{'{#}'} = $opt::seqreplace;
|
my ($shorthand,$long) = split/ /,$_,2;
|
||||||
}
|
$Global::rpl{$shorthand} = $long;
|
||||||
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 == %
|
|
||||||
}
|
}
|
||||||
if(defined $opt::E) { $Global::end_of_file_string = $opt::E; }
|
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::max_args) { $Global::max_number_of_args = $opt::max_args; }
|
||||||
|
@ -942,7 +944,7 @@ sub parse_options {
|
||||||
# for (keys %Global::replace) {
|
# for (keys %Global::replace) {
|
||||||
# $Global::replace{$_} = ::maybe_quote($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) {
|
if(defined $opt::tag and not defined $opt::tagstring) {
|
||||||
$opt::tagstring = $Global::replace{'{}'};
|
$opt::tagstring = $Global::replace{'{}'};
|
||||||
}
|
}
|
||||||
|
@ -1014,6 +1016,14 @@ sub parse_options {
|
||||||
open_joblog();
|
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 {
|
sub env_quote {
|
||||||
my $v = $_[0];
|
my $v = $_[0];
|
||||||
$v =~ s/([\\])/\\$1/g;
|
$v =~ s/([\\])/\\$1/g;
|
||||||
|
@ -1799,7 +1809,7 @@ sub progress {
|
||||||
$eta = sprintf("ETA: %ds Left: %d AVG: %.2fs ", $this_eta, $left, $avgtime);
|
$eta = sprintf("ETA: %ds Left: %d AVG: %.2fs ", $this_eta, $left, $avgtime);
|
||||||
if($opt::bar) {
|
if($opt::bar) {
|
||||||
my $arg = $Global::newest_job ?
|
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",
|
my $bar_text = sprintf("%d%% %d:%d=%ds %s",
|
||||||
$pctcomplete*100, $completed, $left, $this_eta, $arg);
|
$pctcomplete*100, $completed, $left, $this_eta, $arg);
|
||||||
my $rev = '[7m';
|
my $rev = '[7m';
|
||||||
|
@ -5574,13 +5584,14 @@ sub new {
|
||||||
my $max_number_of_args = shift; # for -N and normal (-n1)
|
my $max_number_of_args = shift; # for -N and normal (-n1)
|
||||||
my $return_files = shift;
|
my $return_files = shift;
|
||||||
my $replacecount_ref = shift;
|
my $replacecount_ref = shift;
|
||||||
|
my $len_ref = shift;
|
||||||
my %replacecount = %$replacecount_ref;
|
my %replacecount = %$replacecount_ref;
|
||||||
my $len = {
|
my %len = %$len_ref;
|
||||||
|
for (keys %$replacecount_ref) {
|
||||||
# Total length of this replacement string {} replaced with all args
|
# Total length of this replacement string {} replaced with all args
|
||||||
(map { $_ => 0 } keys %$replacecount_ref),
|
$len{$_} = 0;
|
||||||
'no_args' => undef, # Length of command w/ all replacement args removed
|
}
|
||||||
'context' => undef, # Length of context of an additional arg
|
|
||||||
};
|
|
||||||
# my($sum);
|
# my($sum);
|
||||||
# ($sum,$len->{'no_args'},$len->{'context'},$len->{'contextgroups'},
|
# ($sum,$len->{'no_args'},$len->{'context'},$len->{'contextgroups'},
|
||||||
# %replacecount) = number_of_replacements($command,$context_replace);
|
# %replacecount) = number_of_replacements($command,$context_replace);
|
||||||
|
@ -5627,7 +5638,7 @@ sub new {
|
||||||
return bless {
|
return bless {
|
||||||
'command' => $commandref,
|
'command' => $commandref,
|
||||||
'seq' => $seq,
|
'seq' => $seq,
|
||||||
'len' => $len,
|
'len' => \%len,
|
||||||
'arg_list' => [],
|
'arg_list' => [],
|
||||||
'arg_queue' => $arg_queue,
|
'arg_queue' => $arg_queue,
|
||||||
'max_number_of_args' => $max_number_of_args,
|
'max_number_of_args' => $max_number_of_args,
|
||||||
|
@ -5736,6 +5747,37 @@ sub push {
|
||||||
#::my_dump($record);
|
#::my_dump($record);
|
||||||
my $arg_no = ($self->number_of_args()-1) * ($#$record+1);
|
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) {
|
for my $arg (@$record) {
|
||||||
$arg_no++;
|
$arg_no++;
|
||||||
if(defined $arg) {
|
if(defined $arg) {
|
||||||
|
@ -5892,39 +5934,46 @@ sub len {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
my $len = 0;
|
my $len = 0;
|
||||||
# Add length of the original command with no args
|
# 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'}) {
|
if($self->{'context_replace'}) {
|
||||||
$len += $self->number_of_args()*$self->{'len'}{'context'};
|
$len += $self->number_of_args()*$self->{'len'}{'context'};
|
||||||
for my $replstring (keys %{$self->{'replacecount'}}) {
|
for my $replstring (keys %{$self->{'replacecount'}}) {
|
||||||
if(defined $self->{'len'}{$replstring}) {
|
if(defined $self->{'len'}{$replstring}) {
|
||||||
$len += $self->{'len'}{$replstring} *
|
$len += $self->{'len'}{$replstring} *
|
||||||
$self->{'replacecount'}{$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 {
|
} else {
|
||||||
# Each replacement string may occur several times
|
# Each replacement string may occur several times
|
||||||
# Add the length for each time
|
# Add the length for each time
|
||||||
|
$len += 1*$self->{'len'}{'context'};
|
||||||
for my $replstring (keys %{$self->{'replacecount'}}) {
|
for my $replstring (keys %{$self->{'replacecount'}}) {
|
||||||
if(defined $self->{'len'}{$replstring}) {
|
if(defined $self->{'len'}{$replstring}) {
|
||||||
$len += $self->{'len'}{$replstring} *
|
$len += $self->{'len'}{$replstring} *
|
||||||
$self->{'replacecount'}{$replstring};
|
$self->{'replacecount'}{$replstring};
|
||||||
}
|
} else {
|
||||||
if($Global::replace{$replstring}) {
|
die;
|
||||||
# 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};
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
# Add space between context groups
|
||||||
|
$len += ($self->number_of_args()-1) * ($self->{'len'}{'contextgroups'});
|
||||||
}
|
}
|
||||||
if($opt::nice) {
|
if($opt::nice) {
|
||||||
# Pessimistic length if --nice is set
|
# Pessimistic length if --nice is set
|
||||||
# Worse than worst case: every char needs to be quoted with \
|
# Worse than worst case: every char needs to be quoted with \
|
||||||
$len *= 2;
|
$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) {
|
if($opt::shellquote) {
|
||||||
# Pessimistic length if --shellquote is set
|
# Pessimistic length if --shellquote is set
|
||||||
# Worse than worst case: every char needs to be quoted with \ twice
|
# Worse than worst case: every char needs to be quoted with \ twice
|
||||||
|
@ -5935,81 +5984,132 @@ sub len {
|
||||||
return $len;
|
return $len;
|
||||||
}
|
}
|
||||||
|
|
||||||
sub multi_regexp {
|
# sub _len {
|
||||||
if(not $CommandLine::multi_regexp) {
|
# # The length of the command line with args substituted
|
||||||
$CommandLine::multi_regexp =
|
# my $self = shift;
|
||||||
"(?:".
|
# my $len = 0;
|
||||||
join("|",map {my $a=$_; $a =~ s/(\W)/\\$1/g; $a}
|
# # Add length of the original command with no args
|
||||||
($Global::replace{"{}"},
|
# $len += $self->{'len'}{'no_args'};
|
||||||
$Global::replace{"{.}"},
|
# if($self->{'context_replace'}) {
|
||||||
$Global::replace{"{/}"},
|
# $len += $self->number_of_args()*$self->{'len'}{'context'};
|
||||||
$Global::replace{"{//}"},
|
# for my $replstring (keys %{$self->{'replacecount'}}) {
|
||||||
$Global::replace{"{/.}"})
|
# if(defined $self->{'len'}{$replstring}) {
|
||||||
).")";
|
# $len += $self->{'len'}{$replstring} *
|
||||||
}
|
# $self->{'replacecount'}{$replstring};
|
||||||
return $CommandLine::multi_regexp;
|
# }
|
||||||
}
|
# }
|
||||||
|
# $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 {
|
# sub _multi_regexp {
|
||||||
# Returns:
|
# if(not $CommandLine::multi_regexp) {
|
||||||
# sum_of_count, length_of_command_with_no_args,
|
# $CommandLine::multi_regexp =
|
||||||
# length_of_context { 'replacementstring' => count }
|
# "(?:".
|
||||||
my $command = shift;
|
# join("|",map {my $a=$_; $a =~ s/(\W)/\\$1/g; $a}
|
||||||
my $context_replace = shift;
|
# ($Global::replace{"{}"},
|
||||||
my %count = ();
|
# $Global::replace{"{.}"},
|
||||||
my $sum = 0;
|
# $Global::replace{"{/}"},
|
||||||
my $cmd = $command;
|
# $Global::replace{"{//}"},
|
||||||
my $multi_regexp = multi_regexp();
|
# $Global::replace{"{/.}"})
|
||||||
my $replacement_regexp =
|
# ).")";
|
||||||
"(?:". ::maybe_quote('\{') .
|
# }
|
||||||
'-?\d+(?:|\.|/\.|/|//)?' . # {n} {n.} {n/.} {n/} {n//} {-n} {-n.} {-n/.} {-n/} {-n//}
|
# return $CommandLine::multi_regexp;
|
||||||
::maybe_quote('\}') .
|
# }
|
||||||
'|'.
|
#
|
||||||
join("|",map {$a=$_;$a=~s/(\W)/\\$1/g; $a} values %Global::replace).
|
# sub _number_of_replacements {
|
||||||
")";
|
# # Returns:
|
||||||
my %c = ();
|
# # sum_of_count, length_of_command_with_no_args,
|
||||||
$cmd =~ s/($replacement_regexp)/$c{$1}++;"\0"/ogex;
|
# # length_of_context { 'replacementstring' => count }
|
||||||
for my $k (keys %c) {
|
# my $command = shift;
|
||||||
if(defined $Global::replace_rev{$k}) {
|
# my $context_replace = shift;
|
||||||
$count{$Global::replace_rev{$k}} = $c{$k};
|
# my %count = ();
|
||||||
} else {
|
# my $sum = 0;
|
||||||
$count{::maybe_unquote($k)} = $c{$k};
|
# my $cmd = $command;
|
||||||
}
|
# my $multi_regexp = multi_regexp();
|
||||||
$sum += $c{$k};
|
# my $replacement_regexp =
|
||||||
}
|
# "(?:". ::maybe_quote('\{') .
|
||||||
my $number_of_context_groups = 0;
|
# '-?\d+(?:|\.|/\.|/|//)?' . # {n} {n.} {n/.} {n/} {n//} {-n} {-n.} {-n/.} {-n/} {-n//}
|
||||||
my $no_args;
|
# ::maybe_quote('\}') .
|
||||||
my $context;
|
# '|'.
|
||||||
if($context_replace) {
|
# join("|",map {$a=$_;$a=~s/(\W)/\\$1/g; $a} values %Global::replace).
|
||||||
$cmd = $command;
|
# ")";
|
||||||
while($cmd =~ s/\S*$multi_regexp\S*//o) {
|
# my %c = ();
|
||||||
$number_of_context_groups++;
|
# $cmd =~ s/($replacement_regexp)/$c{$1}++;"\0"/ogex;
|
||||||
}
|
# for my $k (keys %c) {
|
||||||
$no_args = length $cmd;
|
# if(defined $Global::replace_rev{$k}) {
|
||||||
$context = length($command) - $no_args;
|
# $count{$Global::replace_rev{$k}} = $c{$k};
|
||||||
} else {
|
# } else {
|
||||||
$cmd = $command;
|
# $count{::maybe_unquote($k)} = $c{$k};
|
||||||
$cmd =~ s/$multi_regexp//go;
|
# }
|
||||||
$cmd =~ s/$replacement_regexp//go;
|
# $sum += $c{$k};
|
||||||
$no_args = length($cmd);
|
# }
|
||||||
$context = length($command) - $no_args;
|
# my $number_of_context_groups = 0;
|
||||||
}
|
# my $no_args;
|
||||||
for my $k (keys %count) {
|
# my $context;
|
||||||
if(defined $Global::replace{$k}) {
|
# if($context_replace) {
|
||||||
# {} {/} {//} {.} {/.} {#} {%}
|
# $cmd = $command;
|
||||||
$context -= (length $Global::replace{$k}) * $count{$k};
|
# while($cmd =~ s/\S*$multi_regexp\S*//o) {
|
||||||
} else {
|
# $number_of_context_groups++;
|
||||||
# {n}
|
# }
|
||||||
$context -= (length $k) * $count{$k};
|
# $no_args = length $cmd;
|
||||||
}
|
# $context = length($command) - $no_args;
|
||||||
}
|
# } else {
|
||||||
return ($sum,$no_args,$context,$number_of_context_groups,%count);
|
# $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 {
|
sub replaced {
|
||||||
my $self = shift;
|
my $self = shift;
|
||||||
if(not defined $self->{'replaced'}) {
|
if(not defined $self->{'replaced'}) {
|
||||||
my $cmdstring = $self->replace_placeholders($self->{'command'},$Global::quoting);
|
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) {
|
if($opt::cat) {
|
||||||
# Prepend 'cat > {};'
|
# Prepend 'cat > {};'
|
||||||
# Append '_EXIT=$?;(rm {};exit $_EXIT)'
|
# Append '_EXIT=$?;(rm {};exit $_EXIT)'
|
||||||
|
@ -6056,143 +6156,6 @@ sub replaced {
|
||||||
return $self->{'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 {
|
sub replace_placeholders {
|
||||||
# Replace foo{}bar with fooargbar
|
# Replace foo{}bar with fooargbar
|
||||||
# Input:
|
# Input:
|
||||||
|
@ -6209,18 +6172,21 @@ sub replace_placeholders {
|
||||||
# maybe multiple input sources
|
# maybe multiple input sources
|
||||||
# maybe --xapply
|
# maybe --xapply
|
||||||
# $self->{'arg_list'} = [ [Arg11, Arg12], [Arg21, Arg22], [Arg31, Arg32] ]
|
# $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
|
# Fish out the words that have replacement strings in them
|
||||||
my %word;
|
my %word;
|
||||||
for (@target) {
|
for (@target) {
|
||||||
my $tt = $_;
|
my $tt = $_;
|
||||||
# warn $tt;
|
# warn $tt;
|
||||||
if($context_replace) {
|
if($context_replace) {
|
||||||
while($tt =~ s/( (?:\S* \{\{([^{].*?|)\}\})+ \S*)/\0/ox) {
|
while($tt =~ s/( (?:\S* \{=(.*?)=\})+ \S*)/\0/ox) {
|
||||||
$word{$1} ||= 1;
|
$word{$1} ||= 1;
|
||||||
}
|
}
|
||||||
} else {
|
} else {
|
||||||
while($tt =~ s/( (?: \{\{([^{].*?|)\}\})+ )/\0/ox) {
|
while($tt =~ s/( (?: \{=(.*?)=\})+ )/\0/ox) {
|
||||||
$word{$1} ||= 1;
|
$word{$1} ||= 1;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -6241,20 +6207,22 @@ sub replace_placeholders {
|
||||||
# warn($w);
|
# warn($w);
|
||||||
|
|
||||||
# Replace positional arguments
|
# Replace positional arguments
|
||||||
# \000 makes it easier to see where a {{...}} starts and ends
|
# \000 makes it easier to see where a {= perl expr =} starts and ends
|
||||||
$w =~ s/\{\{/\000\{/g;
|
# as \000 will never entered on the command line
|
||||||
$w =~ s/\}\}/\000\}/g;
|
$w =~ s/\{=/\000\{/g;
|
||||||
$w =~ s/ ([^\s\000]*) # before {{
|
$w =~ s/=\}/\000\}/g;
|
||||||
\000\{ # {{
|
$w =~ s/ ([^\s\000]*) # before {=
|
||||||
|
\000\{ # {=
|
||||||
(-?\d+) # Position (eg. -2 or 3)
|
(-?\d+) # Position (eg. -2 or 3)
|
||||||
([^\000]*?) # The perl expression
|
([^\000]*?) # The perl expression
|
||||||
\000\} # }}
|
\000\} # =}
|
||||||
([^\s\000]*) # after }}
|
([^\s\000]*) # after =}
|
||||||
/ $_=$_[$2 > 0 ? $2-1 : $n+$2]; # Set $_ to the argument at the position
|
/ $_=$_[$2 > 0 ? $2-1 : $n+$2]; # Set $_ to the argument at the position
|
||||||
eval("$3"); # evaluate the perl expression
|
eval("$3"); # evaluate the perl expression
|
||||||
$1.$_.$4 /egx;# Prepend and append context
|
$1.$_.$4 /egx;# Prepend and append context
|
||||||
$w =~ s/\000\{/\{\{/g;
|
# Get the {= and =} back
|
||||||
$w =~ s/\000\}/\}\}/g;
|
$w =~ s/\000\{/\{=/g;
|
||||||
|
$w =~ s/\000\}/=\}/g;
|
||||||
# for each arg:
|
# for each arg:
|
||||||
# compute replacement for each string
|
# compute replacement for each string
|
||||||
# replace replacement strings with replacement in the word value
|
# replace replacement strings with replacement in the word value
|
||||||
|
@ -6262,8 +6230,8 @@ sub replace_placeholders {
|
||||||
for my $arg (@_) {
|
for my $arg (@_) {
|
||||||
my $val = $w;
|
my $val = $w;
|
||||||
for my $rplstr (keys %{$self->{'replacecount'}}) {
|
for my $rplstr (keys %{$self->{'replacecount'}}) {
|
||||||
# Replace {{perlexp}} with value for each arg
|
# Replace {= perl expr =} with value for each arg
|
||||||
$val =~ s/\Q{{$rplstr}}\E/$_=$arg;eval("$rplstr");$_/eg;
|
$val =~ s/\Q{=$rplstr=}\E/$_=$arg;eval("$rplstr");$_/eg;
|
||||||
# warn($val," ; ",$rplstr);
|
# warn($val," ; ",$rplstr);
|
||||||
}
|
}
|
||||||
my $ww = $word;
|
my $ww = $word;
|
||||||
|
@ -6276,8 +6244,8 @@ sub replace_placeholders {
|
||||||
if(not @_) {
|
if(not @_) {
|
||||||
my $val = $w;
|
my $val = $w;
|
||||||
for my $rplstr (keys %{$self->{'replacecount'}}) {
|
for my $rplstr (keys %{$self->{'replacecount'}}) {
|
||||||
# Replace {{perlexp}} with value for each arg
|
# Replace {= perl expr =} with value for each arg
|
||||||
$val =~ s/\Q{{$rplstr}}\E/$_="";eval("$rplstr");$_/eg;
|
$val =~ s/\Q{=$rplstr=}\E/$_="";eval("$rplstr");$_/eg;
|
||||||
# warn($val," ; ",$rplstr);
|
# warn($val," ; ",$rplstr);
|
||||||
}
|
}
|
||||||
my $ww = $word;
|
my $ww = $word;
|
||||||
|
@ -6304,98 +6272,6 @@ sub replace_placeholders {
|
||||||
return ("@target");
|
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;
|
package CommandLineQueue;
|
||||||
|
|
||||||
|
@ -6407,45 +6283,60 @@ sub new {
|
||||||
my $max_number_of_args = shift;
|
my $max_number_of_args = shift;
|
||||||
my $return_files = shift;
|
my $return_files = shift;
|
||||||
my @unget = ();
|
my @unget = ();
|
||||||
my ($count,%replacecount,$posrpl,$perlexpr);
|
my ($count,%replacecount,$posrpl,$perlexpr,%len);
|
||||||
my @command = @$commandref;
|
my @command = @$commandref;
|
||||||
# Replace replacement strings with {{perl expr}}
|
# Replace replacement strings with {= perl expr =}
|
||||||
# Protect matching inside {{...}} by replacing {{ and }} with forbidden chars
|
# Protect matching inside {= perl expr =} by replacing {= and =} with forbidden chars
|
||||||
for(@command) {
|
for(@command) {
|
||||||
s/ \{\{([^{].*?|)\}\} / \000\001$1\000\002 /gx;
|
s/ \{=(.*?)=\} /\000\001$1\000\002/gx;
|
||||||
}
|
}
|
||||||
for my $rpl (keys %Global::replace) {
|
for my $rpl (keys %Global::rpl) {
|
||||||
# Replace the short hand string with the {{perl expr}} in $command
|
# Replace the short hand string with the {= perl expr =} in $command
|
||||||
for(@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
|
# Do the same for the positional replacement strings
|
||||||
# A bit harder as we have to put in a number
|
# A bit harder as we have to put in a number
|
||||||
$posrpl = $rpl;
|
$posrpl = $rpl;
|
||||||
$posrpl =~ s/^\{//; # Remove the first {
|
$posrpl =~ s/^\{//; # Remove the first {
|
||||||
$perlexpr = $Global::replace{$rpl};
|
$perlexpr = $Global::rpl{$rpl};
|
||||||
$perlexpr =~ s/^\{\{//; # Remove the first {{
|
$perlexpr =~ s/^\{=//; # Remove the first {=
|
||||||
for(@command) {
|
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) {
|
for(@command) {
|
||||||
s/ \000\001(.*?)\000\002 / \{\{$1\}\} /gx;
|
s/ \000\001(.*?)\000\002 /{=$1=}/gx;
|
||||||
}
|
}
|
||||||
my $sum = 0;
|
my $sum = 0;
|
||||||
while($sum == 0) {
|
while($sum == 0) {
|
||||||
# Count how many times each replacement string is used
|
# Count how many times each replacement string is used
|
||||||
my @cmd = @command;
|
my @cmd = @command;
|
||||||
|
my $contextlen = 0;
|
||||||
|
my $noncontextlen = 0;
|
||||||
|
my $contextgroups = 0;
|
||||||
for my $c (@cmd) {
|
for my $c (@cmd) {
|
||||||
while($c =~ s/ \{\{([^{].*?|)\}\} / \000 /x) {
|
while($c =~ s/ \{=(.*?)=\} /\000/x) {
|
||||||
# %replacecount = { "perlexpr" => number of times seen }
|
# %replacecount = { "perlexpr" => number of times seen }
|
||||||
# e.g { "$_++" => 2 }
|
# e.g { "$_++" => 2 }
|
||||||
$replacecount{$1} ++;
|
$replacecount{$1} ++;
|
||||||
$sum++;
|
$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) {
|
if($sum == 0) {
|
||||||
# Default command = {}
|
# Default command = {}
|
||||||
# If not replacement string: append {}
|
# If not replacement string: append {}
|
||||||
|
@ -6457,7 +6348,7 @@ sub new {
|
||||||
# With --pipe / --pipe-part you can have no replacement
|
# With --pipe / --pipe-part you can have no replacement
|
||||||
last;
|
last;
|
||||||
} else {
|
} 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{'{}'};
|
push @command, $Global::replace{'{}'};
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -6469,6 +6360,7 @@ sub new {
|
||||||
'replacecount' => \%replacecount,
|
'replacecount' => \%replacecount,
|
||||||
'arg_queue' => RecordQueue->new($read_from,$opt::colsep),
|
'arg_queue' => RecordQueue->new($read_from,$opt::colsep),
|
||||||
'context_replace' => $context_replace,
|
'context_replace' => $context_replace,
|
||||||
|
'len' => \%len,
|
||||||
'max_number_of_args' => $max_number_of_args,
|
'max_number_of_args' => $max_number_of_args,
|
||||||
'size' => undef,
|
'size' => undef,
|
||||||
'return_files' => $return_files,
|
'return_files' => $return_files,
|
||||||
|
@ -6490,6 +6382,7 @@ sub get {
|
||||||
$self->{'max_number_of_args'},
|
$self->{'max_number_of_args'},
|
||||||
$self->{'return_files'},
|
$self->{'return_files'},
|
||||||
$self->{'replacecount'},
|
$self->{'replacecount'},
|
||||||
|
$self->{'len'},
|
||||||
);
|
);
|
||||||
$cmd_line->populate();
|
$cmd_line->populate();
|
||||||
::debug("cmd_line->number_of_args ".$cmd_line->number_of_args()."\n");
|
::debug("cmd_line->number_of_args ".$cmd_line->number_of_args()."\n");
|
||||||
|
@ -6962,7 +6855,7 @@ sub read_arg_from_fh {
|
||||||
redo;
|
redo;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
}} while (1 == 0); # Dummy loop for redo
|
}} while (1 == 0); # Dummy loop {{}} for redo
|
||||||
if(defined $arg) {
|
if(defined $arg) {
|
||||||
return Arg->new($arg);
|
return Arg->new($arg);
|
||||||
} else {
|
} else {
|
||||||
|
|
Loading…
Reference in a new issue