Perl code modifie logs - perl

Question

I want to program a perl script to change logs format. I want to remove --- from logs. Then separate the CRLF by |.
basically I want to obtain this result :
INFO|[ACTIVE] ExecuteThread: '0' for queue: 'weblogic.kernel.Default (self-tuning)'|JB173F3N|17/02/15 14:32:03:930|Inbound Message | ID: 5 Response-Code: 200 | Encoding: UTF-8 | Content-Type: application/soap+xml; charset=utf-8 | Headers: {connection=[close], Content-Length=[650], content-type=[application/soap+xml; charset=utf-8], Date=[Tue, 17 Feb 2015 13:32:03 GMT], Server=[Apache], X-Powered-By=[Servlet/2.5 JSP/2.1]} | Payload: <?xml version="1.0" encoding="UTF-8"?> | <soap:Envelope xmlns:soap="http://www.w3.org/2003/05/soap-envelope"><soap:Header/><soap:Body><con:Reponse xmlns:con="http://www.erdfdistribution.fr/linky/types/smc/consultation"><con:IdPRM>19136758109411</con:IdPRM><con:CR><dico:Statut xmlns:dico="http://www.erdfdistribution.fr/linky/types/dico">Rejet</dico:Statut><dico:HorEmission xmlns:dico="http://www.erdfdistribution.fr/linky/types/dico">2015-02-17T14:32:03.887+01:00</dico:HorEmission><dico:Detail xmlns:dico="http://www.erdfdistribution.fr/linky/types/dico"><dico:Code>REJ016</dico:Code></dico:Detail></con:CR></con:Reponse></soap:Body></soap:Envelope>
Instead of this One:
INFO|[ACTIVE] ExecuteThread: '0' for queue: 'weblogic.kernel.Default (self-tuning)'|JB173F3N|17/02/15 14:32:03:930|Inbound Message
----------------------------
ID: 5
Response-Code: 200
Encoding: UTF-8
Content-Type: application/soap+xml; charset=utf-8
Headers: {connection=[close], Content-Length=[650], content-type=[application/soap+xml; charset=utf-8], Date=[Tue, 17 Feb 2015 13:32:03 GMT], Server=[Apache], X-Powered-By=[Servlet/2.5 JSP/2.1]}
Payload: <?xml version="1.0" encoding="UTF-8"?>
<soap:Envelope xmlns:soap="http://www.w3.org/2003/05/soap-envelope"><soap:Header/><soap:Body><con:Reponse xmlns:con="http://www.erdfdistribution.fr/linky/types/smc/consultation"><con:IdPRM>19136758109411</con:IdPRM><con:CR><dico:Statut xmlns:dico="http://www.erdfdistribution.fr/linky/types/dico">Rejet</dico:Statut><dico:HorEmission xmlns:dico="http://www.erdfdistribution.fr/linky/types/dico">2015-02-17T14:32:03.887+01:00</dico:HorEmission><dico:Detail xmlns:dico="http://www.erdfdistribution.fr/linky/types/dico"><dico:Code>REJ016</dico:Code></dico:Detail></con:CR></con:Reponse></soap:Body></soap:Envelope>
--------------------------------------
My code doesnt do this, it makes something like clustering in the same line :(
This is my code :
#!/usr/bin/perl
use strict;
use warnings;
use File::Basename;
use Time::Piece;
my $num_args = $#ARGV + 1;
if ($num_args != 2) {
print "\nUsage: Modif_Log.pl inputDirectory outputDirectory\n";
exit;
}
my $inputDirectory=$ARGV[0];
my $outputDirectory=$ARGV[1];
my #liste = glob($inputDirectory."*.log*");
my $today = localtime->strftime('%d%m');
foreach my $s (#liste){
my $inbound ="";
my $outbound ="";
my $id ="";
my $encoding ="";
my $httpMethod ="";
my $contentType ="";
my $headers ="";
my $payload ="";
my $responseCode ="";
my $theAdress ="";
my $others ="";
open ( FILE, $inputDirectory.basename($s) ) || die "can't open file!";
if (-M $inputDirectory.basename($s) < 1 && $s =~ $today) {
print "Processing ".$s."\n";
my #lines = <FILE>;
close (FILE);
my $outputFileName = basename($s);
$outputFileName =~ s/_[0-9]{6}//;
open(my $outputFile, '>', $outputDirectory.$outputFileName) or die "can't open file!";
foreach my $line (#lines) {
chomp($line);
if ($line =~ /Inbound/i) { $inbound .= $line."|"; }
elsif ($line =~ /Outbound/i) { $outbound .= $line."|"; }
elsif ($line =~ /^ID:/) { $id .= $line."|"; }
elsif ($line =~ /^Encoding :/) { $encoding .= $line."|"; }
elsif ($line =~ /^Http-Method:/) { $httpMethod .= $line."|"; }
elsif ($line =~ /^Content-Type:/) { $contentType .= $line."|"; }
elsif ($line =~ /^Headers:/) { $headers .= $line."|"; }
elsif ($line =~ /^Payload:/) { $payload .= $line."|"; }
elsif ($line =~ /^Response-Code:/) { $responseCode .= $line."|"; }
elsif ($line =~ /^Address:/) { $theAdress .= $line."|"; }
elsif ($line !~ /--/) { $others .= $line."|"; }
else { ; }
}
if ($inbound ne "") { print $outputFile $inbound."\n"; }
if ($outbound ne "") { print $outputFile $outbound."\n"; }
if ($id ne "") { print $outputFile $id."\n"; }
if ($encoding ne "") { print $outputFile $encoding."\n"; }
if ($httpMethod ne "") { print $outputFile $httpMethod."\n"; }
if ($contentType ne "") { print $outputFile $contentType."\n"; }
if ($headers ne "") { print $outputFile $headers."\n"; }
if ($payload ne "") { print $outputFile $payload."\n"; }
if ($responseCode ne "") { print $outputFile $responseCode."\n"; }
if ($theAdress ne "") { print $outputFile $theAdress."\n"; }
if ($others ne "") { print $outputFile $others."\n"; }
close $outputFile;
print "Finished Processing ".$s."\n";
} else {
print $s." is older than one day\n";
}
}
Can you please help me ? Perl is turning me creasy

Answer 1

Remove bunch of if-statements and change your forloop as following:
my $buf = q{};
my $last = q{};
my $sep_count = 0;
my $line_number = 0;
foreach my $line (#lines) {
# remove CRLF, chomp only eliminate LF
$line =~ s/\R+//;
$line_number++;
if ($line =~ /^-+$/) {
# if the line is a separator
$sep_count++;
if ($sep_count & 1) {
# begin sep ($sep_count is an odd number)
$buf = $last;
}
else {
# end sep ($sep_count is an even number)
print {$outputFile} "$buf\n";
}
}
else {
if ($sep_count & 1) {
$buf .= ' | ' . $line;
}
else {
# flush $last except for the first line
print {$outputFile} "$last\n" if $line_number != 1;
}
# keep last line (INFO...) to concat
$last = $line;
}
}
print {$outputFile} "$last\n";

Answer 2

Your list of strings are just values that must appear in a line of the input file for it to be included in the output. There is no need to store lines in different variables according to which criterion it matched
This program appears to do what you need. It builds a regular expression from the list of strings so that they can all be tested in a single match. The lines to be printed are accumulated in array #output and printed to the output file when the whole input file has been processed
Note that I've used rel2abs to append a file name to a directory. It takes account of several cases that simple string concatenation doesn't allow for, as well as making the code clearer
I haven't been able to test this except to make sure that it compiles
#!/usr/bin/perl
use strict;
use warnings;
use File::Basename;
use Time::Piece;
use File::Spec::Functions 'rel2abs';
if ( #ARGV != 2 ) {
die "\nUsage: Modif_Log.pl input_dir output_dir\n";
}
my ( $input_dir, $output_dir ) = #ARGV;
my $today = localtime->strftime('%d%m');
my #liste = glob rel2abs( '*.log*', $input_dir );
my #wanted = (
qr/Inbound/i,
qr/Outbound/i,
qr/^ID:/,
qr/^Response-Code:/,
qr/^Encoding :/,
qr/^Http-Method:/,
qr/^Content-Type:/,
qr/^Headers:/,
qr/^Payload:/,
qr/^Address:/,
);
my $wanted = join '|', #wanted;
$wanted = qr/(?:$wanted)/;
for my $input_file ( #liste ) {
unless ( -M $input_file < 1 and $input_file =~ $today ) {
warn qq{"$input_file" is older than one day\n};
next;
}
warn qq{Processing "$input_file"\n};
open my $in_fh, '<', $input_file die qq{Unable to open "$input_file" for input: $!};
my #output;
while ( <$fh> ) {
next unless /$wanted/;
chomp;
push #output, $_;
}
my $output_file_name = basename($input_file);
$output_file_name =~ s/_[0-9]{6}//;
my $output_file = rel2abs($output_file_name, $output_dir);
open my $out_fh, '>', $output_file
or die qq{Unable to open "$output_file" for output: $!};
print $out_fh join(' | ', #output), "\n";
warn qq{Finished Processing "$input_file"\n};
}