diff --git a/CHANGED b/CHANGED index cad6d102d..5996163b4 100644 --- a/CHANGED +++ b/CHANGED @@ -1,5 +1,7 @@ # Add changes at the top of the list. Keep it in ASCII, and 80-char wide. # Do not insert empty lines here, update check depends on it. + - feature: 98_archetype: new option for FILTER in actual_.* attributes + - change: 98_archetype: now packaged, extend commandref - feature: 89_AndroidDB: Added FHEM reading attributes - bugfix: 70_SVDRP.pm: bugfix in NextTimer - bugfix: 38_netatmo: fixed average wind angle calculation for PUBLIC diff --git a/FHEM/98_archetype.pm b/FHEM/98_archetype.pm index 9549b4f9d..6b2ddb14a 100755 --- a/FHEM/98_archetype.pm +++ b/FHEM/98_archetype.pm @@ -1,6 +1,6 @@ -########################################################################## +# Id ########################################################################## # $Id$ - +# # copyright ################################################################### # # 98_archetype.pm @@ -22,196 +22,276 @@ # You should have received a copy of the GNU General Public License # along with FHEM. If not, see . -# verbose -# Set the verbosity level. Possible values: -# 0 - server start/stop -# 1 - error messages or unknown packets -# 2 - major events/alarms. -# 3 - commands sent out will be logged. -# 4 - you'll see whats received by the different devices. -# 5 - debugging. +=pod +defmod acFHEMapp archetype LichtAussenTerrasse +attr acFHEMapp userattr actual_appOptions +attr acFHEMapp actual_appOptions {genericDeviceType2appOption($name)} +attr acFHEMapp attributes appOptions +attr acFHEMapp splitRooms 1 +=cut -package main; - use strict; - use warnings; +package archetype; ##no critic qw(Package) +use strict; +use warnings; +use GPUtils qw(GP_Import); +use JSON (); # qw(decode_json encode_json); +use utf8; +use List::Util 1.45 qw(max min uniq); +#use FHEM::Meta; -# forward declarations ######################################################## -sub archetype_Initialize($); +sub ::archetype_Initialize { goto &Initialize } -sub archetype_Define($$); -sub archetype_Undef($$); -sub archetype_Set($@); -sub archetype_Get($@); -sub archetype_Attr(@); -sub archetype_Notify($$); +BEGIN { -sub archetype_AnalyzeCommand($$$$$); -sub archetype_attrCheck($$$$;$); -sub archetype_DEFcheck($$;$) ; -sub archetype_define_inheritors($;$$$); -sub archetype_derive_attributes($;$$$); -sub archetype_devspec($;$); -sub archetype_evalSpecials($$;$); -sub archetype_inheritance($;$$); + GP_Import( qw( + addToAttrList + addToDevAttrList + readingsSingleUpdate + Log3 + defs attr cmds modules + DAYSECONDS HOURSECONDS MINUTESECONDS + init_done + InternalTimer + RemoveInternalTimer + CommandAttr + CommandDeleteAttr + readingFnAttributes + IsDisabled IsDevice + AttrVal + InternalVal + ReadingsVal + devspec2array + AnalyzeCommandChain + AnalyzeCommand + CommandDefMod + CommandDelete + EvalSpecials + AnalyzePerlCommand + perlSyntaxCheck + evalStateFormat + getAllAttr + setNotifyDev + deviceEvents + ) ) +}; -sub CommandClean($$); # initialize ################################################################## -sub archetype_Initialize($) { - my ($hash) = @_; - my $TYPE = "archetype"; +sub Initialize { + my $hash = shift // return; + my $TYPE = 'archetype'; - Log(5, "$TYPE - call archetype_Initialize"); + $hash->{DefFn} = \&Define; + $hash->{UndefFn} = \&Undef; + $hash->{SetFn} = \&Set; + $hash->{GetFn} = \&Get; + $hash->{AttrFn} = \&Attr; + $hash->{NotifyFn} = \&Notify; - $hash->{DefFn} = "$TYPE\_Define"; - $hash->{UndefFn} = "$TYPE\_Undef"; - $hash->{SetFn} = "$TYPE\_Set"; - $hash->{GetFn} = "$TYPE\_Get"; - $hash->{AttrFn} = "$TYPE\_Attr"; - $hash->{NotifyFn} = "$TYPE\_Notify"; - - $hash->{AttrList} = "" - . "actual_.+ " + $hash->{AttrList} = + "actual_.+ " . "actualTYPE " . "attributes " . "autocreate:1,0 " . "deleteAttributes:0,1 " . "disable:0,1 " . "initialize:textField-long " - . "metaDEF:textField-long " - . "metaNAME:textField-long " - . "readingList " + . "metaDEF:textField-long metaNAME:textField-long " + . "readingList setList:textField-long " . "relations " - . "setList:textField-long " - . "splitRooms:0,1 " + . "splitRooms:0,1 " #useEval:0,1 " . $readingFnAttributes ; - addToAttrList("attributesExclude"); + addToAttrList('attributesExclude','archetype'); my %hash = ( - Fn => "CommandClean", - Hlp => "[check]" + Fn => 'CommandClean', + Hlp => 'archetype [clean or check], set attributes according to settings in archetypes' ); - $cmds{clean} = \%hash; + $cmds{archetype} = \%hash; + return; } + # regular Fn ################################################################## -sub archetype_Define($$) { - my ($hash, $def) = @_; - my ($SELF, $TYPE, $DEF) = split(/[\s]+/, $def, 3); +sub Define { + my $hash = shift // return; + my $def = shift // return; + #return $@ if !FHEM::Meta::SetInternals($hash); + my ($SELF, $TYPE, $DEF) = split m{\s+}xms, $def, 3; Log3($SELF, 5, "$TYPE ($SELF) - call archetype_Define"); - if($hash->{DEF} eq "derive attributes"){ + if($hash->{DEF} eq 'derive attributes'){ + #https://forum.fhem.de/index.php/topic,53402.msg452468.html#msg452468 - 'derive attributes' als spezielle DEF implementieren um den alias nach dem Muster : [] [] abzuleiten + #https://forum.fhem.de/index.php/topic,53402.msg453030.html#msg453030 - für ein archetype mit der DEF "derive attributes" die Befehle "set derive attributes" und "get pending attributes" implementieren + #- Muster für derive attributes im archetype konfigurierbar machen my $derive_attributes = $modules{$TYPE}{derive_attributes}; return( "$TYPE for deriving attributes already definded as " . "$derive_attributes->{NAME}" - ) if($derive_attributes); + ) if $derive_attributes; $modules{$TYPE}{derive_attributes} = $hash; } - $hash->{DEF} = "defined_by=$SELF" unless($DEF); - $hash->{NOTIFYDEV} = "global"; - $hash->{STATE} = "active" - unless(AttrVal($SELF, "stateFormat", undef) || IsDisabled($SELF)); + $hash->{DEF} = "defined_by=$SELF" if !$DEF; + setNotifyDev($hash,'global'); + #$hash->{NOTIFYDEV} = 'global'; + if ( !IsDisabled($SELF) ) { + readingsSingleUpdate($hash, 'state', 'active', 0); + evalStateFormat($hash); + } - return; + return $init_done ? firstInit($hash) : InternalTimer(time+100, \&firstInit, $hash ); } -sub archetype_Undef($$) { - my ($hash, $SELF) = @_; + +sub firstInit { + my $hash = shift // return; + my $name = $hash->{NAME}; + for (devspec2array('defined_by=.+')) { + addToDevAttrList($_, 'defined_by','archetype'); + } + return; +} + + +sub Undef { + my $hash = shift // return; + my $SELF = shift // return; my $TYPE = $hash->{TYPE}; Log3($SELF, 5, "$TYPE ($SELF) - call archetype_Undef"); delete $modules{$TYPE}{derive_attributes} - if($hash->{DEF} eq "derive attributes"); + if $hash->{DEF} eq 'derive attributes'; return; } -sub archetype_Set($@) { - my ($hash, @arguments) = @_; - my $SELF = shift @arguments; +sub Set { #($@) + my $hash = shift // return; + my $SELF = shift // return; + my $argument = shift // return '"set " needs at least one argument'; + my @arguments = @_; + my $TYPE = $hash->{TYPE}; Log3($SELF, 5, "$TYPE ($SELF) - call archetype_Set"); - return "\"set $TYPE\" needs at least one argument" unless(@arguments); - - my $argument = shift @arguments; - my $value = join(" ", @arguments) if(@arguments); + my $value = @arguments ? join q{ }, @arguments : undef; my %archetype_sets; - if($hash->{DEF} eq "derive attributes"){ + if ( $hash->{DEF} eq 'derive attributes' ) { %archetype_sets = ( - "addToAttrList" => "addToAttrList:textField" - , "derive" => "derive:attributes" + addToAttrList => 'addToAttrList:textField' + , derive => 'derive:attributes' ); } else{ %archetype_sets = ( - "define" => "define:inheritors" - , "inheritance" => "inheritance:noArg" - , "initialize" => "initialize:inheritors" - , "raw" => "raw:textField" + define => 'define:inheritors', + inheritance => 'inheritance:noArg', + initialize => 'initialize:inheritors', + raw => 'raw:textField' ); - $archetype_sets{(split(":", $_))[0]} = $_ - foreach (split(/[\s]+/, AttrVal($SELF, "setList", ""))); + my $inheritors = join q{,}, archetype_devspec($SELF); + if ($inheritors) { $archetype_sets{import} = "import:select,$inheritors" }; + $archetype_sets{(split m{:}x, $_)[0]} = $_ + for ( split m{[\s]+}x, AttrVal($SELF, 'setList', '') ); } return( "Unknown argument $argument, choose one of " - . join(" ", values %archetype_sets) - ) unless(exists($archetype_sets{$argument})); + . join q{ }, values %archetype_sets + ) if !exists $archetype_sets{$argument}; - if($argument eq "addToAttrList"){ - addToAttrList($value); + if($argument eq 'addToAttrList'){ + return addToAttrList($value); } - elsif($argument eq "derive" && $value eq "attributes"){ + if($argument eq "derive" && $value eq "attributes"){ Log3($SELF, 3, "$TYPE ($SELF) - starting $argument $value"); - archetype_derive_attributes($SELF); + derive_attributes($SELF); Log3($SELF, 3, "$TYPE ($SELF) - $argument $value done"); + return; } - elsif($argument eq "define" && $value eq "inheritors"){ + + if($argument eq "define" && $value eq "inheritors"){ Log3($SELF, 3, "$TYPE ($SELF) - starting $argument $value"); - archetype_define_inheritors($SELF); + define_inheritors($SELF); Log3($SELF, 3, "$TYPE ($SELF) - $argument $value done"); + return; } - elsif($argument eq "inheritance"){ + + if($argument eq "inheritance"){ Log3($SELF, 3, "$TYPE ($SELF) - starting $argument inheritors"); - archetype_inheritance($SELF); + _inheritance($SELF); + return; } - elsif($argument eq "initialize" && $value eq "inheritors"){ + + if($argument eq "initialize" && $value eq "inheritors"){ Log3($SELF, 3, "$TYPE ($SELF) - starting $argument $value"); - archetype_define_inheritors($SELF, $argument); + define_inheritors($SELF, $argument); - Log3($SELF, 3, "$TYPE ($SELF) - $argument $value done"); + return Log3($SELF, 3, "$TYPE ($SELF) - $argument $value done"); } - elsif($argument eq "raw" && $value){ - (my $command, $value) = split(/[\s]+/, $value, 2); - return "\"set $TYPE\" $argument at least one command and argument" - unless($value); + if($argument eq "raw" && $value){ + (my $command, $value) = split m{[\s]+}x, $value, 2; + + if ( !$value ) { + return qq("set $TYPE $argument" needs at least one command and one argument); + } Log3($SELF, 3, "$TYPE ($SELF) - $command $value"); - fhem("$command " . join(",", archetype_devspec($SELF)) . " $value"); + #fhem("$command " . join(",", archetype_devspec($SELF)) . " $value"); + my $targets = join q{,}, archetype_devspec($SELF); + return if !$targets; + return AnalyzeCommandChain($hash, "$command $targets $value"); } - else{ + + if($argument eq 'import' && $value){ + $hash->{'.importing'} = 1; + return qq("set $TYPE $argument" requires an existing device as argument) + if !$value || !defined $defs{$value}; + + my @toImport = split m{[\s,]+}x, AttrVal($SELF, 'attributes', getAllAttr($value)); + for (@toImport) { + $_ = (split m{:}x, $_, 2)[0]; + } + my $ownlist = AttrVal($SELF, 'attributes', undef); + my @newlist; + + for my $import ( @toImport ) { + next if $import =~ m{\A[.]}x; # no hidden attributes! + my $cont = AttrVal($value, $import, undef); + next if !$cont; + push @newlist, $import; + $cont = $cont =~ m{\A\{.*\}\z}xms ? "undef,Perl:$cont" : "undef:$cont"; + CommandAttr(undef, "$SELF actual_$import $cont"); + } + if (!$ownlist) { + $ownlist = join q{ }, @newlist; + CommandAttr(undef, "$SELF attributes $ownlist"); + } + delete $hash->{'.importing'}; + return; + } + + #else{ my @readingList = split(/[\s]+/, AttrVal($SELF, "readingList", "")); - if(@readingList && grep(/\b$argument\b/, @readingList)){ + if( @readingList && grep { m/\b$argument\b/ } @readingList ){ Log3($SELF, 3, "$TYPE set $SELF $argument $value"); readingsSingleUpdate($hash, $argument, $value, 1); @@ -221,55 +301,56 @@ sub archetype_Set($@) { readingsSingleUpdate($hash, "state", "$argument $value", 1); } - } + #} return; } -sub archetype_Get($@) { - my ($hash, @arguments) = @_; - my $SELF = shift @arguments; +sub Get { + #($@) my ($hash, @arguments) = @_; + my $hash = shift // return; + my $SELF = shift // return; + my $argument = shift // return '"get " needs at least one argument'; + my @arguments = @_; + my $TYPE = $hash->{TYPE}; Log3($SELF, 5, "$TYPE ($SELF) - call archetype_Get"); - return "\"get $TYPE\" needs at least one argument" unless(@arguments); - - my $argument = shift @arguments; - my $value = join(" ", @arguments) if(@arguments); - my $derive_attributes = $hash->{DEF} eq "derive attributes"; + my $value = @arguments ? join q{ }, @arguments : undef; + my $derive_attributes = $hash->{DEF} eq 'derive attributes'; my %archetype_gets; if($derive_attributes){ %archetype_gets = ( - "inheritors" => "inheritors:noArg", - "pending" => "pending:attributes" + inheritors => 'inheritors:noArg', + pending => 'pending:attributes' ); }else{ %archetype_gets = ( - "inheritors" => "inheritors:noArg", - "pending" => "pending:attributes,inheritors", - "relations" => "relations:noArg" + inheritors => 'inheritors:noArg', + pending => 'pending:attributes,inheritors', + relations => 'relations:noArg' ); } return( "Unknown argument $argument, choose one of " - . join(" ", values %archetype_gets) - ) unless(exists($archetype_gets{$argument})); + . join q{ }, values %archetype_gets + ) if !exists $archetype_gets{$argument}; - return "$SELF is disabled" if(IsDisabled($SELF)); + return "$SELF is disabled" if IsDisabled($SELF); - if($argument =~ /^(inheritors|relations)$/){ + if ($argument =~ m{\A(inheritors|relations)\z}xms){ Log3($SELF, 3, "$TYPE ($SELF) - starting request $argument"); my @devspec; if($derive_attributes){ - @devspec = archetype_devspec($SELF, "specials"); + @devspec = archetype_devspec($SELF, 'specials'); } - elsif($argument eq "relations"){ - @devspec = archetype_devspec($SELF, "relations"); + elsif($argument eq 'relations'){ + @devspec = archetype_devspec($SELF, 'relations'); } else{ @devspec = archetype_devspec($SELF); @@ -277,188 +358,219 @@ sub archetype_Get($@) { Log3($SELF, 3, "$TYPE ($SELF) - request $argument done"); - return @devspec ? join("\n", @devspec) : "no $argument defined"; + return @devspec ? join "\n", @devspec : "no $argument defined"; } - elsif($argument eq "pending"){ + if($argument eq 'pending'){ Log3($SELF, 3, "$TYPE ($SELF) - starting request $argument $value"); my @ret; - if($value eq "attributes"){ + if($value eq 'attributes'){ my @attributes = sort(split(/[\s]+/, AttrVal($SELF, "attributes", ""))); if($derive_attributes){ - @ret = archetype_derive_attributes($SELF, 1); + @ret = derive_attributes($SELF, 1); } else{ - foreach (archetype_devspec($SELF)){ + for my $ds (archetype_devspec($SELF)){ for my $attribute (@attributes){ - my $desired = - AttrVal( - $SELF, "actual_$attribute", AttrVal($SELF, $attribute, "") - ); + my $desired = _get_desired($SELF, $attribute, $ds); + #AttrVal( + # $SELF, "actual_$attribute", AttrVal($SELF, $attribute, "") + #); - next if($desired eq ""); + next if !$desired || $desired eq ''; - push(@ret, archetype_attrCheck($SELF, $_, $attribute, $desired, 1)); + push @ret, _attrCheck($SELF, $ds, $attribute, $desired, 1); } } } } - elsif($value eq "inheritors"){ - @ret = archetype_define_inheritors($SELF, 0, 1); + elsif($value eq 'inheritors'){ + @ret = define_inheritors($SELF, 0, 1); } Log3($SELF, 3, "$TYPE ($SELF) - request $argument $value done"); - return(@ret ? join("\n", @ret) : "no $value $argument"); - return( - "Unknown argument $value, choose one of " - . join(" ", split(",", (split(":", $archetype_gets{$argument}))[1])) - ); + return @ret ? join "\n", @ret : "no $value $argument"; #soft form required } + return "Unknown argument $value, choose one of " + . join q{ }, split m{,}x, (split m{:}x, $archetype_gets{$argument})[1]; } -sub archetype_Attr(@) { +sub _get_desired { + my $SELF = shift // return; #Beta-User: only first argument seem to be mandatory + my $attribute = shift // return; + my $devspec = shift; + + my $desired = AttrVal($devspec, "actual_$attribute", undef); #compability layer + return $desired if $desired; + + $desired = AttrVal( $SELF, "actual_$attribute", AttrVal($SELF, $attribute, '')); + + my @filterattr = grep { $_ =~ m{\Aactual_${attribute}_}x } split m{\s+}x, getAllAttr($SELF); + return $desired if !@filterattr; + for my $tocheck (@filterattr) { + my ($filter, $desired2) = split m{\s+}, AttrVal($SELF,$tocheck,''); + #Debug("FILTER: $filter"); + next if !devspec2array("$devspec:FILTER=$filter"); + #Debug("FILTERed: $desired2"); + return $desired2; + } + return $desired; +} + +sub Attr { my ($cmd, $SELF, $attribute, $value) = @_; - my ($hash) = $defs{$SELF}; + + my $hash = $defs{$SELF}; my $TYPE = $hash->{TYPE}; Log3($SELF, 5, "$TYPE ($SELF) - call archetype_Attr"); - if($attribute eq "disable" && ($cmd eq "del" || $value eq "0")){ - if(AttrVal($SELF, "stateFormat", undef)){ - evalStateFormat($hash); + if( $attribute eq 'disable' ) { + if ($cmd eq 'del' || $value eq '0') { + readingsSingleUpdate($hash, 'state', 'active', 0); + evalStateFormat($hash); + Log3($SELF, 3, "$TYPE ($SELF) - starting inheritance inheritors"); + return _inheritance($SELF); } - else{ - $hash->{STATE} = "active"; - } - - Log3($SELF, 3, "$TYPE ($SELF) - starting inheritance inheritors"); - - archetype_inheritance($SELF); + readingsSingleUpdate($hash, 'state', 'disabled', 0); + evalStateFormat($hash); + return; } - elsif($attribute =~ /^actual_/){ - if($cmd eq "set"){ - addToDevAttrList($SELF, $attribute) + + return if !$init_done; + + if($attribute =~ /^actual_/) { + if ($cmd eq 'set') { + addToDevAttrList($SELF, $attribute, 'archetype'); + return ; } - else{ - my %values = + # delete case + my %values = map{$_, 0} split(" ", AttrVal($SELF, "userattr", "")); delete $values{$attribute}; - my $values = join(" ", sort(keys %values)); + my $values = join q{ }, sort keys %values; - if($values eq ""){ + if($values eq ''){ CommandDeleteAttr(undef, "$SELF userattr"); } else{ - $attr{$SELF}{userattr} = $values; + #$attr{$SELF}{userattr} = $values; + CommandAttr($hash, "$SELF -silent userattr $values"); } - } } - return if(IsDisabled($SELF)); + return if IsDisabled($SELF); my @attributes = AttrVal($SELF, "attributes", ""); if( - $cmd eq "del" - && $attribute ne "disable" - && AttrVal($SELF, "deleteAttributes", 0) eq "1" + $cmd eq 'del' + && $attribute ne 'disable' + && AttrVal($SELF, 'deleteAttributes', 0) == 1 ){ CommandDeleteAttr( undef - , join(",", archetype_devspec($SELF)) + , join q{,}, archetype_devspec($SELF) . ":FILTER=a:attributesExclude!=.*$attribute.* $attribute" ); } elsif($cmd eq "del" && $attribute ne "stateFormat"){ - $hash->{STATE} = "active"; + readingsSingleUpdate($hash, 'state', 'active', 0); + evalStateFormat($hash); } elsif( $cmd eq "set" && ( - grep(/\b$attribute\b/, @attributes) - || $attribute =~ /^actual_(.+)$/ && grep(/\b$1\b/, @attributes) + grep { m/\b$attribute\b/ } @attributes + || $attribute =~ /^actual_(.+)$/ && grep { m/\b$1\b/ } @attributes ) ){ $attribute = $1 if($1); + return if $hash->{'.importing'}; Log3( $SELF, 3 , "$TYPE ($SELF) - " . "starting inheritance attribute \"$attribute\" to inheritors" ); - archetype_inheritance($SELF, undef, $attribute); + return _inheritance($SELF, undef, $attribute); } - elsif($attribute eq "attributes" && $cmd eq "set"){ + + if($attribute eq 'attributes' && $cmd eq 'set'){ if($value =~ /actual_/ && $value !~ /userattr/){ $value = "userattr $value"; $_[3] = $value; $attr{$SELF}{$attribute} = $value; + #CommandAttr($hash, "$SELF -silent $attribute $value"); + } else { + my $posAttr = getAllAttr($SELF); + for my $elem ( split m{ }, $value ) { + addToDevAttrList($SELF, "actual_$elem") if $posAttr !~ m{\b$elem(?:[\b:\s]|\z)}xms; + } } + return if $hash->{'.importing'} && $cmd eq 'set'; + Log3($SELF, 3, "$TYPE ($SELF) - starting inheritance inheritors"); - - archetype_inheritance($SELF, undef, $value); + _inheritance($SELF, undef, $value); } - elsif($attribute eq "disable" && $cmd eq "set" && $value eq "1"){ - $hash->{STATE} = "disabled"; - } - return; } -sub archetype_Notify($$) { - my ($hash, $dev_hash) = @_; +sub Notify { + my $hash = shift // return; + my $dev_hash = shift // return; my $SELF = $hash->{NAME}; my $TYPE = $hash->{TYPE}; Log3($SELF, 5, "$TYPE ($SELF) - call archetype_Notify"); - return if(IsDisabled($SELF)); - return unless(AttrVal($SELF, "autocreate", 1)); + return if IsDisabled($SELF); + return if !AttrVal($SELF, 'autocreate', 1); my @events = @{deviceEvents($dev_hash, 1)}; - return unless(@events); + return if !@events; - foreach my $event (@events){ - next unless($event); + for my $event (@events){ + next if !$event; Log3($SELF, 4, "$TYPE ($SELF) - triggered by event: \"$event\""); - my ($argument, $name, $attr, $value) = split(/[\s]+/, $event, 4); + my ($argument, $name, $attr, $value) = split m{[\s]+}x, $event, 4; - return unless($name); + return if !$name; - if($argument eq "DEFINED" && grep(/\b$name\b/, archetype_devspec($SELF))){ + if( $argument eq 'DEFINED' && grep { m/\b$name\b/ } archetype_devspec($SELF)) { Log3($SELF, 3, "$TYPE ($SELF) - starting inheritance $name"); - archetype_inheritance($SELF, $name); + _inheritance($SELF, $name); } elsif( - $argument eq "DEFINED" - && grep(/\b$name\b/, archetype_devspec($SELF, "relations")) + $argument eq 'DEFINED' + && grep { m/\b$name\b/ } archetype_devspec($SELF, "relations") ){ Log3($SELF, 3, "$TYPE ($SELF) - starting define inheritors"); - archetype_define_inheritors($SELF, undef, undef, $name); + define_inheritors($SELF, undef, undef, $name); Log3($SELF, 3, "$TYPE ($SELF) - define inheritors done"); } elsif( $hash->{DEF} eq "derive attributes" && $argument eq "ATTR" - && grep(/\b$name\b/, archetype_devspec($SELF, "specials")) + && grep { m/\b$name\b/ } archetype_devspec($SELF, "specials") ){ - for my $attribute (split(" ", AttrVal($SELF, "attributes", ""))){ + for my $attribute ( split m{ }, AttrVal($SELF, 'attributes', '') ) { my @specials = archetype_evalSpecials( undef, AttrVal($SELF, "actual_$attribute", ""), "all" ); - if(grep(/\b$attr\b/, @specials)){ - archetype_derive_attributes($SELF, undef, $name, $attribute); + if ( grep { m/\b$attr\b/ } @specials ){ + derive_attributes($SELF, undef, $name, $attribute); last; } @@ -470,209 +582,312 @@ sub archetype_Notify($$) { } # module Fn ################################################################### -sub archetype_AnalyzeCommand($$$$$) { +sub archetype_AnalyzeCommand { # Wird ausgefuehrt um metaNAME und metaDEF auszuwerten. - my ($cmd, $name, $room, $relation, $SELF) = @_; - if($SELF){ - my ($hash) = $defs{$SELF}; - my $TYPE = $hash->{TYPE}; + #($$$$$) my ($cmd, $name, $room, $relation, $SELF) = @_; + my $cmd = shift // return; + my $name = shift; + my $room = shift; + my $relation = shift; + my $SELF = shift; + my $hash; my $TYPE; + if ( $SELF ) { + $hash = $defs{$SELF}; + $TYPE = $hash->{TYPE}; Log3($SELF, 5, "$TYPE ($SELF) - call archetype_AnalyzeCommand"); } - return unless($cmd); + my %specials = ( + '%name' => $name, + '%room' => $room, + '%relation' => $relation + ); + $specials{'%SELF'} = $SELF if $SELF; + $specials{'%TYPE'} = $TYPE if $TYPE; - # # Stellt Variablen fuer Zeit und Datum zur Verfuegung. - # my ($sec, $min, $hour, $mday, $month, $year, $wday, $yday, $hms, $we) = - # split(" ", - # AnalyzePerlCommand( - # undef, '"$sec $min $hour $mday $month $year $wday $yday $hms $we"' - # ) - # );; - - # Falls es sich nicht um einen durch {} gekennzeichneten Perl Befehlt + # Falls es sich nicht um einen durch {} gekennzeichneten Perl Befehl # handelt, werden alle Anfuehrungszeichen maskiert und der Befehl in # Anfuehrungszeichen gesetzt um eine korrekte Auswertung zu gewaehrleisten. - unless($cmd =~ m/^\{.*\}$/){ + if ($cmd !~ m/^\{.*\}$/){ $cmd =~ s/"/\\"/g; - $cmd = "\"$cmd\"" + $cmd = "\"$cmd\""; + #Debug("no Perl in aAC, starting with $cmd"); + #$cmd = EvalSpecials($cmd, %specials); + $cmd = eval($cmd);# if AttrVal($SELF,'useEval',0); #seems we don't have much other opportunities for simple text replacements...? + + #Debug("evaluated to $cmd"); +=pod + for my $special ( sort { length $b <=> length $a } keys %specials) { + last if AttrVal($SELF,'useEval',0); + my $short = substr $special, 1 - length $special; + Log3($SELF, 3, "short is $short, special was $special"); + $cmd =~ s/\$$short/$specials{$special}/g; + } +=cut + return $cmd; } - $cmd = eval($cmd); - return($cmd); + #Debug("cmd in aAC oiginally was $cmd"); + #$cmd = eval($cmd); + $cmd = "$cmd"; + #Debug("cmd in aAC was $cmd"); + $cmd = EvalSpecials($cmd, %specials); + #Debug("cmd now is $cmd"); + + $cmd = AnalyzeCommandChain( $hash, $cmd ); + #Debug("cmd via ACC now is $cmd"); + return $cmd; + # CMD ausführen + #$cmd = eval($cmd); + + #return $cmd; } -sub archetype_attrCheck($$$$;$) { +sub _attrCheck { # Wird fuer jedes vererbende Attribut und fuer jeden Erben ausgefuehrt um zu # pruefen ob das Attribut den vorgaben entspricht. - my ($SELF, $name, $attribute, $desired, $check) = @_; - my ($hash) = $defs{$SELF}; + #($$$$;$) my ($SELF, $name, $attribute, $desired, $check) = @_; + my $SELF = shift // return; + my $name = shift // return; + my $attribute = shift // return; + my $desired = shift // return; #Beta-User: all arguments seem to be mandatory + my $check = shift; + + my $hash = $defs{$SELF} // return; my $TYPE = $hash->{TYPE}; - my $actual = AttrVal($name, $attribute, ""); + my $actual = AttrVal($name, $attribute, ''); - Log3($SELF, 5, "$TYPE ($SELF) - call archetype_attrCheck"); + Log3($SELF, 5, "$TYPE ($SELF) - call _attrCheck"); - return if(AttrVal($name, "attributesExclude", "") =~ /$attribute/); + return if AttrVal($name, 'attributesExclude', '') =~ m{$attribute}; - if(AttrVal($SELF, "actual_$attribute", undef)){ - $desired = eval($desired) if($desired =~ m/^\{.*\}$/); - $desired = archetype_evalSpecials($name, $desired) if($desired =~ m/%/); + #if ( AttrVal($SELF, "actual_$attribute", undef ) ) { + if ( getAllAttr($SELF) =~ m{\bactual_$attribute(?:_.+|[\b:\s]|\z)}xms ) { + my %specials = ( + '%SELF' => $SELF, + '%name' => $name, + '%TYPE' => $TYPE, + '%attribute' => $attribute + ); + + #$desired = eval($desired) if $desired =~ m{\A\{.*\}\z}; + if ( $desired =~ m{\A\{.*\}\z} ) { + $desired = EvalSpecials($desired, %specials); + # CMD ausführen + $desired = AnalyzePerlCommand( $hash, $desired ); + } + + $desired = archetype_evalSpecials($name, $desired) if $desired =~ m/%/; } - if($desired =~ m/^least(\((.*)\))?:(.+)/){ + if ( $desired =~ m{\Aleast(\((.*)\))?:(.+)} ){ my $seperator = $2 ? $2 : " "; my %values = - map{$_, 0} (split(($seperator), $actual), split($seperator, $3)); - $desired = join($seperator, sort(keys %values)); + map{$_, 0} (split( $seperator, $actual), split $seperator, $3 ); + $desired = join $seperator, sort keys %values; } - elsif($desired =~ m/^undef/){ - return if(AttrVal($name, $attribute, undef)); - $desired = (split(":", $desired, 2))[1]; + elsif( $desired =~ m{\Aundef} ){ + return if AttrVal($name, $attribute, undef); + $desired = ( split m{:}x, $desired, 2)[1]; + } + elsif( $desired =~ m{\APerl:} ){ + $desired = ( split m{:}x, $desired, 2)[1]; } - return unless($desired); + return if !$desired; - if($actual ne $desired){ - if($check){ + return if $actual eq $desired; + + if ( $check ) { my $ret; - $ret .= "-attr $name $attribute $actual\n" if($actual ne ""); + $ret .= "-attr $name $attribute $actual\n" if $actual ne ''; $ret .= "+attr $name $attribute $desired"; return $ret; - } - - fhem("attr $name $attribute $desired"); - # CommandAttr(undef, "$name $attribute $desired"); } + #fhem("attr $name $attribute $desired"); + CommandAttr(undef, "$name $attribute $desired"); + return; } -sub archetype_DEFcheck($$;$) { - my ($name, $type, $expected) = @_; - my ($hash) = $defs{$name}; +sub _DEFcheck { + #($$;$) my ($name, $type, $expected) = @_; + my $name = shift // return; + my $type = shift // return; + my $expected = shift; if($expected && $expected ne InternalVal($name, "DEF", " ")){ CommandDefMod(undef, "$name $type $expected"); - }else{ - CommandDefMod(undef, "$name $type") unless(IsDevice($name, $type)); + } else { + CommandDefMod(undef, "$name $type") if !IsDevice($name, $type); + return 1; } + return; } -sub archetype_define_inheritors($;$$$) { - my ($SELF, $init, $check, $relation) = @_; - my ($hash) = $defs{$SELF}; +sub define_inheritors { + #($;$$$) my ($SELF, $init, $check, $relation) = @_; + my $SELF = shift // return; #Beta-User: only first argument seems to be mandatory + my $init = shift; + my $check = shift; + my $relation = shift; - return if(IsDisabled($SELF)); + my $hash = $defs{$SELF} // return; - my @relations = $relation ? $relation : archetype_devspec($SELF, "relations"); + return if IsDisabled($SELF); - return unless(@relations); + my @relations; + if ( $relation ) { + $relations[0] = $relation; + } else { + @relations = archetype_devspec($SELF, 'relations'); + return if !@relations; + } my @ret; - my $TYPE = AttrVal($SELF, "actualTYPE", "dummy"); - my $initialize = AttrVal($SELF, "initialize", undef); - if($initialize && $initialize !~ /^\{.*\}$/s){ - $initialize =~ s/\"/\\"/g; + my $TYPE = AttrVal($SELF, 'actualTYPE', 'dummy'); + my $initialize = AttrVal($SELF, 'initialize', undef); + #Log3($SELF, 3, "$TYPE ($SELF) - call archetype_devspec"); + + if ( $initialize && $initialize !~ /^\{.*\}$/s ) { + $initialize =~ s/\"/\\"/g; $initialize = "\"$initialize\""; } - foreach my $relation (@relations){ - my $room = AttrVal($relation, "room", "Unsorted"); - - foreach $room ( - AttrVal($SELF, "splitRooms", 0) eq "1" ? split(",", $room) : $room - ){ + for my $relative (@relations){ + my @rooms; + push @rooms, AttrVal($relative, 'room', 'Unsorted'); + @rooms = split q{,}, $rooms[0] if AttrVal($SELF, 'splitRooms', 0); + for my $room ( @rooms ) { my $name = archetype_AnalyzeCommand( - AttrVal($SELF, "metaNAME", ""), undef, $room, $relation, $SELF + AttrVal($SELF, 'metaNAME', ''), undef, $room, $relative, $SELF ); + next if !$name; my $DEF = archetype_AnalyzeCommand( - AttrVal($SELF, "metaDEF", " "), $name, $room, $relation, $SELF + AttrVal($SELF, 'metaDEF', ' '), $name, $room, $relative, $SELF ); my $defined = IsDevice($name, $TYPE) ? 1 : 0; - unless($defined && InternalVal($name, "DEF", " ") eq $DEF){ + if ( !$defined || InternalVal($name, 'DEF', '') ne $DEF) { + #unless($defined && InternalVal($name, "DEF", " ") eq $DEF){ if($check){ - push(@ret, $name); - + push @ret, $name; next; } - unless($init){ - archetype_DEFcheck($name, $TYPE, $DEF); - addToDevAttrList($name, "defined_by"); - $attr{$name}{defined_by} = $SELF; + if (!$init){ + _DEFcheck($name, $TYPE, $DEF); #my $new = + #_inheritance($SELF, $name) if $new; #new! + addToDevAttrList($name, 'defined_by', 'archetype'); + CommandAttr($hash, "$name defined_by $SELF"); } + } - next if($check); + next if $check; - fhem(eval($initialize)) if( - $initialize + #fhem(eval($initialize)) if( ##Beta-User: fhem/eval + if ( $initialize && IsDevice($name, $TYPE) && (!$defined || $init) - ); + ) { + $initialize = eval($initialize) if AttrVal($SELF,'useEval',0); #for simple text replacement.... + #Debug("init after eval replacement: $initialize"); + #fhem(eval($initialize)) + my %specials = ( + '%SELF' => $SELF, + '%name' => $name, + '%TYPE' => $TYPE, + '%room' => $room, + '%relation' => $relative + ); +=pod for my $special ( sort { length $b <=> length $a } keys %specials) { + last if AttrVal($SELF,'useEval',0); + my $short = substr $special, 1 - length $special; + $initialize =~ s/\$$short/$specials{$special}/g; + } +=cut - archetype_inheritance($SELF, $name) unless($init); + $initialize = EvalSpecials($initialize, %specials); + #Debug("init now is: $initialize"); + + # CMD ausführen + AnalyzeCommandChain( $hash, $initialize ); + } + + _inheritance($SELF, $name) if !$init; } } - if($check){ + if ($check) { my %ret = map{$_, 1} @ret; - return sort(keys %ret); + my @slist = sort keys %ret; + return @slist; #Beta-User: use uniq instead? } return; } -sub archetype_derive_attributes($;$$$) { - my ($SELF, $check, $name, $attribute) = @_; - my ($hash) = $defs{$SELF}; +sub derive_attributes { + #($;$$$) my ($SELF, $check, $name, $attribute) = @_; + my $SELF = shift // return; #Beta-User: only first argument seem to be mandatory + my $check = shift; + my $name = shift; + my $attribute = shift; + + my $hash = $defs{$SELF} // return; my @ret; - my @devspecs = $name ? $name : archetype_devspec($SELF, "specials"); + my @devspecs = $name ? $name : archetype_devspec($SELF, 'specials'); my @attributes = $attribute ? $attribute - : sort(split(/[\s]+/, AttrVal($SELF, "attributes", ""))) + : sort split m{[\s]+}xms, AttrVal($SELF, 'attributes', '') ; - foreach (@devspecs){ + for my $ds (@devspecs){ for my $attribute (@attributes){ - my $desired = AttrVal( - $_, "actual_$attribute", AttrVal($SELF, "actual_$attribute", "") - ); + my $desired = _get_desired($SELF, $attribute, $ds); + #AttrVal( + # $_, "actual_$attribute", AttrVal($SELF, "actual_$attribute", "") + #); - next if($desired eq ""); + next if $desired eq ''; if($check){ - push(@ret, archetype_attrCheck($SELF, $_, $attribute, $desired, 1)); + push(@ret, _attrCheck($SELF, $ds, $attribute, $desired, 1)); next; } - archetype_attrCheck($SELF, $_, $attribute, $desired); + _attrCheck($SELF, $ds, $attribute, $desired); } } return(@ret); } -sub archetype_devspec($;$) { - my ($SELF, $devspecs) = @_; - my ($hash) = $defs{$SELF}; +sub archetype_devspec { + #($;$) my ($SELF, $devspecs) = @_; + my $SELF = shift // return; + my $devspecs = shift; + + my $hash = $defs{$SELF} // return; my $TYPE = $hash->{TYPE}; Log3($SELF, 5, "$TYPE ($SELF) - call archetype_devspec"); - if(!$devspecs){ - $devspecs = InternalVal($SELF, "DEF", ""); + if ( !$devspecs ) { + $devspecs = InternalVal($SELF, 'DEF', ''); } - elsif($devspecs eq "relations"){ - $devspecs = AttrVal($SELF, "relations", ""); + elsif ( $devspecs eq 'relations' ) { + $devspecs = AttrVal($SELF, 'relations', ''); } - elsif($devspecs eq "specials"){ - $devspecs = ""; - for my $attribute (split(" ", AttrVal($SELF, "attributes", ""))){ + elsif ( $devspecs eq 'specials' ) { + $devspecs = ''; + for my $attribute (split m{ }, AttrVal($SELF, 'attributes', '')){ no warnings; $devspecs .= " a:actual_$attribute=.+"; @@ -682,9 +897,9 @@ sub archetype_devspec($;$) { $devspecs .= " .+"; } else{ - my $mandatory = join(" ", archetype_evalSpecials( - $SELF, $actual_attribute, "mandatory" - )); + my $mandatory = join q{ }, archetype_evalSpecials( + $SELF, $actual_attribute, 'mandatory' + ); while($mandatory =~ m/[^\|]\|[^\|]/){ my @parts = split("\\|\\|", $mandatory);; @@ -701,30 +916,35 @@ sub archetype_devspec($;$) { } my @devspec; - push(@devspec, devspec2array($_)) foreach (split(/[\s]+/, $devspecs)); + push @devspec, devspec2array($_) for (split m{[\s]+}x, $devspecs); + my %devspec = map{$_, 1}@devspec; delete $devspec{$SELF}; + @devspec = sort keys %devspec; - return sort(keys %devspec); + return @devspec; } -sub archetype_evalSpecials($$;$) { - my ($name, $pattern, $get) = @_; +sub archetype_evalSpecials { + #($$;$) my ($name, $pattern, $get) = @_; + my $name = shift // return; + my $pattern = shift // return; + my $get = shift; + my $value; - if($get){ - $pattern =~ s/\[[^]]*\]//g if($get eq "mandatory"); - + if ( $get ) { + $pattern =~ s/\[[^]]*\]//g if $get eq 'mandatory'; return(($pattern =~ m/%(\S+)%/g)); } for my $part (split(/\[/, $pattern)){ for my $special ($part =~ m/%(\S+)%/g){ - foreach (split("\\|", $special)){ + for (split("\\|", $special)){ my $AttrVal = AttrVal($name, $_, undef); $AttrVal = archetype_AnalyzeCommand( - $AttrVal, $name, AttrVal($name, "room", undef), undef, undef - ) if($AttrVal); + $AttrVal, $name, AttrVal($name, 'room', undef), undef, undef + ) if $AttrVal; if($AttrVal){ $part =~ s/\Q%$special%\E/$AttrVal/; @@ -736,36 +956,33 @@ sub archetype_evalSpecials($$;$) { ($part, my $optional) = ($part =~ m/([^\]]+)(\])?$/); - return unless($optional || $part !~ m/%\S+%/); + #return unless($optional || $part !~ m/%\S+%/); + return if !$optional && $part =~ m/%\S+%/; - $value .= $part unless($optional && $part =~ m/%\S+%/); + #$value .= $part unless($optional && $part =~ m/%\S+%/); + $value .= $part if !$optional || $part !~ m/%\S+%/; } return $value; } -sub archetype_inheritance($;$$) { - my $SELF = shift; - my ($hash) = $defs{$SELF}; +sub _inheritance { #($;$$) + my $SELF = shift // return; + my @devices = shift // archetype_devspec($SELF); + my $attrlist = shift // AttrVal($SELF, 'attributes', ''); + + my $hash = $defs{$SELF} // return; my $TYPE = $hash->{TYPE}; - my @devices = shift; - @devices = archetype_devspec($SELF) unless($devices[0]); - my @attributes = shift; - if($attributes[0]){ - @attributes = split(/[\s]+/, $attributes[0]); - } - else{ - @attributes = split(/[\s]+/, AttrVal($SELF, "attributes", "")); - } + for my $attribute ( split m{[\s]+}xms, $attrlist ){ + for my $ds (@devices) { + my $value = _get_desired($SELF, $attribute, $ds); + #AttrVal($SELF, "actual_$attribute", AttrVal($SELF, $attribute, "")); - foreach my $attribute (@attributes){ - my $value = - AttrVal($SELF, "actual_$attribute", AttrVal($SELF, $attribute, "")); + next if !$value || $value eq ''; - next if($value eq ""); - - archetype_attrCheck($SELF, $_, $attribute, $value) for (@devices); + _attrCheck($SELF, $ds, $attribute, $value); # for (@devices); + } } Log3($SELF, 3, "$TYPE ($SELF) - inheritance inheritors done") @@ -777,65 +994,65 @@ sub archetype_inheritance($;$$) { } # command Fn ################################################################## -sub CommandClean($$) { - my ($client_hash, $arguments) = @_; - my @archetypes = devspec2array("TYPE=archetype"); +sub CommandClean { + #($$) my ($client_hash, $arguments) = @_; + my $client_hash = shift // return; + my $arguments = shift // return; + + my @archetypes = devspec2array('TYPE=archetype'); my (@pendingAttributes, @pendingInheritors); my %pendingAttributes; - if($arguments && $arguments eq "check"){ - foreach my $SELF (@archetypes){ + return 'command archetype needs either or as arguments' if !$arguments || $arguments ne 'clean' && $arguments ne 'check'; + + if ( $arguments eq 'check' ){ + for my $SELF (@archetypes){ my $ret = archetype_Get($defs{$SELF}, $SELF, "pending", "attributes"); - next if( - $ret =~ /no attributes pending|Unknown argument pending|is disabled/ - ); + next if $ret =~ m{no attributes pending|Unknown argument pending|is disabled}; - foreach my $pending (split("\n", $ret)){ - my ($sign, $name, $attribute, $value) = split(" ", $pending, 4); + for my $pending ( split m{\n}x, $ret ){ + my ($sign, $name, $attribute, $value) = split q{ }, $pending, 4; $sign =~ s/^\+//; $pendingAttributes{$pending} = "$name $attribute $sign $value"; } } - foreach my $SELF (@archetypes){ + for my $SELF (@archetypes){ my $ret = archetype_Get($defs{$SELF}, $SELF, "pending", "inheritors"); - push(@pendingInheritors, $ret) if( - $ret !~ /no inheritors pending|Unknown argument pending|is disabled/ - ); + push @pendingInheritors, $ret if $ret !~ m{no inheritors pending|Unknown argument pending|is disabled}; } @pendingAttributes = - sort { lc($pendingAttributes{$a}) cmp lc($pendingAttributes{$b}) } + sort { lc $pendingAttributes{$a} cmp lc $pendingAttributes{$b} } keys %pendingAttributes ; - @pendingInheritors = sort(@pendingInheritors); + @pendingInheritors = sort @pendingInheritors; return( (@pendingAttributes ? - "pending attributes:\n" . join("\n", @pendingAttributes) - : "no attributes pending" + "pending attributes:\n" . join "\n", @pendingAttributes + : 'no attributes pending' ) . "\n\n" . (@pendingInheritors ? - "pending inheritors:\n" . join("\n", @pendingInheritors) - : "no inheritors pending" + 'pending inheritors:\n' . join "\n", @pendingInheritors + : 'no inheritors pending' ) ); } - fhem( - "set TYPE=archetype:FILTER=DEF!=derive.attributes define inheritors;" - . "set TYPE=archetype:FILTER=DEF!=derive.attributes inheritance;" - . "set TYPE=archetype:FILTER=DEF=derive.attributes derive attributes;" + #fhem( + AnalyzeCommandChain( undef, + 'set TYPE=archetype:FILTER=DEF!=derive.attributes define inheritors;' + . 'set TYPE=archetype:FILTER=DEF!=derive.attributes inheritance;' + . 'set TYPE=archetype:FILTER=DEF=derive.attributes derive attributes;' ); - return( - "clean done" - . "\n\n" - . CommandClean($client_hash, "check") - ); + return 'clean done' + . "\n\n" + . CommandClean($client_hash, 'check'); } 1; @@ -844,6 +1061,9 @@ __END__ # commandref ################################################################## =pod + +statistic: 04.2.2022: # installations: 13, # defines: 113 + =item helper =item summary inheritance attributes and defines devices =item summary_DE vererbt Attribute und definiert Geräte @@ -855,39 +1075,43 @@ __END__

