diff --git a/src/parallel b/src/parallel index 4faeb005..80d581fc 100755 --- a/src/parallel +++ b/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 = ''; @@ -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 {