{NAME};
my $hName = AttrVal($name, 'HTTPMOD', ''); # which HTTPMOD to use? (url defined there)
my $data = " $service ";
foreach my $arg (@args) {
$data .= "$arg"; # for now only a list of ints
}
$data .= " ";
Log3 $name, 4, "$name: XMLRPC called with $service and " . join (',', map {sprintf("0x%02X", $_)} @args);
Log3 $name, 5, "$name: XMLRPC data = $data";
if ($hName && $defs{$hName} && $defs{$hName}{TYPE} && $defs{$hName}{TYPE} eq "HTTPMOD") {
HTTPMOD::AddToSendQueue($defs{$hName}, {'url' => $defs{$hName}{MainURL}, 'data' => $data, 'type' => 'external'});
} else {
Log3 $name, 3, "$name: XMLRPC does not have valid HTTPMOD device. Please set attr HTTPMOD to a device configured to your STM with port 6680";
}
return;
}
#################################################
# set an output via xmlrpc
sub DoChannelSet {
my $hash = shift;
my $modType = shift;
my $modAdr = shift;
my $modChannel = shift;
my $setVal = shift;
my $name = $hash->{NAME};
my $adrOffset = 0;
my $stmAdr = AttrVal($name, 'STM_ADR', 0);
my($args, $keys) = parseParams(lc($setVal));
my $fName = join ' ', @{$args};
OFFLOOP:
foreach my $off (keys %AdrType) {
if (grep {/^$modType$/i} @{$AdrType{$off}}) {
$adrOffset = $off;
last OFFLOOP
}
}
$modAdr += $adrOffset; # absolute address
Log3 $name, 5, "$name: DoChannelSet called for direct output on $modType (offset $adrOffset), adr $modAdr, ch $modChannel, $fName";
my $hKey = FindFunction($hash, $fName, $modType);
return "function $fName not found" if (!$hKey);
if ($hKey !~ /$modType([0-9][0-9]).*/i) {
return "can not get function number for $hKey";
}
my $function = $1;
my $split = $CodeSplit{uc($modType)}; # get number of bits to combine channel and function
return "unknown module type $modType - can not use splitCode" if (!$split);
my $cmdByte = ($modChannel << $split->[0]) + $function;
my @parseOpts = @{$functions{$hKey}};
Log3 $name, 5, "$name: function def = " . join ",", @parseOpts;
shift @parseOpts;
my %opts;
foreach (@parseOpts) {$opts{$_} = 1};
my @cmdOpts;
if ($opts{'p'}) {
my $prio = $keys->{prio} // 3; # default prio 3
return "illegal prio $prio" if ($prio > 7);
$prio |= 0x40 if ($keys->{set}); # set priority?
push @cmdOpts, $prio;
}
if ($opts{'t1'}||$opts{'t2'}) {
my $time = $keys->{time} // 600; # 60 secs as default
return "illegal time $time" if ($time > 3000);
my $t1 = int($time / 256);
my $t2 = int($time) % 256;
push @cmdOpts, $t2; # low byte
push @cmdOpts, $t1; # high byte
}
if ($opts{'dt1'}) {
my $time = $keys->{time} // 5; # 5 secs as default
return "illegal time $time" if ($time > 160);
my $t1 = int($time * 25 / 16);
push @cmdOpts, $t1;
push @cmdOpts, 0;
}
if ($opts{'dt2'}) {
my $value = $keys->{value} // 128; # 128 as default (50%)
my $time = $keys->{time} // 5; # 5 secs as default
return "illegal time $time" if ($time > 160);
my $t1 = int($time * 25 / 16);
push @cmdOpts, $value;
push @cmdOpts, $t1;
}
XMLRPC($hash, 'service.stm.sendTelegram', $stmAdr, $modAdr, $cmdByte, @cmdOpts);
return;
}
#####################################
# set comand
sub SetFn {
my @setValArr = @_; # remainder is set values
my $hash = shift @setValArr; # reference to Fhem device hash
my $name = shift @setValArr; # Fhem device name
my $setName = shift @setValArr; # name of the set option
my $setVal = join(' ', @setValArr); # set values as one string
Log3 $name, 5, "$name: SetFn called from " . FhemCaller() . " with $setName and $setVal";
return "\"set $name\" needs at least one argument" if(!$setName);
if ($setName eq 'importChannelList') {
if (!$setVal) {
return 'please specify a filename';
}
return DoImport($hash, $setVal);
}
elsif ($setName eq 'emd') {
my @arg = @setValArr;
shift @arg;
shift @arg;
my $fName = lc join(' ', @arg);
return DoEMD($hash, $setValArr[0], $setValArr[1], $fName);
}
elsif ($setName eq "sendRaw") {
my $modAdr = unpack ('H2', $setValArr[0]);
my $hexCmd = $setValArr[1];
SendFrame($hash, $modAdr, $hexCmd);
}
elsif ($setName =~ m{ (EMD|MCC|UIM|AMD|JRM|MFM|DIM) ([\d]+) o ([\d]+) }xmsi) {
my $modType = $1;
my $modAdr = $2;
my $modChannel = $3;
return DoChannelSet($hash, $1, $2, $3, $setVal);
}
else {
my @ChannelSetList = grep { m{channel (EMD|AMD|JRM|DIM|UIM|MCC|MFM) [0-9]+ [o]? [0-9]+ set}xms } keys %{$attr{$name}};
my @setModHintList;
Log3 $name, 5, "$name: check setName $setName against attrs " . join ",", @ChannelSetList if ($setName ne '?');
foreach my $setAttr (@ChannelSetList) {
if ($setAttr =~ m{channel (EMD|AMD|JRM|DIM|UIM|MCC|MFM) ([0-9]+) ([o]?) ([0-9]+) set}xms) {
my $modType = $1;
my $modAdr = $2;
my $o = $3;
my $chAdr = $4;
my $aName = "channel$modType$modAdr$o$chAdr" . 'description';
my $aVal = SanitizeReadingName(lc($attr{$name}{$aName}));
my $nameCmp = SanitizeReadingName(lc($setName));
$nameCmp =~ s/ //g; # channel name without spaces
Log3 $name, 5, "$name: compare $nameCmp with $aVal" if ($setName ne '?');
if ($nameCmp eq $aVal) {
return DoChannelSet($hash, $modType, $modAdr, $chAdr, $setVal);
}
push @setModHintList, $aVal . ':' . join (',', FindOutFunctions($hash, $modType));
}
}
my @virtEMDList = grep { m{virtEMD [0-9]+ C [0-9]+ Name}xms } keys %{$attr{$name}};
foreach my $aName (@virtEMDList) {
if (lc($setName) eq lc($attr{$name}{$aName})) { # ist es der im konkreten Set verwendete setName?
if ($aName =~ m{virtEMD ([0-9]+) C ([0-9]+) Name}xms) {
return DoEMD($hash, $1, $2, $setVal);
}
}
}
# todo: also take input functions from functions hash
my $hints = "Unknown argument $setName, choose one of importChannelList sendRaw amd.*:ein,aus,umschalten" .
' ' . join (' ', map { $attr{$name}{$_} . ':ein>0,ein>1,ein>2,aus,aus<1,aus>1' } @virtEMDList ) .
' ' . join (' ', @setModHintList);
return $hints;
}
return;
}
###############################################################################
# Called from ParseCommands
# find out type of module at $command->{ADR}
# then split the code field into channel and function
# then search in functions hash for matching function and details / options
# set keys in command hash: MTYPE, CHANNEL, FUNCTION, FNAME, PARSEOPTS, CTYPE
#
sub ParsePHCCode {
my $hash = shift; # reference to Fhem device hash
my $command = shift; # reference to command hash containing ADR and CMD
my $name = $hash->{NAME}; # Fhem device name
my $fAdr = sprintf('%03d', $command->{ADR}); # formatted abs module adr for attr lookup (mod type)
my @typeArr = split (',', AttrVal($name, "module${fAdr}type", "")); # potential types from attr
my $typeAttrLen = @typeArr; # number of potential types in attr
@typeArr = @{$AdrType{$command->{ADR} & 0xE0}} if (!@typeArr); # fallback to types from AdrType hash
my $mType = $typeArr[0]; # first option for split (same for all options)
#Log3 $name, 5, "$name: ParseCode called, Adr $fAdr, typeArr = @typeArr, code " . sprintf ('x%02X', $command->{CODE});
#Log3 $name, 5, "$name: ParseCode data = @{$command->{DATA}}";
#Log3 $name, 5, "$name: ParseCode ackdata = @{$command->{ACKDATA}}";
return 'unknown module type' if (!$mType);
$command->{MTYPE} = $mType; # first idea unless we find a fit later
# splitting and therefore channel and function are the same within one address class
# so they are ok to calculate here regardless of the exact module type identified later
my ($channel, $function) = SplitPHCCode($hash, $mType, $command->{CODE});
$command->{CHANNEL} = $channel;
$command->{FUNCTION} = $function;
my $key1 = sprintf('%02d', $function); # formatted function number
my $key2 = sprintf('%02d', $command->{LEN}); # formatted LEN
my $key3 = sprintf('%02d', $command->{ACKLEN}); # formatted ACKLEN
my $wldk = '+';
my @keys = ("$mType$key1$key2$key3", "$mType$key1$wldk$key3", "$mType$key1$key2", "$mType$key1");
Log3 $name, 5, "$name: ParseCode for Adr $fAdr checks typelist @typeArr against" .
" Fkt=" . sprintf ('x%02X', $function) . " Ch=" . sprintf ('x%02X', $channel) .
" Len=$command->{LEN}, ackLen=$command->{ACKLEN}";
my $bestFit = 0; # any fit of key 3, 2 or 1 is better than 0
TYPELOOP:
foreach my $mTypePot (@typeArr) {
#Log3 $name, 5, "$name: ParseCode checks if type of module at $fAdr can be $mTypePot";
# does this module type match better than a previously tested type?
my $idx = 4; # four levels of abstraction in the functions hash
FUNCLOOP:
foreach my $key (@keys) { # four keys, one for each abstraction
if ($functions{$key}) {
#Log3 $name, 5, "$name: match: $key";
if ($idx > $bestFit) { # longer = better matching type found
$bestFit = $idx; # save for next type
my @parseOpts = @{$functions{$key}};
$command->{MTYPE} = $mTypePot;
$command->{FNAME} = shift @parseOpts;
foreach (@parseOpts) {$command->{PARSEOPTS}{$_} = 1};
Log3 $name, 5, "$name: ParseCode match $key / $command->{FNAME} " . join (',', @parseOpts);
}
last FUNCLOOP; # first match is the best for this potential type
}
if (!$idx) { # this was the last try for this type with $idx=0, $key=$mTypePot$key1
@typeArr = grep {!/$mTypePot/} @typeArr; # module type is not an option any more
Log3 $name, 5, "$name: ParseCode could not match to $mTypePot, delete this option";
last FUNCLOOP; # not really necessary because at idx=0 FUNCLOOP is through anyway -> next TYPELOOP
}
$idx--;
}
}
Log3 $name, 4, "$name: ParseCode typelist after matching is @typeArr" if (@typeArr > 1);
return 'no parse info' if (!$command->{FNAME});
$command->{CTYPE} = ($command->{PARSEOPTS}{'i'} ? 'i' : 'o');
if (!$typeAttrLen || (scalar(@typeArr) >= 1 && scalar(@typeArr) < $typeAttrLen)) {
# no moduleType attr so far or we could eliminate an option -> set more specific new attr
CommandAttr(undef, "$name module${fAdr}type " . join (',', @typeArr));
#Log3 $name, 4, "$name: set attr $name module${fAdr}type " . join (',', @typeArr);
}
return;
}
#####################################
# Called from ParseCommands
sub ParseOptions {
my $hash = shift; # reference to Fhem device hash
my $command = shift; # reference to command hash containing ADR and CMD
my $name = $hash->{NAME}; # Fhem device name
my $dLen = @{$command->{DATA}}; # length of Data
if ($command->{PARSEOPTS}{'p'}) { # priority in data[1]
$command->{PRIO} = unpack ('b6', pack ('C', $command->{DATA}[1] & 0x3F));
$command->{PSET} = $command->{DATA}[1] & 0x40;
}
if ($command->{PARSEOPTS}{'t1'}) { # time in data[1] / data[2] (JRM)
$command->{TIME1} = $command->{DATA}[1] + ($command->{DATA}[2] << 8) if ($dLen > 2);
}
if ($command->{PARSEOPTS}{'t2'}) { # times in data[2/3] and data[4/5] ... if existant (JRM)
$command->{TIME1} = $command->{DATA}[2] + ($command->{DATA}[3] << 8) if ($dLen > 3);
$command->{TIME2} = $command->{DATA}[4] + ($command->{DATA}[5] << 8) if ($dLen > 5);
$command->{TIME3} = $command->{DATA}[6] + ($command->{DATA}[7] << 8) if ($dLen > 7);
}
if ($command->{PARSEOPTS}{'dt1'}) { # time in data[1], data[2]=0 (DIM)
$command->{TIME1} = sprintf ('%.0f', $command->{DATA}[1]*16/25 + 0.1) if ($dLen > 2);
}
if ($command->{PARSEOPTS}{'dt2'}) { # time in data[1], data[2]=0 (DIM)
$command->{VALUE} = sprintf ('%.0f', $command->{DATA}[1]) if ($dLen > 2);
$command->{TIME1} = sprintf ('%.0f', $command->{DATA}[2]*16/25 + 0.1) if ($dLen > 2);
}
return;
}
# todo: zumindest bei emds können mehrere codes (channel/function) nacheinender in einer message kommen
# wenn zwei tasten gleichzeitig gedrückt werden...
##########################################################################################
# Called from ParseFrames when a valid command frame and its ACK have been received
# all data is in $hash->{COMMAND}
# call ParsePHCCode to split code into channel / function, find function name and options
# call ParseOptions and then set readings / create events
sub ParseCommands {
my $hash = shift; # reference to Fhem device hash
my $command = shift; # reference to command hash containing ADR and CMD
my $name = $hash->{NAME}; # Fhem device name
my $err = ParsePHCCode($hash, $command) // '';
ParseOptions($hash, $command) if (!$err);
my $lvl = ($err ? 3 : ($command->{MTYPE} eq "CLK" ? 5:4));
LogCommand($hash, $command, $err, $lvl);
# todo: new mode to set on/off depending on command instead of bits in ack message
# to avoid multiple events when a group of outputs on the same module is switched
# and every output creates a redundant event in every command
return if ($command->{MTYPE} eq "CLK"); # don't handle this noisy message
my $busEvents = AttrVal($name, "BusEvents", 'short'); # can be short, long or none
my $longChName = ChannelLongName($hash, $command, $command->{CHANNEL});
my $shortChName = ChannelShortName($hash, $command, $command->{CHANNEL});
my $cmd = $command->{FNAME};
my $event;
if ($busEvents eq 'long') {
$event = $longChName;
}
elsif ($busEvents eq 'short') {
$event = $shortChName;
} # if attr was set to none then $event stays undef
if ($event) {
$event .= ': ' . $cmd if ($cmd);
DoTrigger($name, $event);
Log3 $name, 5, "$name: ParseCommands create Event $event";
}
if (AttrVal($name, "EMDReadings", 0) && $command->{MTYPE} eq "EMD") {
readingsSingleUpdate($hash, $longChName, $cmd, 0); # descriptive reading of EMD command using the long name of the input channel but don't trigger event here
Log3 $name, 5, "$name: ParseCommands sets EMD reading $longChName to $cmd without event";
}
readingsBeginUpdate($hash);
readingsBulkUpdate($hash, 'LastCommand', CmdDetailText($hash, $command)); # reading with full Log-Details of command
# channel bits aus Feedback / Ack verarbeiten
if ($command->{PARSEOPTS}{'cbm'} || $command->{PARSEOPTS}{'cba'}) { # 8 channel bits in command message or in ACK
my $bin = unpack ("B8", pack ("C", ($command->{PARSEOPTS}{'cbm'} ? $command->{DATA}[1] : $command->{ACKDATA}[1])));
Log3 $name, 5, "$name: ParseCommands channel map = $bin";
my $channelBit = 7;
foreach my $c (split //, $bin) {
my $bitName = ChannelLongName($hash, $command, $channelBit);
Log3 $name, 5, "$name: ParseCommands sets reading $bitName for channel $channelBit to $c";
readingsBulkUpdate($hash, $bitName, $c) if ($bitName);
$channelBit --;
}
}
elsif ($command->{PARSEOPTS}{'cb2'}) { # 2 channel bits in ACKData (last two)
my $bin = substr (unpack ("B8", pack ("C", $command->{ACKDATA}[1])), -2);
Log3 $name, 5, "$name: ParseCommands channel map = $bin";
my $channelBit = 1;
foreach my $c (split //, $bin) {
my $bitName = ChannelLongName($hash, $command, $channelBit);
Log3 $name, 5, "$name: ParseCommands sets reading $bitName for channel $channelBit to $c";
readingsBulkUpdate($hash, $bitName, $c) if ($bitName);
$channelBit --;
}
}
my @data = @{$command->{DATA}};
if ($command->{PARSEOPTS}{'i'} && @data > 1) { # input with more data -> more commands
my $codeIdx = 1; # second code
while ($codeIdx < @data) {
Log3 $name, 5, "$name: ParseCommands now handles additional code at Index $codeIdx";
$command->{CODE} = $data[$codeIdx];
my $err = ParsePHCCode($hash, $command) // '';
my $lvl = ($err ? 3 : 4);
LogCommand($hash, $command, $err, $lvl);
DoTrigger($name, ChannelShortName($hash, $command, $command->{CHANNEL}) . ": " . $command->{FNAME});
$codeIdx++;
}
Log3 $name, 5, "$name: ParseCommands done";
}
readingsEndUpdate($hash, 1);
return;
}
#####################################
# Called from the read functions
sub ParseFrames {
my $hash = shift;
my $name = $hash->{NAME};
#Log3 $name, 5, "$name: Parseframes called";
use bytes;
if (!$hash->{skipReason}) {
$hash->{skipBytes} = '';
$hash->{skipReason} = '';
};
BUFLOOP:
while ($hash->{helper}{buffer}) {
$hash->{RAWBUFFER} = unpack ('H*', $hash->{helper}{buffer});
Log3 $name, 5, "$name: Parseframes: loop with raw buffer: $hash->{RAWBUFFER}" if (!$hash->{skipReason});
my $rLen = length($hash->{helper}{buffer});
return if ($rLen < 4);
my ($adr, $lUTog, $rest) = unpack ('CCa*', $hash->{helper}{buffer});
my $xAdr = unpack('H2', $hash->{helper}{buffer});
my $tog = $lUTog >> 7; # toggle bit
my $len = $lUTog & 0x7F; # length
if ($len > 30) {
#Log3 $name, 5, "$name: Parseframes: len > 30, skip first byte of buffer $hash->{RAWBUFFER}";
$hash->{skipBytes} .= substr ($hash->{helper}{buffer}, 0, 1); # add, will be logged later
$hash->{skipReason} .= ($hash->{skipReason} ? ', ' : '') . 'Len > 30';
$hash->{helper}{buffer} = substr ($hash->{helper}{buffer}, 1);
next BUFLOOP;
}
if (($rLen < 20) && ($rLen < $len + 4)) {
Log3 $name, 5, "$name: Parseframes: len is $len so frame shoud be " . ($len + 4) . " but only $rLen read. wait for more";
return;
}
my $frame = substr($hash->{helper}{buffer}, 0, $len + 2); # the frame (adr, tog/len, cmd/data) without crc
my $hFrame = unpack ('H*', $frame);
# extract real pdu
my ($pld, $crc, $rest2) = unpack ("a[$len]va*", $rest); # v = little endian unsigned short, n would be big endian
my @data = unpack ('C*', $pld);
$crc = 0 if (!$crc);
# calculate CRC
my $crc1 = crc($frame, 16, 0xffff, 0xffff, 1, 0x1021, 1, 0);
my $fcrc = unpack ("H*", pack ("v", $crc)); # formatted crc as received
my $fcrc1 = unpack ("H*", pack ("v", $crc1)); # formatted crc as calculated
# check CRC
if ($crc != $crc1) {
my $skip = 1;
#Log3 $name, 5, "$name: Parseframes: CRC error for $hFrame $fcrc, calc $fcrc1) - skip $skip bytes of buffer $hash->{RAWBUFFER}";
$hash->{skipBytes} .= substr ($hash->{helper}{buffer}, 0, $skip);
$hash->{skipReason} .= ($hash->{skipReason} ? ', ' : '') . 'CRC Error';
$hash->{helper}{buffer} = substr ($hash->{helper}{buffer}, $skip);
next BUFLOOP;
}
Log3 $name, 4, "$name: Parseframes: skipped " .
unpack ("H*", $hash->{skipBytes}) . " reason: $hash->{skipReason}"
if $hash->{skipReason};
$hash->{skipBytes} = '';
$hash->{skipReason} = '';
$hash->{helper}{buffer} = $rest2;
#Log3 $name, 5, "$name: Parseframes: Adr $adr/x$xAdr Len $len T$tog Data " . unpack ('H*', $pld) . " (Frame $hFrame $fcrc) Rest " . unpack ('H*', $rest2)
Log3 $name, 5, "$name: Parseframes: Adr $adr/x$xAdr Len $len T$tog Data " . unpack ('H*', $pld) . " (Frame $hFrame $fcrc)"
if ($adr != 224); # todo: remove this filter later (hide noisy stuff)
$hash->{Toggle}{$adr} = ($tog ? 's' : 'c'); # save toggle for potential own sending of data
if ($hash->{COMMAND} && $hFrame eq $hash->{COMMAND}{FRAME}) {
Log3 $name, 4, "$name: Parseframes: Resend of $hFrame $fcrc detected";
next BUFLOOP;
}
my $cmd = $data[0];
if ($cmd == 1) { # Ping / Ping response
if ($hash->{COMMAND} && $hash->{COMMAND}{CODE} == 1
&& $hash->{COMMAND}{ADR} == $adr) { # ping response
# response to a previous ping
Log3 $name, 5, "$name: Parseframes: Ping response received";
$hash->{COMMAND}{ACKDATA} = \@data;
$hash->{COMMAND}{ACKLEN} = $len;
ParseCommands($hash, $hash->{COMMAND});
delete $hash->{COMMAND}; # done with this command
next BUFLOOP;
}
if (!$hash->{COMMAND}) { # new ping request
Log3 $name, 5, "$name: Parseframes: Ping request received";
}
else {
Log3 $name, 4, "$name: Parseframes: new Frame $hFrame $fcrc but no ACK for valid last Frame $hash->{COMMAND}{FRAME} - dropping last one";
delete $hash->{COMMAND}; # done with this command
}
my @oldData = @data; # save data in a new array that can be referenced by the command hash
$hash->{COMMAND} = {CODE => $data[0], ADR => $adr, LEN => $len, TOGGLE => $tog, DATA => \@oldData, FRAME => $hFrame};
next BUFLOOP;
}
elsif ($cmd == 254) { # reset
# todo: get module name / type and show real type / adr in Log, add to comand reading or go through ParseCommands with simulated acl len 0 ...
# parse payload in parsecommand
# por byte, many channel/ function bytes
Log3 $name, 4, "$name: Parseframes: configuration request for adr $adr received - frame is $hFrame $fcrc";
delete $hash->{COMMAND}; # done with this command
next BUFLOOP;
}
elsif ($cmd == 255) { # reset
Log3 $name, 4, "$name: Parseframes: reset for adr $adr received - frame is $hFrame $fcrc";
delete $hash->{COMMAND}; # done with this command
next BUFLOOP;
}
elsif ($cmd == 0) { # ACK received
Log3 $name, 5, "$name: Parseframes: Ack received";
if ($hash->{COMMAND}) {
if ($hash->{COMMAND}{ADR} != $adr) {
Log3 $name, 4, "$name: Parseframes: ACK frame $hFrame $fcrc does not match adr of last Frame $hash->{COMMAND}{FRAME}";
}
elsif ($hash->{COMMAND}{TOGGLE} != $tog) {
Log3 $name, 4, "$name: Parseframes: ACK frame $hFrame $fcrc does not match toggle of last Frame $hash->{COMMAND}{FRAME}";
}
else { # this ack is fine
$hash->{COMMAND}{ACKDATA} = \@data;
$hash->{COMMAND}{ACKLEN} = $len;
ParseCommands($hash, $hash->{COMMAND});
}
delete $hash->{COMMAND}; # done with this command
}
else {
Log3 $name, 4, "$name: Parseframes: ACK frame $hFrame $fcrc without a preceeding request - dropping";
}
next BUFLOOP;
}
else { # normal command - no ack, ping etc.
if ($hash->{COMMAND}) {
Log3 $name, 4, "$name: Parseframes: new Frame $hFrame $fcrc but no ACK for valid last Frame $hash->{COMMAND}{FRAME} - dropping last one";
}
Log3 $name, 5, "$name: Parseframes: $hFrame $fcrc is not an Ack frame, wait for ack to follow";
my @oldData = @data; # save data in a new array that can be referenced by the command hash
$hash->{COMMAND} = {CODE => $data[0], ADR => $adr, LEN => $len, TOGGLE => $tog, DATA => \@oldData, FRAME => $hFrame};
# todo: set timeout timer if not ACK received
}
} # BUFLOOP
return;
}
#####################################
# Called from the global loop, when the select for hash->{FD} reports data
sub ReadFn {
my $hash = shift;
my $name = $hash->{NAME};
my $now = gettimeofday();
# throw away old stuff
if ($hash->{helper}{lastRead} && ($now - $hash->{helper}{lastRead}) > 1) {
if ($hash->{helper}{buffer}) {
Log3 $name, 5, "throw away " . unpack ('H*', $hash->{helper}{buffer});
}
$hash->{helper}{buffer} = "";
}
$hash->{helper}{lastRead} = $now;
my $buf = DevIo_SimpleRead($hash);
return if(!defined($buf));
$hash->{helper}{buffer} .= $buf;
ParseFrames($hash);
return;
}
#####################################
sub ReadyFn {
my $hash = shift;
if ($hash->{STATE} eq "disconnected") {
$hash->{devioLoglevel} = (AttrVal($hash->{NAME}, "silentReconnect", 0) ? 4 : 3);
return DevIo_OpenDev($hash, 1, undef);
}
# This is relevant for windows/USB only
my $po = $hash->{USBDev};
my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags) = $po->status;
return ($InBytes>0);
}
###############################################################
# split code into channel and function depending on module type
sub SplitPHCCode {
my $hash = shift; # phc device hash ref
my $mType = shift; # module type (AMD, EMD, ...)
my $code = shift; # code byte in protocol to be split into channel and function
#Log3 $hash->{NAME}, 5, "$hash->{NAME}: SplitPHCCode called with code $code and type $mType";
my @splitArr = @{$CodeSplit{$mType}};
#Log3 $hash->{NAME}, 5, "$hash->{NAME}: SplitCode splits code " .
# sprintf ('%02d', $code) . " for type $mType into " .
# " channel " . ($code >> $splitArr[0]) . " / function " . ($code & $splitArr[1]);
return ($code >> $splitArr[0], $code & $splitArr[1]); # channel, function
}
###############################################################
# log message with command parse data
sub LogCommand {
my ($hash, $command, $msg, $level) = @_;
Log3 $hash->{NAME}, $level, "$hash->{NAME}: " . FhemCaller() . ' ' . CmdDetailText($hash, $command) . " $msg";
return;
}
###############################################################
# get Text like EMD12i01
sub ChannelShortName {
my $hash = shift; # device hash
my $command = shift; # reference to command hash with ADR, MTYPE, CTYPE
my $channel = shift; # channel number
my $fmAdr = sprintf('%02d', ($command->{ADR} & 0x1F)); # relative module address formatted with two digits
my $mType = $command->{MTYPE};
my $cText = ($mType ? $mType . $fmAdr : 'Module' . sprintf ("x%02X", $command->{ADR})) .
($command->{CTYPE} ? $command->{CTYPE} : "?") .
(defined($channel) ? sprintf('%02d', $channel) : "");
#Log3 $hash->{NAME}, 5, "$hash->{NAME}: ChannelText is $cText";
return $cText;
}
###############################################################
# channel description if attr is defined
# or internal mod/chan text like EMD12i01
sub ChannelLongName {
my $hash = shift; # device hash
my $command = shift; # reference to command hash with ADR, MTYPE, CTYPE
my $channel = shift; # channel number
my $name = $hash->{NAME}; # Fhem device name
my $cName = ChannelShortName($hash, $command, $channel);
my $descr = AttrVal($name, "channel${cName}description", '');
my $bitName = SanitizeReadingName( $descr ? $descr : $cName);
#Log3 $hash->{NAME}, 5, "$hash->{NAME}: ChannelDesc is looking for $aName or $cName, Result name is $bitName";
return $bitName;
}
###############################################################
# full detail of a command for logging
sub CmdDetailText {
my $hash = shift; # device hash
my $command = shift; # reference to command hash with ADR, MTYPE, CTYPE
my $channel = $command->{CHANNEL}; # channel on PHC module
my $cDesc = ChannelLongName($hash, $command, $channel);
my $start = ChannelShortName($hash, $command, $channel);
return ($start ? $start : "") .
(defined($command->{CHANNEL}) ? " Ch$command->{CHANNEL}" : "") .
(defined($command->{FUNCTION}) ? " F$command->{FUNCTION}" : "") .
($command->{FNAME} ? " $command->{FNAME}" : "") .
(defined($command->{PRIO}) ? " P$command->{PRIO}" : "") .
(defined($command->{PRIO}) ? ($command->{PSET} ? " (Set)" : " (no Set)") : "") .
(defined($command->{VALUE}) ? " Value $command->{VALUE}" : "") .
(defined($command->{TIME1}) ? " Time1 $command->{TIME1}" : "") .
(defined($command->{TIME2}) ? " Time2 $command->{TIME2}" : "") .
(defined($command->{TIME3}) ? " Time3 $command->{TIME3}" : "") .
" data " . join (",", map ({sprintf ("x%02X", $_)} @{$command->{DATA}})) .
" ack " . join (",", map ({sprintf ("x%02X", $_)} @{$command->{ACKDATA}})) .
" tg " . $command->{TOGGLE} .
($cDesc ? " $cDesc" : "");
}
###############################################################
# convert description into a usable reading name
sub SanitizeReadingName {
my $bitName = shift;
$bitName =~ s/ä/ae/g;
$bitName =~ s/ö/oe/g;
$bitName =~ s/ü/ue/g;
$bitName =~ s/Ä/Ae/g;
$bitName =~ s/Ö/Oe/g;
$bitName =~ s/Ü/Ue/g;
$bitName =~ s/ß/ss/g;
$bitName =~ s/ / /g;
$bitName =~ s/ -/-/g;
$bitName =~ s/- /-/g;
$bitName =~ s/ /_/g;
$bitName =~ s/[^A-Za-z0-9\-]/_/g;
$bitName =~ s/__/_/g;
$bitName =~ s/__/_/g;
return $bitName;
}
1;
=pod
=item device
=item summary retrieves events / readings from PHC bus and simulates input modules
=item summary_DE hört den PHC-Bus ab, erzeugt Events / Readings und simuliert EMDs
=begin html
PHC
PHC provides a way to communicate with the PHC bus from Peha. It listens to the communication on the PHC bus, tracks the state of output modules in readings and can send events to the bus / "Steuermodul" by simulating PHC input modules.
It can import the channel list file that is exportable from the Peha "Systemsoftware" to get names of existing modules and channels.
This module can not replace a Peha "Steuermodul". It is also not possible to directly send commands to output modules on the PHC bus. If you want to
interact with output modules then you have to define the action on the Peha "Steuermodul" and send the input event to it through a virtual input module.
If you define a virtual input module then it needs to be given a unique address in the allowed range for input modules and this address must not be used by existing input modules.
Prerequisites
-
This module requires the Perl modules Device::SerialPort or Win32::SerialPort and Digest::CRC.
To connect to the PHC bus it requires an RS485 adapter that connects directly to the PHC bus with GND, +data and -data.
Define
define <name> PHC <Device>
The module connects to the PHC bus with the specified device (RS485 adapter)
Examples:
define MyPHC PHC /dev/ttyRS485
Configuration of the module
The module doesn't need configuration to listen to the bus and create readings.
Only if you want to send input to the bus, you need to define a virtual input module with an address that is not used by real modules.
Virtual input modules and their channels are defined using attributes.
Example:
attr MyPHC virtEMD25C2Name VirtLightSwitch
Defines a virtual light switch as channel 2 on the virtual input nodule with address 25. This light switch can then be used with set comands like
set MyPHC VirtualLightSwitch ein>0
The set options offered here are the event types that PHC knows for input modules. They are ein>0, ein>1, ein>2, aus, aus<1.
To react on such events in the PHC system you need to add a reaction to the programming of your PHC control module.
Set-Commands
- importChannelList
reads an xml file that is exportable by the Peha "Systemsoftware" that contains addresses and names of existing modules and channels on the PHC bus.
The path to the filename to import is relative to the Fhem base directory.
Example:
set MyPHC importChannelList Kanalliste.xml
If Kanalliste.xml is located in /opt/fhem.
more set options are created based on the attributes defining virtual input modules / channels
Every input channel for which an attribute like virtEMDxyCcName
is defined will create a valid set option with name specified in the attribute.
Get-Commands
Attributes
=end html
=cut