Perl代码修改日志

Question

我想编写一个perl脚本来更改日志格式。我想从日志中删除-。然后用|分隔CRLF。

基本上我想要得到这样的结果：

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>

而不是这个：

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>
--------------------------------------

我的代码不能做到这一点，它使类似于在同一行中的集群:(

这是我的代码：

#!/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";
   }
}

你能帮帮我吗？Perl把我变成了克雷塞

Answer 1

删除一堆if语句，并按如下方式更改forloop：

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

字符串列表中的值必须出现在输入文件的一行中，才能包含在输出中。不需要根据匹配的条件将行存储在不同的变量中

这个程序似乎能做你需要的事情。它从字符串列表构建正则表达式，以便可以在单个匹配中测试所有字符串。待打印的行将在数组@output中累积，并在处理完整个输入文件后打印到输出文件

请注意，我已经使用rel2abs将文件名附加到目录。它考虑了简单字符串连接不允许的几种情况，并使代码更清晰

除了确保它可以编译之外，我还无法对其进行测试

#!/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};
}