parallel: --rpl implemented.

This commit is contained in:
Ole Tange 2014-07-01 21:12:13 +02:00
parent f2dfb82a40
commit 0725d2e2f5

View file

@ -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 = ''; my $rev = '';
@ -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 {