archetype

    - With an archetype, attributes are transferred to inheritors, other devices. + With an archetype, attributes are transferred to other devices, so called inheritors. The inheritors can be defined according to a given pattern in the archetype and for relations, a certain group of devices.

    - Notes: + As this is rather an abstract description that only may be self-explaining for those + beeing familiar with concepts of inheritence in programming, + here's some examples how archetype can be used:
      -
    • - $name
      - name of the inheritor -

      • -
    • - $room
      - room of the inheritor -

      • -
    • - $relation
      - name of the relation -

      • -
    • - $SELF
      - name of the archetype -
      • +
    • transfer attributes (and their values) from an archetype to arbitrary other devices and/or
      • +
    • new devices (as well within the autocreate process) can be +
        +
      • supplied with define and attr commands derived according to patterns
        • +
      • supplied with default attribute values
        • +
      • initialized with default attribute values and/or Reading-values
        • +
      • +
    • indicate and/or correct differences between actual and desired attribute values
      • +

    + +
    + These variables may be used within inheritence instructions: +
      +
    • $name name of the inheritor
      • +
    • $room room of the inheritor
      • +
    • $relation name of the relation
      • +
    • $SELF name of the archetype

    + Note: FHEM commands setdefaultattr and template + provide partly similar functionality.

    Commands

      - - clean [check]
      - Defines all inheritors for all relations und inheritance all inheritors - with the attributes specified under the attribute attribute.
      - If the "check" parameter is specified, all outstanding attributes and - inheritors are displayed. + + archetype <clean or check>
      + "clean" will define all inheritors for all relations and process all inheritances to + all inheritors with the attributes specified under the attribute attribute.
      + If the "check" parameter is specified, all outstanding actions are displayed.

    @@ -896,13 +1120,13 @@ __END__ define <name> archetype [<devspec>] [<devspec>] [...]
    - In the <devspec> are described all the inheritors for this - archetype. Care should be taken to ensure that each inheritor is - associated with only one archetype.
    - If no <devspec> is specified, this is set with "defined_by=$SELF". - This devspec is also always checked, even if it is not specified.
    - See the section on - device specification + The <devspec> arguments point to all inheritors for this archetype. Make shure + there are no conflicting actions described when using more than one archetype pointing + to an inheritor. Basically it's recommended to associate each inheritor with just one + archetype.
    + If no <devspec> is specified, it is set to "defined_by=$SELF". + This devspec is also always checked, even if it is not specified explicitly.
    + See the section on device specification for details of the <devspec>.

    define <name> archetype derive attributes
    @@ -920,7 +1144,7 @@ __END__ addToAttrList <attribute>
    The command is only possible for an archetype with DEF "derive attributes".
    - Add an entry to the userattr of the global device so that it is + Add an entry to the userattr of the global device so that it is available to all of the devices.
    This can be useful to derive the alias according to a pattern. @@ -933,30 +1157,42 @@ __END__ define <metaNAME> <actualTYPE> [<metaDEF>]
