Я получаю сообщение об ошибке «Не могу использовать строку в качестве ссылки HA SH, в то время как« строгие ссылки »....» при использовании моего кода perl

Question

я использую этот код perl для преобразования JSON в другую форму с некоторыми регулярными выражениями:

use strict;
use warnings;
use feature 'say';
use JSON;
use utf8;
my %IDs = ( 'User awx01 logged in.' => 1001 );  
my %levels = ( INFO => 4 );             
my $data = <DATA>;                      
my $json    = data2json($data);         
my $record  = decode_json($json);       
say rec2msg($record);
sub data2json {                         
    my $json = shift;                   
    $json =~ s/[""]/"/g;
    $json =~ s/\\//g;
    $json =~ s/"(\{.*?\})"/$1/;
    return $json;
}
sub rec2msg {                           
    my $r = shift;
    $r->{Message}{message} =~ /(\w+) (\w+) (.+)/;

    my($user,$msg) = ($2,"$1 $3");
    my $ID   = $IDs{$r->{Message}{message}};
    my $level   = $levels{$r->{Message}{level}};

    my $out = "$r->{Message}{'@timestamp'} host CEF:0|OpenSource|AWX|7.0.0|$ID|$msg|$level|src=127.0.0.1 dst=$r->{MessageSourceAddress} duser=$user";
    return $out;
}
__DATA__
{"MessageSourceAddress":"192.168.81.20","EventReceivedTime":"2020-02-06 11:55:14","SourceModuleName":"udp","SourceModuleType":"im_udp","SyslogFacilityValue":1,"SyslogFacility":"USER","SyslogSeverityValue":5,"SyslogSeverity":"NOTICE","SeverityValue":2,"Severity":"INFO","EventTime":"2020-02-06 11:55:14","Hostname":"192.168.81.20","Message":"{\"@timestamp\": \"2020-02-06T08:55:52.907Z\", \"message\": \"User awx01 logged in.\", \"host\": \"awxweb\", \"level\": \"INFO\", \"logger_name\": \"awx.api.generics\", \"stack_info\": null, \"type\": \"other\", \"cluster_host_id\": \"awx-contr-01\", \"tower_uuid\": \"333b4131-495f-4460-8e4b-890241a9d73d\"}"}

Но я получаю эту ошибку:

2020-03-31 20:48:50 ERROR perl subroutine rec2msg failed with an error: 'Can't use string ("140511667030448") as a HASH ref while "strict refs" in use at /usr/libexec/nxlog/modules/extension/perl/event1.pl line 21.;'

Что я делаю неправильно? Как я могу решить это?

Answer 1

У вас есть JSON, встроенный в JSON, поэтому вам нужно декодировать его дважды. Это часто происходит, когда одна служба проходит через ответ для другой службы.

Ваш data2json не декодировал этот второй уровень, поэтому значение для имени Message все еще было строкой. Так как это значение не было ссылкой ha sh, вы получите сообщение об ошибке.

Вы не хотите использовать кучу подстановок для всего объекта, потому что вы можете непреднамеренно изменить то, что не должны ' не возиться. Расшифруйте верхний уровень так же, как вы, но затем сделайте то же самое для значения Message:

# read in all the data, even though it looks like a single line. Maybe it won't be later.
my $data = do { local $/; <DATA> };

# decode the first layer
my $decoded = decode_json( $data );

# decode the Message value:
$decoded->{Message} = decode_json( $decoded->{Message} );

Теперь, когда вы вызываете rec2msg, это должно сработать.

Обратите внимание, что проблема заключается в обратном. Вы не можете просто закодировать все это в JSON снова. Значение для Message все еще должно быть строкой, поэтому вам нужно сначала ее кодировать, если вы хотите отправить ее куда-нибудь еще. Если вы делаете это, вы, вероятно, хотите работать над копией. Я использую dclone для создания глубокой копии, поэтому все, что я делаю с $encoded, не отображается в $decoded:

# make a deep copy so nested references aren't shared
use Storable qw(dclone);
my $encoded = dclone( $decoded );
$encoded->{Message} = encode_json( $encoded->{Message} );
my $new_data = encode_json( $encoded );

Тогда $new_data будет иметь тот же выход, что и исходный ввод.

---

Вот и все:

use strict;
use warnings;
use feature 'say';
use JSON;
use utf8;
my %IDs = ( 'User awx01 logged in.' => 1001 );
my %levels = ( INFO => 4 );

# read in all the data, even though it looks
my $data = do { local $/; <DATA> };
my $decoded = decode_json( $data );
$decoded->{Message} = decode_json( $decoded->{Message} );

say rec2msg($decoded);

sub rec2msg {
    my $r = shift;
    $r->{Message}{message} =~ /(\w+) (\w+) (.+)/;

    my($user,$msg) = ($2,"$1 $3");
    my $ID    = $IDs{$r->{Message}{message}};
    my $level = $levels{$r->{Message}{level}};

    my $out = "$r->{Message}{'@timestamp'} host CEF:0|OpenSource|AWX|7.0.0|$ID|$msg|$level|src=127.0.0.1 dst=$r->{MessageSourceAddress} duser=$user";
    return $out;
}