mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-05-04 22:19:38 +00:00
98_HTTPMOD: new version with many internal changes, own namespace and functions in a separate utils module
git-svn-id: https://svn.fhem.de/fhem/trunk/fhem@22997 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
StefanStrobel
parent
3fc241c56c
commit
dcb50b8974
3109
FHEM/98_HTTPMOD.pm
3109
FHEM/98_HTTPMOD.pm
File diff suppressed because it is too large
Load Diff
@ -27,20 +27,28 @@ use warnings;
|
|||||||
use GPUtils qw(:all);
|
use GPUtils qw(:all);
|
||||||
use Time::HiRes qw(gettimeofday);
|
use Time::HiRes qw(gettimeofday);
|
||||||
use Encode qw(decode encode);
|
use Encode qw(decode encode);
|
||||||
|
use Scalar::Util qw(looks_like_number);
|
||||||
use DevIo;
|
use DevIo;
|
||||||
|
|
||||||
use Exporter ('import');
|
use Exporter ('import');
|
||||||
our @EXPORT_OK = qw(UpdateTimer FhemCaller
|
our @EXPORT_OK = qw(UpdateTimer FhemCaller
|
||||||
|
StopQueueTimer
|
||||||
|
StartQueueTimer
|
||||||
ValidRegex ValidExpr
|
ValidRegex ValidExpr
|
||||||
EvalExpr
|
EvalExpr
|
||||||
|
FormatVal
|
||||||
MapConvert MapToHint
|
MapConvert MapToHint
|
||||||
|
CheckRange
|
||||||
|
ReverseWordOrder
|
||||||
|
SwapByteOrder
|
||||||
ReadKeyValue StoreKeyValue
|
ReadKeyValue StoreKeyValue
|
||||||
ManageUserAttr
|
ManageUserAttr
|
||||||
MemReading
|
MemReading
|
||||||
FlattenJSON
|
FlattenJSON
|
||||||
BodyDecode
|
BodyDecode
|
||||||
IsOpen
|
IsOpen
|
||||||
FmtTime
|
FmtTimeMs
|
||||||
|
ReadableArray
|
||||||
);
|
);
|
||||||
|
|
||||||
our %EXPORT_TAGS = (all => [@EXPORT_OK]);
|
our %EXPORT_TAGS = (all => [@EXPORT_OK]);
|
||||||
@ -104,43 +112,108 @@ sub UpdateTimer {
|
|||||||
|
|
||||||
if ($cmd eq 'stop' || !$intvl) { # stop timer
|
if ($cmd eq 'stop' || !$intvl) { # stop timer
|
||||||
RemoveInternalTimer("update:$name");
|
RemoveInternalTimer("update:$name");
|
||||||
if ($hash->{TRIGGERTIME}) {
|
if ($hash->{'.TRIGGERTIME'}) {
|
||||||
Log3 $name, 4, "$name: UpdateTimer called from " . FhemCaller() . " with cmd $cmd and interval $intvl stops timer";
|
Log3 $name, 4, "$name: UpdateTimer called from " . FhemCaller() . " with cmd $cmd and interval $intvl stops timer";
|
||||||
delete $hash->{TRIGGERTIME};
|
delete $hash->{'.TRIGGERTIME'};
|
||||||
delete $hash->{TRIGGERTIME_FMT};
|
#delete $hash->{TRIGGERTIME_FMT};
|
||||||
delete $hash->{lastUpdate};
|
delete $hash->{'.LastUpdate'};
|
||||||
}
|
}
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
if ($cmd eq 'next') {
|
if ($cmd eq 'next') {
|
||||||
$hash->{lastUpdate} = $now; # start timer from now, ignore potential last update time
|
$hash->{'.LastUpdate'} = $now; # start timer from now, ignore potential last update time
|
||||||
}
|
}
|
||||||
my $nextUpdate;
|
my $nextUpdate;
|
||||||
if ($hash->{TimeAlign}) { # TimeAlign: do as if interval started at time w/o drift ...
|
if ($hash->{'.TimeAlign'}) { # TimeAlign: do as if interval started at time w/o drift ...
|
||||||
my $count = int(($now - $hash->{TimeAlign}) / $intvl); # $intvl <> 0,has been checked above
|
my $count = int(($now - $hash->{'.TimeAlign'}) / $intvl); # $intvl <> 0,has been checked above
|
||||||
$nextUpdate = $count * $intvl + $hash->{TimeAlign}; # next aligned time >= now, lastUpdate doesn't matter with alignment
|
$nextUpdate = $count * $intvl + $hash->{'.TimeAlign'}; # next aligned time >= now, lastUpdate doesn't matter with alignment
|
||||||
$nextUpdate += $intvl if ($nextUpdate <= $now); # works for initial alignment as welas for next round
|
$nextUpdate += $intvl if ($nextUpdate <= $now); # works for initial alignment as welas for next round
|
||||||
}
|
}
|
||||||
else { # no align time -> just add the interval to now
|
else { # no align time -> just add the interval to now
|
||||||
if ($hash->{lastUpdate}) {
|
if ($hash->{'.LastUpdate'}) {
|
||||||
$nextUpdate = $hash->{lastUpdate} + $intvl;
|
$nextUpdate = $hash->{'.LastUpdate'} + $intvl;
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$nextUpdate = $now; # first call -> don't wait for interval to pass
|
$nextUpdate = $now; # first call -> don't wait for interval to pass
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
$hash->{TRIGGERTIME} = $nextUpdate;
|
$hash->{'.TRIGGERTIME'} = $nextUpdate;
|
||||||
$hash->{TRIGGERTIME_FMT} = FmtDateTime($nextUpdate);
|
#$hash->{TRIGGERTIME_FMT} = FmtDateTime($nextUpdate);
|
||||||
|
|
||||||
my $delay = sprintf ("%.1f", $nextUpdate - $now);
|
my $delay = sprintf ("%.1f", $nextUpdate - $now);
|
||||||
Log3 $name, 4, "$name: UpdateTimer called from " . FhemCaller() . " with cmd $cmd" .
|
Log3 $name, 4, "$name: UpdateTimer called from " . FhemCaller() . " with cmd $cmd" .
|
||||||
" sets timer to call update function in $delay sec at $hash->{TRIGGERTIME_FMT}, interval $intvl";
|
" sets timer to call update function in $delay sec at " . FmtDateTime($nextUpdate) . ", interval $intvl";
|
||||||
RemoveInternalTimer("update:$name");
|
RemoveInternalTimer("update:$name");
|
||||||
InternalTimer($nextUpdate, $updFn, "update:$name", 0); # now set the timer
|
InternalTimer($nextUpdate, $updFn, "update:$name", 0); # now set the timer
|
||||||
return;
|
return;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
######################################################
|
||||||
|
# set internal timer for next queue processing
|
||||||
|
# to now + passed delay (if delay is passed)
|
||||||
|
# if no delay is passed, use attribute queueDelay if no shorter timer is already set
|
||||||
|
#
|
||||||
|
# startQueueTimer is called from Modbus:
|
||||||
|
# - in queueRequest when something got added to the queue
|
||||||
|
# - end of get/set to set it to immediate processing
|
||||||
|
# - at the end of HandleResponse
|
||||||
|
# - in processRequestQueue to set a new delay
|
||||||
|
# - in checkDelay called from processRequestQueue
|
||||||
|
# before it returns 1 (to ask the caller to return because delay is not over yet)
|
||||||
|
# but startQueueTimer does only set the timer if the queue contains something
|
||||||
|
#
|
||||||
|
sub StartQueueTimer {
|
||||||
|
my $ioHash = shift;
|
||||||
|
my $pFunc = shift; # e.g. \&Modbus::ProcessRequestQueue
|
||||||
|
my $oRef = shift; # optional hash ref for passing options
|
||||||
|
my $name = $ioHash->{NAME};
|
||||||
|
my $pDelay = $oRef->{'delay'} // AttrVal($name, 'queueDelay', 1); # delay until queue processing call
|
||||||
|
my $silent = $oRef->{'silent'} // 0;
|
||||||
|
my $msg = $oRef->{'log'} // '';
|
||||||
|
my $qlen = ($ioHash->{QUEUE} ? scalar(@{$ioHash->{QUEUE}}) : 0);
|
||||||
|
|
||||||
|
if ($qlen) {
|
||||||
|
my $now = gettimeofday();
|
||||||
|
my $delay = (defined($pDelay) ? $pDelay : AttrVal($name, 'queueDelay', 1));
|
||||||
|
return if ($ioHash->{nextQueueRun} && $ioHash->{nextQueueRun} < $now+$delay);
|
||||||
|
RemoveInternalTimer ("queue:$name");
|
||||||
|
InternalTimer($now+$delay, $pFunc, "queue:$name", 0);
|
||||||
|
$ioHash->{nextQueueRun} = $now+$delay;
|
||||||
|
Log3 $name, 5, "$name: StartQueueTimer called from " . FhemCaller() .
|
||||||
|
' sets internal timer to process queue in ' .
|
||||||
|
sprintf ('%.3f', $delay) . ' seconds' . ($msg ? ", $msg" : '') if (!$silent);
|
||||||
|
}
|
||||||
|
else {
|
||||||
|
Log3 $name, 5, "$name: StartQueueTimer called from " . FhemCaller() .
|
||||||
|
' removes internal timer because queue is empty' if ($ioHash->{nextQueueRun} && !$silent);
|
||||||
|
delete $ioHash->{nextQueueRun};
|
||||||
|
RemoveInternalTimer ("queue:$name");
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
########################################################################################
|
||||||
|
# remove internal timer for next queue processing
|
||||||
|
# called at the end of open and close (initialized state, queue should be empty)
|
||||||
|
# end when queue becomes empty while processing the queue (not really ... todo:)
|
||||||
|
# when processRequestQueue gets called from fhem.pl via internal timer,
|
||||||
|
# this timer is removed internally -> only nextQueueRun is deleted in processRequestQueue
|
||||||
|
sub StopQueueTimer {
|
||||||
|
my $ioHash = shift;
|
||||||
|
my $oRef = shift; # optional hash ref for passing options
|
||||||
|
my $silent = $oRef->{'silent'} // 0;
|
||||||
|
my $name = $ioHash->{NAME};
|
||||||
|
if ($ioHash->{nextQueueRun}) {
|
||||||
|
RemoveInternalTimer ("queue:$name");
|
||||||
|
delete $ioHash->{nextQueueRun};
|
||||||
|
Log3 $name, 5, "$name: StopQueueTimer called from " . FhemCaller() .
|
||||||
|
' removes internal timer for queue processing' if (!$silent);
|
||||||
|
}
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
#########################################################################
|
#########################################################################
|
||||||
# check if a regex is valid
|
# check if a regex is valid
|
||||||
@ -161,39 +234,6 @@ sub ValidRegex {
|
|||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
##################################################################################
|
|
||||||
# evaluate perl expression and make variables available for the expression
|
|
||||||
# call like $new = EvalExpr($hash, $exp, $rawVal, {'%setValArr' => \@setValArr});
|
|
||||||
#
|
|
||||||
# Problem: can not pass $val and @val at the same time because evalSpecials
|
|
||||||
# expects %val for both.
|
|
||||||
# also $hash can not be passed but will become %hash. Same reason.
|
|
||||||
#
|
|
||||||
sub EvalExprWithFhemFunctions {
|
|
||||||
my $hash = shift; # the current device hash
|
|
||||||
my $exp = shift; # the expression to be used
|
|
||||||
my $text = shift; # the original value to be avaliable as val / old / rawVal
|
|
||||||
my $val_ref = shift; # the values to be passed via EvalSpecials into eval
|
|
||||||
my $name = $hash->{NAME};
|
|
||||||
my %vHash;
|
|
||||||
|
|
||||||
$val_ref = \%vHash if (!$val_ref); # if no value hash is passed create one
|
|
||||||
$val_ref->{'%hash'} = $hash;
|
|
||||||
$val_ref->{'%name'} = $name;
|
|
||||||
$val_ref->{'%val'} = $text if (!exists $val_ref->{'%val'});
|
|
||||||
$val_ref->{'%old'} = $text if (!exists $val_ref->{'%old'});
|
|
||||||
$val_ref->{'%rawVal'} = $text if (!exists $val_ref->{'%rawVal'});
|
|
||||||
$val_ref->{'%inCheckEval'} = 1 if (!exists $val_ref->{'%inCheckEval'});
|
|
||||||
|
|
||||||
if ($exp) {
|
|
||||||
$exp = EvalSpecials($exp, %{$val_ref});
|
|
||||||
$text = AnalyzePerlCommand(undef, $exp);
|
|
||||||
#Log3 $name, 5, "$name: eval $exp resulted in $text";
|
|
||||||
}
|
|
||||||
return $text;
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
###################################################################
|
###################################################################
|
||||||
# new combined function for evaluating perl expressions
|
# new combined function for evaluating perl expressions
|
||||||
# pass values via hash reference similar to fhem EvalSpecials
|
# pass values via hash reference similar to fhem EvalSpecials
|
||||||
@ -213,56 +253,45 @@ sub EvalExprWithFhemFunctions {
|
|||||||
#
|
#
|
||||||
sub EvalExpr {
|
sub EvalExpr {
|
||||||
my $hash = shift; # the current device hash
|
my $hash = shift; # the current device hash
|
||||||
my $exp = shift; # the expression to be used
|
my $oRef = shift; # optional hash ref for passing options and variables for use in expressions
|
||||||
my $vRef = shift; # optional setValArr as reference for use in expressions
|
|
||||||
|
|
||||||
my $name = $hash->{NAME};
|
my $name = $hash->{NAME};
|
||||||
my $val = 0;
|
my $val = $oRef->{'val'} // ''; # need input value already now as potential return value
|
||||||
my @val = ($val);
|
my $checkOnly = $oRef->{'checkOnly'} // 0; # only syntax check
|
||||||
my %vHash;
|
my $NlIfNoExp = $oRef->{'nullIfNoExp'} // 0; # return 0 if expression is missing
|
||||||
|
my $exp = $oRef->{'expr'} // ''; # the expression to be used
|
||||||
my $r = ref $vRef;
|
my $action = $oRef->{'action'} // 'perl expression eval'; # context for logging
|
||||||
if (ref $vRef eq '') {
|
my @val = ($val); # predefined variables, can be overwritten in %vHash
|
||||||
$val = $vRef;
|
my $old = $val;
|
||||||
$vRef = shift;
|
|
||||||
#Log3 $name, 5, "$name: old syntax used, ref is $r, val is $val";
|
|
||||||
} else {
|
|
||||||
$val = $vRef->{'val'} // ''; # need input value already now as potential return value
|
|
||||||
#Log3 $name, 5, "$name: new syntax used, ref is $r, val is $val";
|
|
||||||
}
|
|
||||||
$vRef = \%vHash if (ref ($vRef) ne 'HASH'); # create hash if not passed (rare case)
|
|
||||||
my $action = $vRef->{'action'} // 'perl expression eval'; # context for logging
|
|
||||||
my $checkOnly = $vRef->{'checkOnly'} // 0; # only syntax check
|
|
||||||
return $val if (!$exp);
|
|
||||||
|
|
||||||
my $old = $val; # predefined variables, can be overwritten in %vHash
|
|
||||||
my $rawVal = $val;
|
my $rawVal = $val;
|
||||||
my $text = $val;
|
my $text = $val;
|
||||||
|
return 0 if ($NlIfNoExp && !$exp);
|
||||||
|
return $val if (!$exp);
|
||||||
|
|
||||||
my $inCheckEval = ($checkOnly ? 0 : 1);
|
my $inCheckEval = ($checkOnly ? 0 : 1);
|
||||||
|
|
||||||
my $assign = '';
|
my $assign = '';
|
||||||
foreach my $key (keys %{$vRef}) {
|
foreach my $key (keys %{$oRef}) {
|
||||||
my $type = ref $vRef->{$key};
|
my $type = ref $oRef->{$key};
|
||||||
my $vName = substr($key,1);
|
my $vName = substr($key,1);
|
||||||
my $vType = substr($key,0,1);
|
my $vType = substr($key,0,1);
|
||||||
|
|
||||||
if ($type eq 'SCALAR') {
|
if ($type eq 'SCALAR') {
|
||||||
$assign .= "my \$$vName = \${\$vRef->{'$key'}};"; # assign ref to scalar as scalar
|
$assign .= "my \$$vName = \${\$oRef->{'$key'}};"; # assign ref to scalar as scalar
|
||||||
}
|
}
|
||||||
elsif ($type eq 'ARRAY' && $vType eq '$') {
|
elsif ($type eq 'ARRAY' && $vType eq '$') {
|
||||||
$assign .= "my \$$vName = \$vRef->{'$key'};"; # assign array ref as array ref
|
$assign .= "my \$$vName = \$oRef->{'$key'};"; # assign array ref as array ref
|
||||||
}
|
}
|
||||||
elsif ($type eq 'ARRAY') {
|
elsif ($type eq 'ARRAY') {
|
||||||
$assign .= "my \@$vName = \@{\$vRef->{'$key'}};"; # assign array ref as array
|
$assign .= "my \@$vName = \@{\$oRef->{'$key'}};"; # assign array ref as array
|
||||||
}
|
}
|
||||||
elsif ($type eq 'HASH' && $vType eq '$') {
|
elsif ($type eq 'HASH' && $vType eq '$') {
|
||||||
$assign .= "my \$$vName = \$vRef->{'$key'};"; # assign hash ref as hash ref
|
$assign .= "my \$$vName = \$oRef->{'$key'};"; # assign hash ref as hash ref
|
||||||
}
|
}
|
||||||
elsif ($type eq 'HASH') {
|
elsif ($type eq 'HASH') {
|
||||||
$assign .= "my \%$vName = \%{\$vRef->{'$key'}};"; # assign hash ref as hash
|
$assign .= "my \%$vName = \%{\$oRef->{'$key'}};"; # assign hash ref as hash
|
||||||
}
|
}
|
||||||
elsif ($type eq '' && $vType eq '$') {
|
elsif ($type eq '' && $vType eq '$') {
|
||||||
$assign .= "my \$$vName = \$vRef->{'$key'};"; # assign scalar as scalar
|
$assign .= "my \$$vName = \$oRef->{'$key'};"; # assign scalar as scalar
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
$exp = $assign . ($checkOnly ? 'return undef;' : '') . $exp;
|
$exp = $assign . ($checkOnly ? 'return undef;' : '') . $exp;
|
||||||
@ -280,7 +309,6 @@ sub EvalExpr {
|
|||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
###########################################################
|
###########################################################
|
||||||
# return the name of the caling function for debug output
|
# return the name of the caling function for debug output
|
||||||
sub FhemCaller {
|
sub FhemCaller {
|
||||||
@ -295,19 +323,26 @@ sub FhemCaller {
|
|||||||
#########################################
|
#########################################
|
||||||
# Try to convert a value with a map
|
# Try to convert a value with a map
|
||||||
# called from Set and FormatReading
|
# called from Set and FormatReading
|
||||||
|
# todo: also pass map as named parameter
|
||||||
sub MapConvert {
|
sub MapConvert {
|
||||||
my $hash = shift;
|
my $hash = shift;
|
||||||
my $map = shift;
|
my $oRef = shift; # hash ref for passing options and variables for use in expressions
|
||||||
my $val = shift;
|
|
||||||
my $reverse = shift;
|
my $map = $oRef->{'map'} // ''; # map to use
|
||||||
|
my $reverse = $oRef->{'reverse'} // 0; # use reverse map
|
||||||
|
my $action = $oRef->{'action'} // 'apply map'; # context for logging
|
||||||
|
my $UndefIfNoMatch = $oRef->{'undefIfNoMatch'} // 0; # return undef if map is not matching,
|
||||||
|
my $inVal = $oRef->{'val'} // ''; # input value
|
||||||
my $name = $hash->{NAME};
|
my $name = $hash->{NAME};
|
||||||
|
|
||||||
|
return $inVal if (!$map); # don't change anyting if map is empty
|
||||||
|
|
||||||
$map =~ s/\s+/ /g; # substitute all \t \n etc. by one space only
|
$map =~ s/\s+/ /g; # substitute all \t \n etc. by one space only
|
||||||
if ($reverse) {
|
if ($reverse) {
|
||||||
$map =~ s/([^, ][^,\$]*):([^,][^,\$]*),? */$2:$1, /g; # reverse map
|
$map =~ s/([^, ][^,\$]*):([^,][^,\$]*),? */$2:$1, /g; # reverse map
|
||||||
}
|
}
|
||||||
# spaces in words allowed, separator is ',' or ':'
|
# spaces in words allowed, separator is ',' or ':'
|
||||||
$val = decode ('UTF-8', $val); # convert nbsp from fhemweb
|
my $val = decode ('UTF-8', $inVal); # convert nbsp from fhemweb
|
||||||
$val =~ s/\s| / /g; # back to normal spaces in case it came from FhemWeb with coded Blank
|
$val =~ s/\s| / /g; # back to normal spaces in case it came from FhemWeb with coded Blank
|
||||||
|
|
||||||
my %mapHash = split (/, *|:/, $map); # reverse hash aus dem reverse string
|
my %mapHash = split (/, *|:/, $map); # reverse hash aus dem reverse string
|
||||||
@ -321,7 +356,8 @@ sub MapConvert {
|
|||||||
else {
|
else {
|
||||||
Log3 $name, 3, "$name: MapConvert called from " . FhemCaller() . " did not find $val in" .
|
Log3 $name, 3, "$name: MapConvert called from " . FhemCaller() . " did not find $val in" .
|
||||||
($reverse ? " reversed" : "") . " map $map";
|
($reverse ? " reversed" : "") . " map $map";
|
||||||
return;
|
return if ($UndefIfNoMatch);
|
||||||
|
return $inVal;
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -336,6 +372,102 @@ sub MapToHint {
|
|||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#####################################################################
|
||||||
|
# check that a value is in a defined range
|
||||||
|
sub CheckRange {
|
||||||
|
my $hash = shift;
|
||||||
|
my $oRef = shift; # optional hash ref for passing options and variables for use in expressions
|
||||||
|
my $val = $oRef->{'val'} // ''; # input value
|
||||||
|
my $min = $oRef->{'min'} // ''; # min value
|
||||||
|
my $max = $oRef->{'max'} // ''; # max value
|
||||||
|
my $name = $hash->{NAME};
|
||||||
|
$val =~ s/\s+//g; # remove spaces just to be sure
|
||||||
|
|
||||||
|
# if either min or max are specified, val has to be numeric
|
||||||
|
if (!looks_like_number $val && (looks_like_number $min || looks_like_number $max)) {
|
||||||
|
Log3 $name, 5, "$name: checkRange for " . FhemCaller() . " rejects $val because it is not numeric";
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
if (looks_like_number $min) {
|
||||||
|
Log3 $name, 5, "$name: checkRange for " . FhemCaller() . " checks $val against min $min";
|
||||||
|
return if ($val < $min);
|
||||||
|
}
|
||||||
|
if (looks_like_number $max) {
|
||||||
|
Log3 $name, 5, "$name: checkRange for " . FhemCaller() . " checks $val against max $max";
|
||||||
|
return if ($val > $max);
|
||||||
|
}
|
||||||
|
return 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#####################################################################
|
||||||
|
# check that a value is in a defined range
|
||||||
|
sub FormatVal {
|
||||||
|
my $hash = shift;
|
||||||
|
my $oRef = shift; # optional hash ref for passing options and variables for use in expressions
|
||||||
|
my $val = $oRef->{'val'} // ''; # input value
|
||||||
|
my $format = $oRef->{'format'} // ''; # format string
|
||||||
|
my $name = $hash->{NAME};
|
||||||
|
|
||||||
|
return $val if (!$format);
|
||||||
|
my $newVal = sprintf($format, $val);
|
||||||
|
Log3 $name, 5, "$name: FormatVal for " . FhemCaller() . " formats $val with $format, result is $newVal";
|
||||||
|
return $newVal;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#####################################
|
||||||
|
# called from send and parse
|
||||||
|
# reverse order of word registers
|
||||||
|
sub ReverseWordOrder {
|
||||||
|
my $hash = shift; # hash only needed for logging
|
||||||
|
my $buffer = shift;
|
||||||
|
my $len = shift;
|
||||||
|
my $name = $hash->{NAME}; # name of device for logging
|
||||||
|
|
||||||
|
use bytes;
|
||||||
|
$len = length($buffer) if (!defined $len); # optional parameter
|
||||||
|
return $buffer if ($len < 2 || length ($buffer) < 3); # nothing to be done if only one register
|
||||||
|
Log3 $name, 5, "$name: ReverseWordOrder is reversing order of up to $len registers";
|
||||||
|
my $work = substr($buffer, 0, $len * 2); # the first 2*len bytes of buffer
|
||||||
|
my $rest = substr($buffer, $len * 2); # everything after len
|
||||||
|
|
||||||
|
my $new = '';
|
||||||
|
while ($work) {
|
||||||
|
$new = substr($work, 0, 2) . $new; # prepend first two bytes of work to new
|
||||||
|
$work = substr($work, 2); # remove first word from work
|
||||||
|
}
|
||||||
|
my $newBuffer = $new . $rest;
|
||||||
|
Log3 $name, 5, "$name: ReverseWordOrder for " . FhemCaller() . " is transforming "
|
||||||
|
. unpack ('H*', $buffer) . " to " . unpack ('H*', $newBuffer);
|
||||||
|
return $newBuffer;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#####################################
|
||||||
|
# called from send and parse
|
||||||
|
# reverse byte order in word registers
|
||||||
|
sub SwapByteOrder {
|
||||||
|
my $hash = shift; # hash only needed for logging
|
||||||
|
my $buffer = shift;
|
||||||
|
my $len = shift;
|
||||||
|
my $name = $hash->{NAME}; # name of device for logging
|
||||||
|
|
||||||
|
use bytes;
|
||||||
|
$len = length($buffer) if (!defined $len); # optional parameter
|
||||||
|
Log3 $name, 5, "$name: SwapByteOrder is reversing byte order of up to $len registers";
|
||||||
|
my $rest = substr($buffer, $len * 2); # everything after len
|
||||||
|
my $nval = '';
|
||||||
|
for (my $i = 0; $i < $len; $i++) {
|
||||||
|
$nval = $nval . substr($buffer,$i*2 + 1,1) . substr($buffer,$i*2,1);
|
||||||
|
};
|
||||||
|
my $newBuffer = $nval . $rest;
|
||||||
|
Log3 $name, 5, "$name: SwapByteOrder for " . FhemCaller() . " is transforming "
|
||||||
|
. unpack ('H*', $buffer) . " to " . unpack ('H*', $newBuffer);
|
||||||
|
return $newBuffer;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
#########################################################################
|
#########################################################################
|
||||||
# set userAttr-Attribute for Regex-Attrs
|
# set userAttr-Attribute for Regex-Attrs
|
||||||
# pass device hash and new attr based on a regex attr
|
# pass device hash and new attr based on a regex attr
|
||||||
@ -547,22 +679,22 @@ sub BodyDecode {
|
|||||||
if ($bodyDecode eq 'auto' or $bodyDecode eq 'Auto') {
|
if ($bodyDecode eq 'auto' or $bodyDecode eq 'Auto') {
|
||||||
if ($header =~/Content-Type:.*charset=([\w\-\.]+)/i) {
|
if ($header =~/Content-Type:.*charset=([\w\-\.]+)/i) {
|
||||||
$bodyDecode = $1;
|
$bodyDecode = $1;
|
||||||
Log3 $name, 4, "$name: Read found charset header and set decoding to $bodyDecode (bodyDecode was set to auto)";
|
Log3 $name, 4, "$name: BodyDecode found charset header and set decoding to $bodyDecode (bodyDecode was set to auto)";
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$bodyDecode = "";
|
$bodyDecode = "";
|
||||||
Log3 $name, 4, "$name: Read found no charset header (bodyDecode was set to auto)";
|
Log3 $name, 4, "$name: BodyDecode found no charset header (bodyDecode was set to auto)";
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
if ($bodyDecode) {
|
if ($bodyDecode) {
|
||||||
if ($bodyDecode =~ m{\A [Nn]one \z}xms) {
|
if ($bodyDecode =~ m{\A [Nn]one \z}xms) {
|
||||||
Log3 $name, 4, "$name: Read is not decoding the response body (set to none)";
|
Log3 $name, 4, "$name: BodyDecode is not decoding the response body (set to none)";
|
||||||
}
|
}
|
||||||
else {
|
else {
|
||||||
$body = decode($bodyDecode, $body);
|
$body = decode($bodyDecode, $body);
|
||||||
Log3 $name, 4, "$name: Read is decoding the response body as $bodyDecode ";
|
Log3 $name, 4, "$name: BodyDecode is decoding the response body as $bodyDecode ";
|
||||||
}
|
}
|
||||||
#Log3 $name, 5, "$name: Read callback " . ($body ? "new body as utf-8 is: \n" . encode ('utf-8', $body) : "body empty");
|
#Log3 $name, 5, "$name: BodyDecode callback " . ($body ? "new body as utf-8 is: \n" . encode ('utf-8', $body) : "body empty");
|
||||||
}
|
}
|
||||||
return $body;
|
return $body;
|
||||||
}
|
}
|
||||||
@ -583,8 +715,7 @@ sub IsOpen {
|
|||||||
|
|
||||||
####################################################
|
####################################################
|
||||||
# format time as string with msecs as fhem.pl does
|
# format time as string with msecs as fhem.pl does
|
||||||
sub FmtTime($)
|
sub FmtTimeMs {
|
||||||
{
|
|
||||||
my $time = shift // 0;
|
my $time = shift // 0;
|
||||||
my $seconds;
|
my $seconds;
|
||||||
my $mseconds;
|
my $mseconds;
|
||||||
@ -607,6 +738,15 @@ sub FmtTime($)
|
|||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
|
#########################################################
|
||||||
|
sub ReadableArray {
|
||||||
|
my $val = shift;
|
||||||
|
my $vString = '';
|
||||||
|
foreach my $v (@{$val}) {
|
||||||
|
$vString .= ($vString eq '' ? '' : ', ') . ($v =~ /^[[:print:]]+$/ ? $v : 'hex ' . unpack ('H*', $v));
|
||||||
|
}
|
||||||
|
return $vString
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
1;
|
1;
|
||||||
|
|||||||
Loading…
x
Reference in New Issue
Block a user