- When an inheritor Is defined, it is initialized with the commands - specified under the initialize attribute, and the archetype assign the - defined_by attribute to the value $ SELF.
- The relations, metaNAME, actualTYPE, and metaDEF are described in - the attributes. + When an inheritor is defined, it is initialized with the commands + specified under the initialize attribute, + and the archetype assign thedefined_by attribute to the value $ SELF.
+ The relations (metaNAME, + metaTYPE and metaDEF) are described in + the respective attributes.
  • derive attributes
    - This command is only possible for an archetype with DEF + This command is only availabe for an archetype with DEF "derive attributes".
    - Derives all attributes specified under the attributes attribute for all - inheritors. + Derives all attributes specified under the + attributes attribute for all inheritors.

  • inheritance
    - Inheritance all attributes specified under the attributes attribute for - all inheritors. + Inheritance all attributes specified under the attributes attribute for + all inheritors. Attribute values will be taken - if available - from the respective actual_.+-attribute, otherwise the value will be taken from the archetype's attribute with the same name. +
    • +
    +
  • + import
    + Helper funktion to create an archetype. +
      +
    • Imports all attributes from the given device as listed in archetype's attributes list.
      • +
    • If attributes was not set before, all attributes from the given device will be imported (as actual_.+-attribute) to the archetype; attributes will be filled with a list of the importierted attributes.
      • +
    • The values form the attributs will also be imported for further usage in the archetype (marked as optional with the "undef"-prefix).
      • +
    + Note: While import is running, no values will be forwarded to the inheritors.

  • initialize inheritors
    - Executes all commands specified under the attributes initialize for all + Executes all commands specified under the attributes initialize for all inheritors.

    • @@ -983,15 +1219,15 @@ __END__
    • pending attributes
      - Displays all outstanding attributes specified under the attributes - attributes for all inheritors, which do not match the attributes of the - archetype. + Displays all outstanding attributes specified under the attributes + attribute for all inheritors, which do not match the (not optional) + attributes of the archetype.

    • pending inheritors
      - Displays all outstanding inheritors, which should be defined on the - basis of the relations + Displays all outstanding inheritors, which shall be defined + based on the described relations.
    @@ -1005,8 +1241,8 @@ __END__
    • attr archetype <attribute> undef:<...>
      - If undef: preceded, the attribute is inherited only if - the inheritors does not already have this attribute. + If undef: preceded, the attribute is not inherited + if the inheritors does not already have this attribute (no matter which value it is set to).

    • @@ -1018,6 +1254,14 @@ __END__ least[(<seperator>)]:.
      If no separator is specified, the space is used as separator.
      • +
    • + attr archetype <attribute> Perl:<...>
      + attr archetype <attribute> undef,Perl:<...>
      + Default behaviour for Perl code in any attribute is: Code will be evaluated and the result + will be the value to be set in the inheritor's attribute. + (Additional) modifier Perl: will change that so the (unevaluated) Perl code + will be used directly as attribute value (e.g. usefull for devStateIcon or stateFormat). +


  • @@ -1034,18 +1278,52 @@ __END__
    All terms enclosed in% are attributes. An order can be achieved by |. If an expression is included in [] it is optional.
    - The captionRoom, description, index, and suffix expressions are added - by addToAttrList.
    + The captionRoom, description, index, and suffix expressions are added (e.g.) + by addToAttrList.
    + Remarks and options: +
      +
    • no return value
      • + If an actual_<attribute> is set, it will be used instead of the + identically named <attribute>. If it contains Perl code to be evaluated + and evaluation returns no value, no changes will be derived. +
    • Filtering
      • + Extending the attribute names indicates filtering is desired. Syntax is: + actual_<attribute>_<index> <FILTER> <value>. + This may be helpful to configure devices with more than one channels or different models + by a common archetype. If the given filter matches, this will prevent useage of + content of actual_<attribute> (and <attribute> as well), + even if the evaluation of Perl code will return nothing.
      + Example:
      + define archHM_CC archetype TYPE=CUL_HM:FILTER=model=(HM-CC-RT-DN|HM-TC-IT-WM-W-EU)
      + attr archHM_CC attributes devStateIcon icon
      + attr archHM_CC actual_devStateIcon_RT model=HM-CC-RT-DN:FILTER=chanNo=04 Perl:{devStateIcon_Clima($name)}
      + attr archHM_CC actual_devStateIcon_WT model=HM-TC-IT-WM-W-EU:FILTER=chanNo=02 Perl:{devStateIcon_Clima($name)}
      + attr archHM_CC actual_icon hm-cc-rt-dn
      + attr archHM_CC actual_icon_2 model=HM-TC-IT-WM-W-EU hm-tc-it-wm-w-eu       +
    • Frontend availability
      • + actual_<attribute> is a "wildcard" attribute, intended to be set (initially) + using FHEM command field. Wrt. to useage of filtering, this is the only way to set + this type of attribute, all items from the attributes list + will added as actual_<attribute> as well and then can be accessed + directly by the regular drop-down menu in FHEMWEB. +

  • actualTYPE <TYPE>
    - Sets the TYPE of the inheritor. The default value is dummy. + Sets the TYPE of the inheritor. The default value is dummy.

  • attributes <attribute> [<attribute>] [...]
    - Space-separated list of attributes to be inherited. + Space-separated list of attributes to be inherited. Values of the attributes + in the inheritence process will be taken from the attributes with either (lower + to higher priority) from +

  • @@ -1058,20 +1336,20 @@ __END__
  • autocreate 0
    - The archetype does not automatically inherit attributes to new devices, + If set to 0, the archetype does not automatically inherit attributes to new devices, and inheritors are not created automatically for new relations.
    The default value is 1.

  • defined_by <...>
    - Auxiliary attribute to recognize by which archetype the inheritor was - defined. + Auxiliary attribute to recognize by which archetype + the device has been defined as inheritor.

  • deleteAttributes 1
    - If an attribute is deleted in the archetype, it is also deleted for all + If set to 1 and then an attribute is deleted in the archetype, it is also deleted for all inheritors.
    The default value is 0.
    • @@ -1086,7 +1364,8 @@ __END__ <initialize> can be specified as <text> or {perl code}.
    The <text> or the return of {perl code} must be a list of FHEM commands separated by a semicolon (;). These are used to initialize the - inheritors when they are defined. + inheritors when they are defined.
    + Note: This functionality is limited to "relations"!
  • @@ -1101,8 +1380,11 @@ __END__ describes the structure of the name for the inheritors.

    • -
  • - readingList +
  • + readingList <values>
    + setList <values>
    + Both work as same attributes in dummy. They are intented + to set initial values for "initialize"-actions that may he handed over to heirs.

  • @@ -1114,10 +1396,6 @@ __END__ for details of the <devspec>.

    • -
  • - setList -
    • -
  • splitRooms 1
    Returns every room seperatly for each relation in $room. @@ -1139,8 +1417,9 @@ __END__ 
      defmod SVG_archetype archetype TYPE=SVG
