2
0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-03-04 05:16:45 +00:00

98_JsonMod.pm: add regex as filter opp (#120700)

git-svn-id: https://svn.fhem.de/fhem/trunk@24360 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
herrmannj 2021-04-29 21:17:23 +00:00
parent 4119043c39
commit 1e3a6808b6

View File

@ -715,9 +715,9 @@ use B;
my ($escape, $reverse); my ($escape, $reverse);
BEGIN { BEGIN {
eval "use JSON::XS;1;" or do { eval "use Cpanel::JSON::XS;1;" or do {
if (not $main::_JSON_PP_WARN) { if (not $main::_JSON_PP_WARN) {
main::Log3 (undef, 3, sprintf('json [%s] is PP. Consider installing JSON::XS', __PACKAGE__)); main::Log3 (undef, 3, sprintf('json [%s] is pure perl. Consider installing Cpanel::JSON::XS', __PACKAGE__));
$main::_JSON_PP_WARN = 1; $main::_JSON_PP_WARN = 1;
}; };
}; };
@ -754,8 +754,8 @@ sub parse {
my ($self, $data) = @_; my ($self, $data) = @_;
my $stream; my $stream;
# use JSON::XS if available # use Cpanel::JSON::XS if available
my $xs = eval 'JSON::XS::encode_json($data)'; my $xs = eval 'Cpanel::JSON::XS::encode_json($data)';
return $xs if ($xs); return $xs if ($xs);
if (my $ref = ref $data) { if (my $ref = ref $data) {
@ -811,9 +811,9 @@ use warnings;
use utf8; use utf8;
BEGIN { BEGIN {
eval "use JSON::XS;1;" or do { eval "use Cpanel::JSON::XS;1;" or do {
if (not $main::_JSON_PP_WARN) { if (not $main::_JSON_PP_WARN) {
main::Log3 (undef, 3, sprintf('json [%s] is PP. Consider installing JSON::XS', __PACKAGE__)); main::Log3 (undef, 3, sprintf('json [%s] is pure perl. Consider installing Cpanel::JSON::XS', __PACKAGE__));
$main::_JSON_PP_WARN = 1; $main::_JSON_PP_WARN = 1;
}; };
}; };
@ -975,8 +975,8 @@ sub parse {
return $@; return $@;
}; };
# use JSON::XS if available # use Cpanel::JSON::XS if available
my $xs = eval 'JSON::XS::decode_json($in)'; my $xs = eval 'Cpanel::JSON::XS::decode_json($in)';
return $xs if ($xs); return $xs if ($xs);
my $err = _decode(\my $value, $in, 1); my $err = _decode(\my $value, $in, 1);
@ -1341,6 +1341,7 @@ sub get {
my $filter; my $filter;
$filter = extract_codeblock($filterText, '()', '\?') $filter = extract_codeblock($filterText, '()', '\?')
and $filter = substr($filter, 1, (length($filter)-2)); and $filter = substr($filter, 1, (length($filter)-2));
die('wrong syntax for JsonPath filter: '.$filterText) unless length($filter);
my ($delim, $list, $idx) = (0, 0, 0); my ($delim, $list, $idx) = (0, 0, 0);
my @parts; my @parts;
@ -1361,6 +1362,7 @@ sub get {
'\s*>=\s*', '\s*>=\s*',
'\s*>\s*', '\s*>\s*',
'\s+in\s+', '\s+in\s+',
'\s*=~\s*',
); );
my $rex = join('|', @operators); my $rex = join('|', @operators);
$rex = qr/^($rex)/; $rex = qr/^($rex)/;
@ -1405,7 +1407,7 @@ sub get {
sub filter { sub filter {
my ($self, $left, $operater, $right) = @_; my ($self, $left, $operater, $right) = @_;
my $result = []; my $result = [];
# fn ref as test for: numeric, string, list # fn ref as test for: numeric, string, list
@ -1418,6 +1420,7 @@ sub filter {
'>' => [sub {$a > $b}, sub {$a gt $b}, undef], '>' => [sub {$a > $b}, sub {$a gt $b}, undef],
'>=' => [sub {$a >= $b}, sub {$a ge $b}, undef], '>=' => [sub {$a >= $b}, sub {$a ge $b}, undef],
'in' => [undef, undef, sub {any {$_ eq $a} @b}], 'in' => [undef, undef, sub {any {$_ eq $a} @b}],
'=~' => [undef, sub {$a =~ m/$b/}, undef],
}; };
# todo: test if right is filter!!! # todo: test if right is filter!!!