Replace every second comma in a text file - perl

I recorded some data on my laptop and because the OS system language is German it converted the decimal separator to a comma (didn't think of that at the time...).
The column separator (there are three columns in the text file) is a comma too and so I end up with six columns instead of three
Example.txt
4,0,5,0,6,0
should be
4.0, 5.0, 6.0
How can I loop through all files in a folder and replace every first, third and fifth comma with a point in all lines in my data-files? I would prefer a bash script (.sh) or possibly a perl solution

Or how about awk
for F in * ; do awk -F, 'BEGIN { OFS = "," } ; { print $1"."$2, $3"."$4, $5"."$6 } ' $F | sponge $F ; done
You need "moreutils" for sponge, by the way. And back up your files first!

Generally for csv parsing you should use Text::CSV, however for this correction task, a quick and dirty could be:
#!/usr/bin/perl
use strict;
use warnings;
my $output;
#onen my $out, '>', 'outfile.dat';
#open my $in, '<', 'infile.dat';
#while(<$in>){
while(<DATA>){
chomp;
my #fields = split ',';
while (#fields) {
$output .= shift(#fields) . '.' . shift(#fields);
$output .= ', ' if #fields;
}
$output .= "\n";
}
#print $out $output;
print $output;
__DATA__
4,0,5,0,6,0
4,0,5,0,6,0
of course you will read from a file rather than DATA and print to a new file presumably. I have added this real-world usage as comments.

Well I see lots of valid and good answers here, here's another.
perl -wpe 'my $i; s/,/($i^=1) ? "." : ","/ge'
Here /e means "execute the replacement part"; $i^=1 generates a 1,0,1,0...sequence, and x?y:z selects y or z based on x's value (i.e. if (x) {y} else {z})

Following perl script should help you.
perl -e '$a = $ARGV[0]; $a =~ s/(\d)\,(\d\,)?/$1\.$2/g; print $a' "4,0,5,0,6,0"
OUTPUT
4.0,5.0,6.0

In Perl, the necessary regex would be s/,([^,]*,?)/.$1/g. If you apply this to a string, it will replace the first comma with a period, preserve the next comma (if any), and then start looking for commas again after the second one.

Related

Search and replace a string in a file

I'm trying to read contents from an input file, copy only certain lines of code from the file and print in an output file.
Certain lines of code is determined by:
Code name to determine the first line (IP1_NAME or IP2_NAME)
Pattern to determine the last line (END_OF_LIST)
Input file:
IP1_NAME
/ip1name/ip1dir/ //CLIENT_NAME/ip1name/ip1dir
/ip1testname/ip1testdir/ //CLIENT_NAME/ip1testname/ip1testdir
END_OF_LIST
IP2_NAME
/ip2name/ip2dir/ //CLIENT_NAME/ip2name/ip2dir
/ip2testname/ip2testdir/ //CLIENT_NAME/ip2testname/ip2testdir
END_OF_LIST
Output file:
(If IP1_NAME is chosen and the CLIENT_NAME should be replaced by tester_ip)
/ip1name/ip1dir/ //tester_ip/ip1name/ip1dir
/ip1testname/ip1testdir/ //tester_ip/ip1testname/ip1testdir
You could use the following one-liner to pull out the lines between the two patterns:
perl -0777 -ne 'print "$1\n" while /IP1_NAME(.*?)END_OF_LIST/gs' in.txt > out.txt
Where in.txt is your input file and out.txt is the output file.
This use case is actually described in perlfaq6: Regular Expressions.
You can then modify the output file to replace CLIENT_NAME with tester_ip:
perl -pi -e 's/CLIENT_NAME/tester_ip/' y.txt
As a script instead of a one-liner, using the scalar range operator:
#/usr/bin/env perl
use warnings;
use strict;
use autodie;
use feature qw/say/;
process('input.txt', qr/^IP1_NAME$/, qr/^END_OF_LIST$/, 'tester_ip');
sub process {
my ($filename, $startpat, $endpat, $newip) = #_;
open my $file, '<', $filename;
while (my $line = <$file>) {
chomp $line;
if ($line =~ /$startpat/ .. $line =~ /$endpat/) {
next unless $line =~ /^\s/; # Skip the start and lines.
$line =~ s/^\s+//; # Remove indentation
$line =~ s/CLIENT_NAME/$newip/g; # Replace with desired value
say $line;
}
}
}
Running this on your sample input file produces:
/ip1name/ip1dir/ //tester_ip/ip1name/ip1dir
/ip1testname/ip1testdir/ //tester_ip/ip1testname/ip1testdir
I am assuming there is additional stuff in your input file, otherwise we would not have to jump through the hoops with these start and end markers as and we could just say
perl -ne "print if /^ /"
and that would be silly, right ;-)
So, the flipflop has potential problems as I stated in my comment. And while clever, it does not buy you that much in terms of readability or verbosement (verbocity?), since you have to test again anyway in order to not process the marker lines.
As long as there is no exclusive flip flop operator, I would go for a more robust solution.
my $in;
while (<DATA>) {
$in = 1, next if /^IP\d_NAME/;
$in = 0 if /^END_OF_LIST/;
if ( $in )
{
s/CLIENT_NAME/tester_ip/;
print;
}
}
__DATA__
cruft
IP1_NAME
/ip1name/ip1dir/ //CLIENT_NAME/ip1name/ip1dir
/ip1testname/ip1testdir/ //CLIENT_NAME/ip1testname/ip1testdir
END_OF_LIST
more
cruft
IP2_NAME
/ip2name/ip2dir/ //CLIENT_NAME/ip2name/ip2dir
/ip2testname/ip2testdir/ //CLIENT_NAME/ip2testname/ip2testdir
END_OF_LIST
Lore Ipsargh!

sort alphabetically whole word in first array position

I have a file with values separated by pipe |
input:
car tree alfa young|salt brick|23223|
emilia jack albert| way to go|56566|
I'm trying to sort first column alphabetically and write sorted file out.
result:
alfa car tree young|salt brick|23223|
albert emilia jack| way to go|56566|
What I have tried:
can sort first array position but cant write out all file content.
$filename = 'test.dat';
open (INPUT,"$filename");
open (OUTPUT,">out.dat");
while (<INPUT>)
{
#array = split('\|');
#arr = split(' ',$array[0]);
$,=" ";
print OUTPUT sort #arr,"\n";
}
close (INPUT);
close (OUTPUT);
sorts everything in each line.
$filename = 'test.dat';
open (INPUT,"$filename");
open (OUTPUT,">out.dat");
while (<INPUT>)
{
#arr = split(' ');
$,=" ";
print OUTPUT sort #arr,"\n";
}
close (INPUT);
close (OUTPUT);
Your programs will be far more flexible if you move away from the idea of hard-coding file names in your code. It's a much better idea to read from STDIN and write to STDOUT whenever possible. That's what this code does.
#!/usr/bin/perl
use strict;
use warnings;
while (<>) {
# Split the record into the first field (the one we want to sort)
# and everything else.
my ($first, $rest) = split /\|/, $_, 2;
# Split the first record into words
my #words = split /\s+/, $first;
# Sort #words and then join the line back together and print it.
print join(' ', sort #words), "|$rest";
}
If we store this program in a file called reorder, we can then run it from a command-line prompt like this:
$ ./reorder < test.dat > out.dat
We avoid having to open any filehandles (the operating system does it for us) and we don't need to change the program if the filenames ever change.
perl -pe 's/^([^|]+)/#a = sort split ' ', $1; "#a";/e' myfile
After you've split the line into an array
my #ary = split '\|';
you need to split the first element, sort the list, and join it back
my $first = join ' ', sort split ' ', shift #ary;
where shift removes (and returns) the first element.
Then build the string back
my $new_string = join '|', $first, #ary;
This can be done without temporary variables. The last two steps can be done in one statement, and all of it right in a print statement.
Comments
Please always start your programs with use warnings; and use strict;
Use three-argument form of open
open my $fh, '<', $file or die "Can't open $file: $!";
and so use lexical filehandles ($fh), not bareword (typeglobs, FH).
Don't quote things that don't need to be quoted -- even errors can result! See What's wrong with always quoting (perlfaq4), for instance. Thanks to Sinan Ünür for the comment.
You can also do it with a regex
$line =~ s/(.*?)\|/join(" ", sort split " ", $1).q(|)/e;
This captures the first field (up to the pipe), and runs the above code on it, courtesy of /e modifier which makes replacement part be evaluated as code.
We needed to also match the pipe and then put it back. This can be avoided using lookahead
$line =~ s/(.*?)(?=\|)/join(' ', sort split ' ', $1)/e;
which only asserts that the pattern inside (?=...) is there, without consuming it.
Your first bit of code is so very close to being right. You're only outputting the first column though - you need to print out the contents of #array. If you replace the first element of #array with the sorted results, then you can just write it out like this.
#array = split('\|');
$array[0] = join(" ",sort split(' ',$array[0]));
print OUTPUT join("|",#array),"\n";

With Perl, how do I read records from a file with two possible record separators?

Here is what I am trying to do:
I want to read a text file into an array of strings. I want the string to terminate when the file reads in a certain character (mainly ; or |).
For example, the following text
Would you; please
hand me| my coat?
would be put away like this:
$string[0] = 'Would you;';
$string[1] = ' please hand me|';
$string[2] = ' my coat?';
Could I get some help on something like this?
This will do it. The trick to using split while preserving the token you're splitting on is to use a zero-width lookback match: split(/(?<=[;|])/, ...).
Note: mctylr's answer (currently the top rated) isn't actually correct -- it will split fields on newlines, b/c it only works on a single line of the file at a time.
gbacon's answer using the input record separator ($/) is quite clever--it's both space and time efficient--but I don't think I'd want to see it in production code. Putting one split token in the record separator and the other in the split strikes me as a little too unobvious (you have to fight that with Perl ...) which will make it hard to maintain. I'm also not sure why he's deleting multiple newlines (which I don't think you asked for?) and why he's doing that only for the end of '|'-terminated records.
# open file for reading, die with error message if it fails
open(my $fh, '<', 'data.txt') || die $!;
# set file reading to slurp (whole file) mode (note that this affects all
# file reads in this block)
local $/ = undef;
my $string = <$fh>;
# convert all newlines into spaces, not specified but as per example output
$string =~ s/\n/ /g;
# split string on ; or |, using a zero-width lookback match (?<=) to preserve char
my (#strings) = split(/(?<=[;|])/, $string);
One way is to inject another character, like \n, whenever your special character is found, then split on the \n:
use warnings;
use strict;
use Data::Dumper;
while (<DATA>) {
chomp;
s/([;|])/$1\n/g;
my #string = split /\n/;
print Dumper(\#string);
}
__DATA__
Would you; please hand me| my coat?
Prints out:
$VAR1 = [
'Would you;',
' please hand me|',
' my coat?'
];
UPDATE: The original question posed by James showed the input text on a single line, as shown in __DATA__ above. Because the question was poorly formatted, others edited the question, breaking the 1 line into 2. Only James knows whether 1 or 2 lines was intended.
I prefer #toolic's answer because it deals with multiple separators very easily.
However, if you wanted to overly complicate things, you could always try:
#!/usr/bin/perl
use strict; use warnings;
my #contents = ('');
while ( my $line = <DATA> ) {
last unless $line =~ /\S/;
$line =~ s{$/}{ };
if ( $line =~ /^([^|;]+[|;])(.+)$/ ) {
$contents[-1] .= $1;
push #contents, $2;
}
else {
$contents[-1] .= $1;
}
}
print "[$_]\n" for #contents;
__DATA__
Would you; please
hand me| my coat?
Something along the lines of
$text = <INPUTFILE>;
#string = split(/[;!]/, $text);
should do the trick more or less.
Edit: I've changed "/;!/" to "/[;!]/".
Let Perl do half the work for you by setting $/ (the input record separator) to vertical bar, and then extract semicolon-separated fields:
#!/usr/bin/perl
use warnings;
use strict;
my #string;
*ARGV = *DATA;
$/ = "|";
while (<>) {
s/\n+$//;
s/\n/ /g;
push #string => $1 while s/^(.*;)//;
push #string => $_;
}
for (my $i = 0; $i < #string; ++$i) {
print "\$string[$i] = '$string[$i]';\n";
}
__DATA__
Would you; please
hand me| my coat?
Output:
$string[0] = 'Would you;';
$string[1] = ' please hand me|';
$string[2] = ' my coat?';

Neatest way to remove linebreaks in Perl

I'm maintaining a script that can get its input from various sources, and works on it per line. Depending on the actual source used, linebreaks might be Unix-style, Windows-style or even, for some aggregated input, mixed(!).
When reading from a file it goes something like this:
#lines = <IN>;
process(\#lines);
...
sub process {
#lines = shift;
foreach my $line (#{$lines}) {
chomp $line;
#Handle line by line
}
}
So, what I need to do is replace the chomp with something that removes either Unix-style or Windows-style linebreaks.
I'm coming up with way too many ways of solving this, one of the usual drawbacks of Perl :)
What's your opinion on the neatest way to chomp off generic linebreaks? What would be the most efficient?
Edit: A small clarification - the method 'process' gets a list of lines from somewhere, not nessecarily read from a file. Each line might have
No trailing linebreaks
Unix-style linebreaks
Windows-style linebreaks
Just Carriage-Return (when original data has Windows-style linebreaks and is read with $/ = '\n')
An aggregated set where lines have different styles
After digging a bit through the perlre docs a bit, I'll present my best suggestion so far that seems to work pretty good. Perl 5.10 added the \R character class as a generalized linebreak:
$line =~ s/\R//g;
It's the same as:
(?>\x0D\x0A?|[\x0A-\x0C\x85\x{2028}\x{2029}])
I'll keep this question open a while yet, just to see if there's more nifty ways waiting to be suggested.
Whenever I go through input and want to remove or replace characters I run it through little subroutines like this one.
sub clean {
my $text = shift;
$text =~ s/\n//g;
$text =~ s/\r//g;
return $text;
}
It may not be fancy but this method has been working flawless for me for years.
$line =~ s/[\r\n]+//g;
Reading perlport I'd suggest something like
$line =~ s/\015?\012?$//;
to be safe for whatever platform you're on and whatever linefeed style you may be processing because what's in \r and \n may differ through different Perl flavours.
Note from 2017: File::Slurp is not recommended due to design mistakes and unmaintained errors. Use File::Slurper or Path::Tiny instead.
extending on your answer
use File::Slurp ();
my $value = File::Slurp::slurp($filename);
$value =~ s/\R*//g;
File::Slurp abstracts away the File IO stuff and just returns a string for you.
NOTE
Important to note the addition of /g , without it, given a multi-line string, it will only replace the first offending character.
Also, the removal of $, which is redundant for this purpose, as we want to strip all line breaks, not just line-breaks before whatever is meant by $ on this OS.
In a multi-line string, $ matches the end of the string and that would be problematic ).
Point 3 means that point 2 is made with the assumption that you'd also want to use /m otherwise '$' would be basically meaningless for anything practical in a string with >1 lines, or, doing single line processing, an OS which actually understands $ and manages to find the \R* that proceed the $
Examples
while( my $line = <$foo> ){
$line =~ $regex;
}
Given the above notation, an OS which does not understand whatever your files '\n' or '\r' delimiters, in the default scenario with the OS's default delimiter set for $/ will result in reading your whole file as one contiguous string ( unless your string has the $OS's delimiters in it, where it will delimit by that )
So in this case all of these regex are useless:
/\R*$// : Will only erase the last sequence of \R in the file
/\R*// : Will only erase the first sequence of \R in the file
/\012?\015?// : When will only erase the first 012\015 , \012 , or \015 sequence, \015\012 will result in either \012 or \015 being emitted.
/\R*$// : If there happens to be no byte sequences of '\015$OSDELIMITER' in the file, then then NO linebreaks will be removed except for the OS's own ones.
It would appear nobody gets what I'm talking about, so here is example code, that is tested to NOT remove line feeds. Run it, you'll see that it leaves the linefeeds in.
#!/usr/bin/perl
use strict;
use warnings;
my $fn = 'TestFile.txt';
my $LF = "\012";
my $CR = "\015";
my $UnixNL = $LF;
my $DOSNL = $CR . $LF;
my $MacNL = $CR;
sub generate {
my $filename = shift;
my $lineDelimiter = shift;
open my $fh, '>', $filename;
for ( 0 .. 10 )
{
print $fh "{0}";
print $fh join "", map { chr( int( rand(26) + 60 ) ) } 0 .. 20;
print $fh "{1}";
print $fh $lineDelimiter->();
print $fh "{2}";
}
close $fh;
}
sub parse {
my $filename = shift;
my $osDelimiter = shift;
my $message = shift;
print "Parsing $message File $filename : \n";
local $/ = $osDelimiter;
open my $fh, '<', $filename;
while ( my $line = <$fh> )
{
$line =~ s/\R*$//;
print ">|" . $line . "|<";
}
print "Done.\n\n";
}
my #all = ( $DOSNL,$MacNL,$UnixNL);
generate 'Windows.txt' , sub { $DOSNL };
generate 'Mac.txt' , sub { $MacNL };
generate 'Unix.txt', sub { $UnixNL };
generate 'Mixed.txt', sub {
return #all[ int(rand(2)) ];
};
for my $os ( ["$MacNL", "On Mac"], ["$DOSNL", "On Windows"], ["$UnixNL", "On Unix"]){
for ( qw( Windows Mac Unix Mixed ) ){
parse $_ . ".txt", #{ $os };
}
}
For the CLEARLY Unprocessed output, see here: http://pastebin.com/f2c063d74
Note there are certain combinations that of course work, but they are likely the ones you yourself naívely tested.
Note that in this output, all results must be of the form >|$string|<>|$string|< with NO LINE FEEDS to be considered valid output.
and $string is of the general form {0}$data{1}$delimiter{2} where in all output sources, there should be either :
Nothing between {1} and {2}
only |<>| between {1} and {2}
In your example, you can just go:
chomp(#lines);
Or:
$_=join("", #lines);
s/[\r\n]+//g;
Or:
#lines = split /[\r\n]+/, join("", #lines);
Using these directly on a file:
perl -e '$_=join("",<>); s/[\r\n]+//g; print' <a.txt |less
perl -e 'chomp(#a=<>);print #a' <a.txt |less
To extend Ted Cambron's answer above and something that hasn't been addressed here: If you remove all line breaks indiscriminately from a chunk of entered text, you will end up with paragraphs running into each other without spaces when you output that text later. This is what I use:
sub cleanLines{
my $text = shift;
$text =~ s/\r/ /; #replace \r with space
$text =~ s/\n/ /; #replace \n with space
$text =~ s/ / /g; #replace double-spaces with single space
return $text;
}
The last substitution uses the g 'greedy' modifier so it continues to find double-spaces until it replaces them all. (Effectively substituting anything more that single space)

Why isn't Perl's tr/// doing what I want?

I am using Perl for a script that takes in input as two short strings of DNA. As an output, I concatenate the two strings strings then print the second string lined up over its copy at the end of the concatenated string. For example: if input string are AAAA and TTTTT then print:
AAAAATTTTT
TTTTT
I know there are other ways to do this but I am curious to know why my use of tr/// isn't working.
The code for the program is:
use strict;
use warnings;
print "enter a DNA sequence \n";
$DNA1=<>; #<> shorthand for STDIN
$DNA1=~ s/\r?\n?$//;
print $DNA1 "\n\n";
print "enter second DNA sequence \n";
$DNA2=<>;
$DNA2=~ s/\r?\n?$//;
print $DNA2 "\n\n";
$DNA= join("",($DNA1,$DNA2));
print "Both DNA sequences are \"$DNA\" \n\n";
$DNA3=$DNA1;
$DNA3=~ tr/ATCGatcg//;
print $DNA3 "\n\n";
$DNA4= join("",($DNA3,$DNA2));
print $DNA4 "\n\n";
exit;
Your tr changes any of ACTGatcg and removes them. I think you want
$DNA3 =~ tr/atcgATCG/ /;
You need to put a space in the second half of the tr command.
Alternatively, it seems that what you're trying to do is create a variable containing as many spaces as there were characters in the first string:
my $spaces = ' ' x length($DNA1);
It might just be a simple syntax error. Try:
$DNA3 =~ tr/ATCGatcg/ /;
where the second slash separates your two translation entities, and you have a space character between the second and third slashes.
Good luck!
Edit: my mistake - misunderstood what you wanted to do. Answer adjusted accordingly :)
Is this the program that you want?
#!perl
my $s1 = 'AAAAAAAAA';
my $s2 = 'TCGAGCTA';
print
$s1, $s2, "\n",
' ' x length( $s1 ), $s2, "\n";