-attr SVG_archetype group verlaufsdiagramm
-attr SVG_archetype attributes group
      +attr SVG_archetype attributes group +attr SVG_archetype group history +
  • @@ -1154,7 +1433,7 @@ attr SVG_link_archetype actualTYPE weblink attr SVG_link_archetype metaNAME $relation\_link attr SVG_link_archetype metaDEF link ?detail=$relation attr SVG_link_archetype initialize attr $name room $room;; -attr SVG_link_archetype group verlaufsdiagramm +attr SVG_link_archetype group history attr SVG_link_archetype attributes group
    • @@ -1170,43 +1449,44 @@ attr SVG_link_archetype attributes group

    archetype

      - Mit einem archetype werden Attribute auf Erben (inheritors), andere - Geräte, übertragen. Die Erben können, nach einem vorgegeben - Muster im archetype und für Beziehungen (relations), eine bestimmte - Gruppe von Geräten, definiert werden.
      -
      - Hinweise: + archetype (lt. Duden Synonym u.a. für: Urbild, Urform, Urgestalt, Urtyp, Ideal, Inbegriff, Musterbild, Vorbild) kann:
        -
      • - $name
        - Name des Erben -

        • -
      • - $room
        - Raum der Beziehung -

        • -
      • - $relation
        - Name der Beziehung -

        • -
      • - $SELF
        - Name des archetype -
        • +
      • Attribute vom archetype auf andere Geräte übertragen und/oder
        • +
      • neue Geräte (auch z.B. solche, die von autocreate erzeugt werden) +
          +
        • nach einem bestimmten Muster anlegen
          • +
        • mit Standardattributen versorgen
          • +
        • mit Standardattributen und/oder Reading-Werte initialisieren
          • +
        • +
      • vorhandene Abweichungen zu gewünschten Standard-Attribut-Inhalten aufzeigen und beheben
        • +

      + Die verwendeten Begriffe sind angelehnt an Vererbung + in der Programmierung. + Mit einem archetype werden Attribute auf Erben (inheritors), andere + Geräte, übertragen. Die Erben können, nach einem vorgegeben + Muster im archetype und für Beziehungen (relations), eine bestimmte + Gruppe von Geräten, definiert werden.
      +
      + Folgende Variablen können für Übertragungsvorgänge genutzt werden: +
        +
      • $name Name des Erben
        • +
      • $room Raum der Beziehung
        • +
      • $relation Name der Beziehung
        • +
      • $SELF Name des archetype

      + Hinweis: Für in Teilen ähnliche Funktionalitäten siehe auch die Kommandos setdefaultattr sowie template.

      Befehle

        - - clean [check]
        + + archetype <clean or check>
        Definiert für alle Beziehungen aller archetype die Erben, vererbt für - alle archetype die unter dem Attribut attributes angegeben Attribute auf + alle archetype die unter dem Attribut attributes angegeben Attribute auf alle Erben.
        Wird optinal der Parameter "check" angegeben werden alle ausstehenden Attribute und Erben angezeigt.
      -

      Define

        @@ -1215,75 +1495,87 @@ attr SVG_link_archetype attributes group
        In den <devspec> werden alle Erben beschrieben die es für dieses archetype gibt. Es sollte darauf geachtet werden, dass jeder Erbe nur - einem archetype zugeordnet ist.
        + einem archetype zugeordnet ist und keine widerstreitenden Angaben für + diesselben Attribute aus unterschiedlichen archetype abgeleitet werden sollen. + .
        Wird keine <devspec> angegeben wird diese mit "defined_by=$SELF" - gesetzt. Diese devspec wird auch immer überprüft, selbst wenn + gesetzt. Diese devspec wird auch immer überprüft, selbst wenn sie nicht angegeben ist.
        - Siehe den Abschnitt über - Geräte-Spezifikation - für Details der <devspec>.
        + Siehe den Abschnitt über Geräte-Spezifikation + für Details zu <devspec>.

        define <name> archetype derive attributes
        - Wird in der DEF "derive attributes" angegeben handelt es sich um ein + Wird in der DEF "derive attributes" angegeben, handelt es sich um ein besonderes archetype. Es leitet Attribute anhand eines Musters ab.
        Das Muster wird mit den Attributen actual_.+ beschrieben.
        - Als Erben werden alle Geräte aufgelistet welche alle Pflicht- + Als Erben werden alle Geräte aufgelistet welche alle Pflicht- Attribute eines Musters besitzen.
      -

      Set

      • addToAttrList <attribute>
        Der Befehl ist nur bei einem archetype mit der DEF "derive attributes" - möglich.
        - Fügt global einen Eintrag unter userattr hizu, sodass er für - alle Geäräte zur Verfügung steht.
        - Dies kann sinnvoll sein um den alias nach einem Muster abzuleiten. + möglich.
        + Fügt global einen Eintrag unter userattr hinzu, sodass er für + alle Geräte zur Verfügung steht.
        + Dies kann sinnvoll sein, um (z.B.) den alias nach einem Muster abzuleiten.

      • define inheritors
        - Definiert für alle Beziehungen einen Erben nach dem Muster:
        + Definiert für alle Beziehungen einen Erben nach dem Muster:
          define <metaNAME> <actualTYPE> [<metaDEF>]
        - Wenn ein Erbe definiert wird, wird er, mit den unter dem Attribut - initialize angegebenen Befehlen, initialisiert und ihm wir das Attribut - defined_by mit dem Wert $SELF zugewiesen.
        - Die Beziehungen, metaNAME, actualTYPE und metaDEF werden in Attributen - beschrieben. + Wenn ein Erbe definiert wird, wird er mit den unter dem Attribut + initialize angegebenen Befehlen initialisiert und ihm wird das Attribut + defined_by mit dem Wert $SELF zugewiesen.
        + Die Beziehungen (metaNAME, + metaTYPE und metaDEF) werden + in den gleichnamigen Attributen beschrieben.

      • derive attributes
        Der Befehl ist nur bei einem archetype mit der DEF "derive attributes" - möglich.
        - Leitet für alle Erben die unter dem Attribut attributes angegeben - Attribute ab. + möglich.
        + Leitet für alle Erben die unter dem Attribut attributes + angegeben Attribute ab.

      • inheritance
        - Vererbt die eigenen unter dem Attribut attributes angegeben Attribute - auf alle Erben. + Vererbt die eigenen unter dem Attribut attributes + angegeben Attribute auf alle Erben. Dabei werden - wenn vorhanden - die Vorgaben aus dem + zugehörigen actual_.+-Attribut entnommen, + hilfsweise aus dem gleichnamigen Attribut des archetype. +
        • +
        +
      • + import
        + Hilfsfunktion zum Erstellen eines archetype. +
          +
        • Importiert alle Attribute vom ausgewählten Device, die im archetype unter attributes gelistet sind.
          • +
        • Ist attributes nicht gesetzt, werden alle im genannten Device gesetzten Attribute (als actual_.+-attribute) in das archetype importiert und attributes wird mit der Liste der importierten Attribute gefüllt
          • +
        • die Attribut-Werte werden ebenfalls importiert und können dann nachbearbeitet werden. Sie werden dabei als nicht zwingende Attributwerte (mit "undef"-Präfix) übernommen.
          • +
        + Hinweis: Beim Import werden die Attribute nicht direkt wieder weitervererbt.

      • initialize inheritors
        - Führt für alle Erben die unter dem Attribut initialize - angegebenen Befehle aus. + Führt für alle Erben die unter dem Attribut initialize angegebenen Befehle aus.

        • -
      • +
      • raw <Befehl>
        - Führt für alle Erben den Befehl aus. + Führt für alle Erben den Befehl aus.
      -

      Get

        @@ -1300,9 +1592,9 @@ attr SVG_link_archetype attributes group
        • pending attributes
          - Listet für jeden Erben die unter dem Attribut attributes angegeben - Attribute auf, die nicht mit den Attributen des archetype - übereinstimmen. + Listet für jeden Erben die unter dem Attribut attributes angegeben + Attribute auf, die nicht mit den (zwingenden) Attribut-Vorgaben des archetype + übereinstimmen.

        • @@ -1313,18 +1605,17 @@ attr SVG_link_archetype attributes group
      -

      Attribute

        Hinweise:
          - Alle Attribute, die vererbt werden können, können vorab mit + Alle Attribute, die vererbt werden können, können vorab mit einem Modifikator versehen werden.
        • attr archetype <attribute> undef:<...>
          Wird undef: vorangestellt wird das Attribut nur vererbt, - sofern der Erbe dieses Attribut noch nicht besitzt. + sofern dieses Attribut an dem Erbe noch gar nicht vorhanden ist.

        • @@ -1338,14 +1629,19 @@ attr SVG_link_archetype attributes group Wird kein Trennzeichen angegeben wird das Leerzeichen als Trennzeichen verwendet.
          • +
        • + attr archetype <attribute> Perl:<...>
          + attr archetype <attribute> undef,Perl:<...>
          + Wird Perl: (mit) vorangestellt wird der folgende Perl-Code nicht zur Ermittlung des Attributwerts vorab ausgeführt, sondern direkt als Attributwert übernommen (z.B. für devStateIcon oder stateFormat). +


      • actual_<attribute> <value>
        <value> kann als <Text> oder als {perl code} angegeben werden.
        - Wir das Attribut <attribute> vererbt, ersetz die Rückgabe - des actual_<attribute> Wert des Attributes.
        + Wird das Attribut <attribute> vererbt, ersetzt die Rückgabe + des actual_<attribute> den Wert des gleichnamigen Attributes.
        Bei dem archetype mit der DEF "derive attributes" können Muster definiert werden.
        Beispiel: @@ -1355,18 +1651,50 @@ attr SVG_link_archetype attributes group Alle in % eingeschlossenen Ausdrücke sind Attribute. Eine Reihenfolge lässt sich durch | erreichen. Ist ein Ausdruck in [] eingeschlossen ist er optional.
        - Die Ausdrücke captionRoom, description, index und suffix sind hierbei - durch addToAttrList hinzugefügte Attribute.
        + Die Ausdrücke captionRoom, description, index und suffix sind hierbei + z.B. durch addToAttrList hinzugefügte (globale) Attribute.

        + Weitere Hinweise und Optionen +
          +
        • keine Rückgabe
          • + Ist in einem Attribut (z.B. nach der Evaluierung einer Perl-Funktion) kein Inhalt definiert, + wird keine Änderung vorgenommen. +
        • Filterungen
          • + Duch weitere Zusätze zum Attributnamen können zusätzliche Filterungen realisiert werden. + Dies erfolgt in der Form actual_<attribute>_<index> <FILTER> + <value>. Dies kann genutzt werden, um z.B. Geräte mit mehreren Kanälen oder + ähnliche Modelle über ein gemeinsames archetype abzubilden. Falls der angegebene Filter paßt, wird ein eventuell vorhandenes gleichnamiges actual_<attribute> nicht ausgewertet, selbst, wenn ggf. die Evaluierung von Perl-Code keinen Rückgabewert ergibt.
          + Beispiel:
          + define archHM_CC archetype TYPE=CUL_HM:FILTER=model=(HM-CC-RT-DN|HM-TC-IT-WM-W-EU)
          + attr archHM_CC attributes devStateIcon icon
          + attr archHM_CC actual_devStateIcon_RT model=HM-CC-RT-DN:FILTER=chanNo=04 Perl:{devStateIcon_Clima($name)}
          + attr archHM_CC actual_devStateIcon_WT model=HM-TC-IT-WM-W-EU:FILTER=chanNo=02 Perl:{devStateIcon_Clima($name)}
          + attr archHM_CC actual_icon hm-cc-rt-dn
          + attr archHM_CC actual_icon_2 model=HM-TC-IT-WM-W-EU hm-tc-it-wm-w-eu           +
        • Verfügbarkeit im FHEMWEB-Frontend
          • + Es handelt sich um "wildcard"-Attribute, die (initial) über das FHEM-Kommandofeld gesetzt + werden können bzw. (im Fall der Filterung) müssen. Ein Attribut, das in + attributes gelistet ist, erhält automatisch + einen passenden actual_<attribute>-Eintrag und kann dann auch direkt das drop-down + Menü der Attribut-Liste in FHEMWEB gesetzt werden. +

      • actualTYPE <TYPE>
        - Legt den TYPE des Erben fest. Der Standardwert ist dummy. + Legt den TYPE des Erben fest. Der Standardwert ist dummy.

      • attributes <attribute> [<attribute>] [...]
        - Leerzeichen-getrennte Liste der zu vererbenden Attribute. + Leerzeichen-getrennte Liste der zu vererbenden Attribute. Die Werte der + Attribute werden (mit steigender Priorität) im Vererbungsprozess entnommen aus + dem Attribut mit: +

      • @@ -1378,24 +1706,23 @@ attr SVG_link_archetype attributes group

      • - autocreate 0
        - Durch das archetype werden Attribute auf neue devices nicht automatisch - vererbt und Erben werden nicht automatisch für neue Beziehungen - angelegt.
        + autocreate <0 oder 1>
        + Legt fest, ob durch das archetype automatisch Attribute auf neue Devices vererbt werden + sollen bzw. ob Erben automatisch für neue Beziehungen angelegt werden.
        Der Standardwert ist 1.

      • defined_by <...>
        - Hilfsattribut um zu erkennen, durch welchen archetype der Erbe - definiert wurde. + Hilfsattribut um zu erkennen, durch welchen archetype ein + Device als Erbe definiert wurde.

      • - delteAttributes 1
        - Wird ein Attribut im archetype gelöscht, wird es auch bei allen Erben + deleteAttributes 1
        + Wenn gesetzt, wird ein im archetype gelöschtes Attribut auch bei allen Erben gelöscht.
        - Der Standardwert ist 0. + Der Standardwert ist 0 (deaktiviert).

      • @@ -1407,49 +1734,50 @@ attr SVG_link_archetype attributes group initialize <initialize>
        <initialize> kann als <Text> oder als {perl code} angegeben werden.
        - Der <Text> oder die Rückgabe vom {perl code} muss eine + Der <Text> oder die Rückgabe vom {perl code} muss eine durch Semikolon (;) getrennte Liste von FHEM-Befehlen sein. Mit diesen - werden die Erben initialisiert, wenn sie definiert werden. + werden die Erben initialisiert, wenn sie definiert werden bzw. der + Befehl initialize angewandt wird.
        + Hinweis: Die Funktion ist beschränkt auf "relations"!

      • metaDEF <metaDEF>
        <metaDEF> kann als <Text> oder als {perl code} angegeben - werden und beschreibt den Aufbau der DEF für die Erben. + werden und beschreibt den Aufbau der DEF für die Erben.

      • metaNAME <metaNAME>
        <metaNAME> kann als <Text> oder als {perl code} angegeben - werden und beschreibt den Aufbau des Namen für die Erben. + werden und beschreibt den Aufbau des Namens für die Erben.

        • -
      • readingList
        • -
      • relations <devspec> [<devspec>] [...]
        - In den <relations> werden alle Beziehungen beschrieben die es für + In den <relations> werden alle Beziehungen beschrieben, die es für dieses archetype gibt.
        - Siehe den Abschnitt über - Geräte-Spezifikation - für Details der <devspec>. + Siehe den Abschnitt über Geräte-Spezifikation + für Details zu <devspec>.

        • -
      • setList
        • +
      • + readingList <values>
        + setList <values>
        + Ermöglichen zusammen das Vorbelegen von Reading-Werten, die z.B. bei einer "initialize"-Aktion ausgewertet und an die Erben weitergereicht werden können. Siehe auch die entsprechenden Attributbeschreibungen in dummy. +

      • splitRooms 1
        Gibt für jede Beziehung jeden Raum separat in $room zurück.
        • -
      -

      Beispiele