From 08661bec6fd648484a246951caff912bcded49a8 Mon Sep 17 00:00:00 2001 From: igami Date: Sun, 2 Jul 2017 05:52:55 +0000 Subject: [PATCH] 98_archetype: initial commit git-svn-id: https://svn.fhem.de/fhem/trunk@14620 2b470e98-0d58-463d-a4d8-8e2adae1ed80 --- fhem/FHEM/98_archetype.pm | 1476 +++++++++++++++++++++++++++++++++++++ 1 file changed, 1476 insertions(+) create mode 100755 fhem/FHEM/98_archetype.pm diff --git a/fhem/FHEM/98_archetype.pm b/fhem/FHEM/98_archetype.pm new file mode 100755 index 000000000..6d272920d --- /dev/null +++ b/fhem/FHEM/98_archetype.pm @@ -0,0 +1,1476 @@ +# Id ########################################################################## +# $Id$ + +# copyright ################################################################### +# +# 98_archetype.pm +# +# Copyright by igami +# +# This file is part of FHEM. +# +# FHEM is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 2 of the License, or +# (at your option) any later version. +# +# FHEM is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# 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. + +package main; + use strict; + use warnings; + +# forward declarations ######################################################## +sub archetype_Initialize($); + +sub archetype_Define($$); +sub archetype_Undef($$); +sub archetype_Set($@); +sub archetype_Get($@); +sub archetype_Attr(@); +sub archetype_Notify($$); + +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($;$$); + +sub CommandClean($$); + +# initialize ################################################################## +sub archetype_Initialize($) { + my ($hash) = @_; + my $TYPE = "archetype"; + + Log(5, "$TYPE - call archetype_Initialize"); + + $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_.+ " + . "actualTYPE " + . "attributes " + . "autocreate:1,0 " + . "deleteAttributes:0,1 " + . "disable:0,1 " + . "initialize:textField-long " + . "metaDEF:textField-long " + . "metaNAME " + . "readingList " + . "relations " + . "setList:textField-long " + . "splitRooms:0,1 " + . $readingFnAttributes + ; + + addToAttrList("attributesExclude"); + + my %hash = ( + Fn => "CommandClean", + Hlp => "[check]" + ); + $cmds{clean} = \%hash; +} + +# regular Fn ################################################################## +sub archetype_Define($$) { + my ($hash, $def) = @_; + my ($SELF, $TYPE, $DEF) = split(/[\s]+/, $def, 3); + + Log3($SELF, 5, "$TYPE ($SELF) - call archetype_Define"); + + if($hash->{DEF} eq "derive attributes"){ + my $derive_attributes = $modules{$TYPE}{derive_attributes}; + + return( + "$TYPE for deriving attributes already definded as " + . "$derive_attributes->{NAME}" + ) 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)); + + return; +} + +sub archetype_Undef($$) { + my ($hash, $SELF) = @_; + my $TYPE = $hash->{TYPE}; + + Log3($SELF, 5, "$TYPE ($SELF) - call archetype_Undef"); + + delete $modules{$TYPE}{derive_attributes} + if($hash->{DEF} eq "derive attributes"); + + return; +} + +sub archetype_Set($@) { + my ($hash, @arguments) = @_; + my $SELF = shift @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 %archetype_sets; + + if($hash->{DEF} eq "derive attributes"){ + %archetype_sets = ( + "addToAttrList" => "addToAttrList:textField" + , "derive" => "derive:attributes" + ); + } + else{ + %archetype_sets = ( + "define" => "define:inheritors" + , "inheritance" => "inheritance:noArg" + , "initialize" => "initialize:inheritors" + , "raw" => "raw:textField" + ); + $archetype_sets{(split(":", $_))[0]} = $_ + foreach (split(/[\s]+/, AttrVal($SELF, "setList", ""))); + } + + return( + "Unknown argument $argument, choose one of " + . join(" ", values %archetype_sets) + ) unless(exists($archetype_sets{$argument})); + + if($argument eq "addToAttrList"){ + addToAttrList($value); + } + elsif($argument eq "derive" && $value eq "attributes"){ + Log3($SELF, 3, "$TYPE ($SELF) - starting $argument $value"); + + archetype_derive_attributes($SELF); + + Log3($SELF, 3, "$TYPE ($SELF) - $argument $value done"); + } + elsif($argument eq "define" && $value eq "inheritors"){ + Log3($SELF, 3, "$TYPE ($SELF) - starting $argument $value"); + + archetype_define_inheritors($SELF); + + Log3($SELF, 3, "$TYPE ($SELF) - $argument $value done"); + } + elsif($argument eq "inheritance"){ + Log3($SELF, 3, "$TYPE ($SELF) - starting $argument inheritors"); + + archetype_inheritance($SELF); + } + elsif($argument eq "initialize" && $value eq "inheritors"){ + Log3($SELF, 3, "$TYPE ($SELF) - starting $argument $value"); + + archetype_define_inheritors($SELF, $argument); + + 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); + + Log3($SELF, 3, "$TYPE ($SELF) - $command $value"); + + fhem("$command " . join(",", archetype_devspec($SELF)) . " $value"); + } + else{ + my @readingList = split(/[\s]+/, AttrVal($SELF, "readingList", "")); + + if(@readingList && grep(/\b$argument\b/, @readingList)){ + Log3($SELF, 3, "$TYPE set $SELF $argument $value"); + + readingsSingleUpdate($hash, $argument, $value, 1); + } + else{ + Log3($SELF, 3, "$TYPE set $SELF $argument $value"); + + readingsSingleUpdate($hash, "state", "$argument $value", 1); + } + } + + return; +} + +sub archetype_Get($@) { + my ($hash, @arguments) = @_; + my $SELF = shift @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 %archetype_gets; + + if($derive_attributes){ + %archetype_gets = ( + "inheritors" => "inheritors:noArg", + "pending" => "pending:attributes" + ); + }else{ + %archetype_gets = ( + "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})); + + return "$SELF is disabled" if(IsDisabled($SELF)); + + if($argument =~ /^(inheritors|relations)$/){ + Log3($SELF, 3, "$TYPE ($SELF) - starting request $argument"); + + my @devspec; + + if($derive_attributes){ + @devspec = archetype_devspec($SELF, "specials"); + } + elsif($argument eq "relations"){ + @devspec = archetype_devspec($SELF, "relations"); + } + else{ + @devspec = archetype_devspec($SELF); + } + + Log3($SELF, 3, "$TYPE ($SELF) - request $argument done"); + + return @devspec ? join("\n", @devspec) : "no $argument defined"; + } + elsif($argument eq "pending"){ + Log3($SELF, 3, "$TYPE ($SELF) - starting request $argument $value"); + + my @ret; + + if($value eq "attributes"){ + my @attributes = sort(split(/[\s]+/, AttrVal($SELF, "attributes", ""))); + + if($derive_attributes){ + @ret = archetype_derive_attributes($SELF, 1); + } + else{ + foreach (archetype_devspec($SELF)){ + for my $attribute (@attributes){ + my $desired = + AttrVal( + $SELF, "actual_$attribute", AttrVal($SELF, $attribute, "") + ); + + next if($desired eq ""); + + push(@ret, archetype_attrCheck($SELF, $_, $attribute, $desired, 1)); + } + } + } + } + elsif($value eq "inheritors"){ + @ret = archetype_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])) + ); + } +} + +sub archetype_Attr(@) { + my ($cmd, $SELF, $attribute, $value) = @_; + 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); + } + else{ + $hash->{STATE} = "active"; + } + + Log3($SELF, 3, "$TYPE ($SELF) - starting inheritance inheritors"); + + archetype_inheritance($SELF); + } + elsif($attribute =~ /^actual_/){ + if($cmd eq "set"){ + addToDevAttrList($SELF, $attribute) + } + else{ + my %values = + map{$_, 0} split(" ", AttrVal($SELF, "userattr", "")); + delete $values{$attribute}; + my $values = join(" ", sort(keys %values)); + + if($values eq ""){ + CommandDeleteAttr(undef, "$SELF userattr"); + } + else{ + $attr{$SELF}{userattr} = $values; + } + } + } + + return if(IsDisabled($SELF)); + + my @attributes = AttrVal($SELF, "attributes", ""); + + if( + $cmd eq "del" + && $attribute ne "disable" + && AttrVal($SELF, "deleteAttributes", 0) eq "1" + ){ + CommandDeleteAttr( + undef + , join(",", archetype_devspec($SELF)) + . ":FILTER=a:attributesExclude!=.*$attribute.* $attribute" + ); + } + elsif($cmd eq "del" && $attribute ne "stateFormat"){ + $hash->{STATE} = "active"; + } + elsif( + $cmd eq "set" + && ( + grep(/\b$attribute\b/, @attributes) + || $attribute =~ /^actual_(.+)$/ && grep(/\b$1\b/, @attributes) + ) + ){ + $attribute = $1 if($1); + Log3( + $SELF, 3 + , "$TYPE ($SELF) - " + . "starting inheritance attribute \"$attribute\" to inheritors" + ); + + archetype_inheritance($SELF, undef, $attribute); + } + elsif($attribute eq "attributes" && $cmd eq "set"){ + if($value =~ /actual_/ && $value !~ /userattr/){ + $value = "userattr $value"; + $_[3] = $value; + $attr{$SELF}{$attribute} = $value; + } + + Log3($SELF, 3, "$TYPE ($SELF) - starting inheritance inheritors"); + + archetype_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) = @_; + 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)); + + my @events = @{deviceEvents($dev_hash, 1)}; + + return unless(@events); + + foreach my $event (@events){ + next unless($event); + + Log3($SELF, 4, "$TYPE ($SELF) - triggered by event: \"$event\""); + + my ($argument, $name, $attr, $value) = split(/[\s]+/, $event, 4); + + return unless($name); + + if($argument eq "DEFINED" && grep(/\b$name\b/, archetype_devspec($SELF))){ + Log3($SELF, 3, "$TYPE ($SELF) - starting inheritance $name"); + + archetype_inheritance($SELF, $name); + } + elsif( + $argument eq "DEFINED" + && grep(/\b$name\b/, archetype_devspec($SELF, "relations")) + ){ + Log3($SELF, 3, "$TYPE ($SELF) - starting define inheritors"); + + archetype_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")) + ){ + for my $attribute (split(" ", 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); + + last; + } + } + } + } + + return; +} + +# module Fn ################################################################### +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}; + + Log3($SELF, 5, "$TYPE ($SELF) - call archetype_AnalyzeCommand"); + } + + return unless($cmd); + + # # 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 + # handelt, werden alle Anfuehrungszeichen maskiert und der Befehl in + # Anfuehrungszeichen gesetzt um eine korrekte Auswertung zu gewaehrleisten. + unless($cmd =~ m/^\{.*\}$/){ + $cmd =~ s/"/\\"/g; + $cmd = "\"$cmd\"" + } + + $cmd = eval($cmd); + + return($cmd); +} + +sub archetype_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 $TYPE = $hash->{TYPE}; + my $actual = AttrVal($name, $attribute, ""); + + Log3($SELF, 5, "$TYPE ($SELF) - call archetype_attrCheck"); + + return if(AttrVal($name, "attributesExclude", "") =~ /$attribute/); + + + if($desired =~ m/^least(\((.*)\))?:(.+)/){ + my $seperator = $2 ? $2 : " "; + my %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]; + } + + if($hash->{DEF} eq "derive attributes"){ + $desired = eval($desired) if($desired =~ m/^\{.*\}$/); + $desired = archetype_evalSpecials($name, $desired) if($desired =~ m/%/); + } + + return unless($desired); + + if($actual ne $desired){ + if($check){ + my $ret; + $ret .= "-attr $name $attribute $actual\n" if($actual ne ""); + $ret .= "+attr $name $attribute $desired"; + + return $ret; + } + + CommandAttr(undef, "$name $attribute $desired"); + } + + return; +} + +sub archetype_DEFcheck($$;$) { + my ($name, $type, $expected) = @_; + my ($hash) = $defs{$name}; + + if($expected && $expected ne InternalVal($name, "DEF", " ")){ + CommandDefMod(undef, "$name $type $expected"); + }else{ + CommandDefMod(undef, "$name $type") unless(IsDevice($name, $type)); + } +} + +sub archetype_define_inheritors($;$$$) { + my ($SELF, $init, $check, $relation) = @_; + my ($hash) = $defs{$SELF}; + + return if(IsDisabled($SELF)); + + my @relations = $relation ? $relation : archetype_devspec($SELF, "relations"); + + return unless(@relations); + + my @ret; + my $TYPE = AttrVal($SELF, "actualTYPE", "dummy"); + my $initialize = AttrVal($SELF, "initialize", undef); + 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 + ){ + my $name = archetype_AnalyzeCommand( + AttrVal($SELF, "metaNAME", ""), undef, $room, $relation, $SELF + ); + my $DEF = archetype_AnalyzeCommand( + AttrVal($SELF, "metaDEF", " "), $name, $room, $relation, $SELF + ); + my $defined = IsDevice($name, $TYPE) ? 1 : 0; + + unless($defined && InternalVal($name, "DEF", " ") eq $DEF){ + if($check){ + push(@ret, $name); + + next; + } + unless($init){ + archetype_DEFcheck($name, $TYPE, $DEF); + addToDevAttrList($name, "defined_by"); + $attr{$name}{defined_by} = $SELF; + } + } + + next if($check); + + fhem(eval($initialize)) if( + $initialize + && IsDevice($name, $TYPE) + && (!$defined || $init) + ); + + archetype_inheritance($SELF, $name) unless($init); + } + } + + if($check){ + my %ret = map{$_, 1} @ret; + return sort(keys %ret); + } + + return; +} + +sub archetype_derive_attributes($;$$$) { + my ($SELF, $check, $name, $attribute) = @_; + my ($hash) = $defs{$SELF}; + my @ret; + my @devspecs = $name ? $name : archetype_devspec($SELF, "specials"); + my @attributes = + $attribute ? + $attribute + : sort(split(/[\s]+/, AttrVal($SELF, "attributes", ""))) + ; + + foreach (@devspecs){ + for my $attribute (@attributes){ + my $desired = AttrVal( + $_, "actual_$attribute", AttrVal($SELF, "actual_$attribute", "") + ); + + next if($desired eq ""); + + if($check){ + push(@ret, archetype_attrCheck($SELF, $_, $attribute, $desired, 1)); + + next; + } + + archetype_attrCheck($SELF, $_, $attribute, $desired); + } + } + + return(@ret); +} + +sub archetype_devspec($;$) { + my ($SELF, $devspecs) = @_; + my ($hash) = $defs{$SELF}; + my $TYPE = $hash->{TYPE}; + + Log3($SELF, 5, "$TYPE ($SELF) - call archetype_devspec"); + + if(!$devspecs){ + $devspecs = InternalVal($SELF, "DEF", ""); + } + elsif($devspecs eq "relations"){ + $devspecs = AttrVal($SELF, "relations", ""); + } + elsif($devspecs eq "specials"){ + $devspecs = ""; + for my $attribute (split(" ", AttrVal($SELF, "attributes", ""))){ + no warnings; + + $devspecs .= " a:actual_$attribute=.+"; + + my $mandatory = join(" ", archetype_evalSpecials( + $SELF, AttrVal($SELF, "actual_$attribute", ""), "mandatory" + )); + + while($mandatory =~ m/[^\|]\|[^\|]/){ + my @parts = split("\\|\\|", $mandatory);; + $_ =~ s/(.* )?(\S+)\|(\S+)( .*)?/$1$2$4\|\|$1$3$4/ for(@parts);; + $mandatory = join("\|\|", @parts);; + } + + for my $mandatory (split("\\|\\|", $mandatory)){ + $devspecs .= " .+"; + $devspecs .= ":FILTER=a:$_=.+" for(split(" ", $mandatory)); + } + } + } + + my @devspec; + push(@devspec, devspec2array($_)) foreach (split(/[\s]+/, $devspecs)); + my %devspec = map{$_, 1}@devspec; + delete $devspec{$SELF}; + + return sort(keys %devspec); +} + +sub archetype_evalSpecials($$;$) { + my ($name, $pattern, $get) = @_; + my $value; + + 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)){ + my $AttrVal = AttrVal($name, $_, undef); + $AttrVal = archetype_AnalyzeCommand( + $AttrVal, $name, AttrVal($name, "room", undef), undef, undef + ) if($AttrVal); + + if($AttrVal){ + $part =~ s/\Q%$special%\E/$AttrVal/; + + last; + } + } + } + + ($part, my $optional) = ($part =~ m/([^\]]+)(\])?$/); + + return unless($optional || $part !~ m/%\S+%/); + + $value .= $part unless($optional && $part =~ m/%\S+%/); + } + + return $value; +} + +sub archetype_inheritance($;$$) { + my $SELF = shift; + my ($hash) = $defs{$SELF}; + 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", "")); + } + + foreach my $attribute (@attributes){ + my $value = + AttrVal($SELF, "actual_$attribute", AttrVal($SELF, $attribute, "")); + + next if($value eq ""); + + archetype_attrCheck($SELF, $_, $attribute, $value) for (@devices); + } + + Log3($SELF, 3, "$TYPE ($SELF) - inheritance inheritors done") + if(@devices > 1); + Log3($SELF, 3, "$TYPE ($SELF) - inheritance @devices done") + if(@devices == 1); + + return; +} + +# command Fn ################################################################## +sub CommandClean($$) { + my ($client_hash, $arguments) = @_; + my @archetypes = devspec2array("TYPE=archetype"); + my (@pendingAttributes, @pendingInheritors); + my %pendingAttributes; + + if($arguments && $arguments eq "check"){ + foreach my $SELF (@archetypes){ + my $ret = archetype_Get($defs{$SELF}, $SELF, "pending", "attributes"); + + next if( + $ret =~ /no attributes pending|Unknown argument pending|is disabled/ + ); + + foreach my $pending (split("\n", $ret)){ + my ($sign, $name, $attribute, $value) = split(" ", $pending, 4); + $sign =~ s/^\+//; + $pendingAttributes{$pending} = "$name $attribute $sign $value"; + } + } + + foreach 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/ + ); + } + + @pendingAttributes = + sort { lc($pendingAttributes{$a}) cmp lc($pendingAttributes{$b}) } + keys %pendingAttributes + ; + @pendingInheritors = sort(@pendingInheritors); + + return( + (@pendingAttributes ? + "pending attributes:\n" . join("\n", @pendingAttributes) + : "no attributes pending" + ) + . "\n\n" + . (@pendingInheritors ? + "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;" + ); + + return( + "clean done" + . "\n\n" + . CommandClean($client_hash, "check") + ); +} + +1; + +# commandref ################################################################## +=pod +=item helper +=item summary inheritance attributes and defines devices +=item summary_DE vererbt Attribute und definiert Geräte + +=begin html + + +

archetype

+( en | de ) +
+
    + With an archetype, attributes are transferred to inheritors, other devices. + The inheritors can be defined according to a given pattern in the archetype + and for relations, a certain group of devices.
    +
    + Notes: +
      +
    • + $name
      + name of the inheritor +

      • +
    • + $room
      + room of the inheritor +

      • +
    • + $relation
      + name of the relation +

      • +
    • + $SELF
      + name of the archetype +
      • +
    +
    + + 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. +
    +
    + + Define +
      + + 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 + for details of the <devspec>.
      +
      + define <name> archetype derive attributes
      + If the DEF specifies "derive attributes" it is a special archetype. It + derives attributes based on a pattern.
      + The pattern is described with the actual_. + Attributes.
      + All devices with all the mandatory attributes of a pattern are listed as + inheritors. +
    +
    + + Set +
      +
    • + 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 + available to all of the devices.
      + This can be useful to derive the alias according to a pattern. +
      • +
      +
    • + define inheritors
      + Defines an inheritor for all relations according to the pattern:
      +
        + + 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. +
      • +
      +
    • + derive attributes
      + This command is only possible for an archetype with DEF + "derive attributes".
      + Derives all attributes specified under the attributes attribute for all + inheritors. +
      • +
      +
    • + inheritance
      + Inheritance all attributes specified under the attributes attribute for + all inheritors. +
      • +
      +
    • + initialize inheritors
      + Executes all commands specified under the attributes initialize for all + inheritors. +
      • +
      +
    • + raw <command>
      + Executes the command for all inheritors. +
      • +
    +
    + + Get +
      +
    • + inheritors
      + Displays all inheritors. +
      • +
      +
    • + relations
      + Displays all relations. +
      • +
      +
    • + pending attributes
      + Displays all outstanding attributes specified under the attributes + attributes for all inheritors, which do not match the attributes of the + archetype. +
      • +
      +
    • + pending inheritors
      + Displays all outstanding inheritors, which should be defined on the + basis of the relations +
      • +
    +
    + + Attribute +
      + Notes:
      + All attributes that can be inherited can be pre-modified with a modifier. +
        +
      • + attr archetype <attribute> undef:<...>
        + If undef: preceded, the attribute is inherited only if + the inheritors does not already have this attribute. +

        • +
      • + + attr archetype <attribute> + least[(<seperator>)]:<...> +
        + If a list is inherited, it can be specified that these elements + should be at least present, by prepending the + least[(<seperator>)]:.
        + If no separator is specified, the space is used as separator. +
        • +
      +
      +
    • + actual_<attribute> <value>
      + <value> can be specified as <text> or {perl code}.
      + If the attribute <attribute> becomes inheritance the return + value of the attribute actual_<attribute> is replacing the value + of the attribute.
      + The archetype with DEF "derive attributes" can be used to define + patterns.
      + Example: + + actual_alias %captionRoom|room%: %description%[ %index%][%suffix%] +
      + 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.
      +
      • +
      +
    • + actualTYPE <TYPE>
      + Sets the TYPE of the inheritor. The default value is dummy. +
      • +
      +
    • + attributes <attribute> [<attribute>] [...]
      + Space-separated list of attributes to be inherited. +
      • +
      +
    • + + attributesExclude <attribute> [<attribute>] [...] +
      + A space-separated list of attributes that are not inherited to these + inheritors. +
      • +
      +
    • + autocreate 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. +
      • +
      +
    • + delteAttributes 1
      + If an attribute is deleted in the archetype, it is also deleted for all + inheritors.
      + The default value is 0. +
      • +
      +
    • + disable 1
      + No attributes are inherited and no inheritors are defined. +
      • +
      +
    • + initialize <initialize>
      + <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. +
      • +
      +
    • + metaDEF <metaDEF>
      + <metaDEF> can be specified as <text> or {perl code} and + describes the structure of the DEF for the inheritors. +
      • +
      +
    • + metaNAME <metaNAME>
      + <metaNAME> can be specified as <text> or {perl code} and + describes the structure of the name for the inheritors. +
      • +
      +
    • + readingList +
      • +
      +
    • + relations <devspec> [<devspec>] [...]
      + The relations describes all the relations that exist for this + archetype.
      + See the section on + device specification + for details of the <devspec>. +
      • +
      +
    • + setList +
      • +
      +
    • + splitRooms 1
      + Returns every room seperatly for each relation in $room. +
      • +
      +
    +
    + + Examples +
      + + The following sample codes can be imported via "Raw definition". + +
      +
      +
    • + + All plots should be moved to the group "history": + +
        +
        defmod SVG_archetype archetype TYPE=SVG
+attr SVG_archetype group verlaufsdiagramm
+attr SVG_archetype attributes group
        +
      +
      • +
    • + + In addition, a weblink should be created for all plots: + +
        +
        defmod SVG_link_archetype archetype
+attr SVG_link_archetype relations TYPE=SVG
+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 attributes group
        +
      +
      • +
    +
+
+ +=end html + +=begin html_DE + + +

archetype

+( en | de ) +
+
    + 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: +
      +
    • + $name
      + Name des Erben +

      • +
    • + $room
      + Raum der Beziehung +

      • +
    • + $relation
      + Name der Beziehung +

      • +
    • + $SELF
      + Name des archetype +
      • +
    +
    + + Befehle +
      + clean [check]
      + Definiert für alle Beziehungen aller archetype die Erben, vererbt für + 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 +
      + + define <name> archetype [<devspec>] [<devspec>] [...] +
      + 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.
      + Wird keine <devspec> angegeben wird diese mit "defined_by=$SELF" + 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>.
      +
      + define <name> archetype derive attributes
      + 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- + 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. +
      • +
      +
    • + define inheritors
      + 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. +
      • +
      +
    • + 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. +
      • +
      +
    • + inheritance
      + Vererbt die eigenen unter dem Attribut attributes angegeben Attribute + auf alle Erben. +
      • +
      +
    • + initialize inheritors
      + 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. +
      • +
    +
    + + Get +
      +
    • + inheritors
      + Listet alle Erben auf. +
      • +
      +
    • + relations
      + Listet alle Beziehungen auf. +
      • +
      +
    • + pending attributes
      + Listet für jeden Erben die unter dem Attribut attributes angegeben + Attribute auf, die nicht mit den Attributen des archetype + übereinstimmen. +
      • +
      +
    • + pending inheritors
      + Listet alle Erben auf die aufgrund der Beziehungen noch definiert + werden sollen. +
      • +
    +
    + + Attribute +
      + Hinweise: +
        + 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. +

        • +
      • + + attr archetype <attribute> + least[(<Trennzeichen>)]:<...> +
        + Wird eine Liste vererbt kann mit dem voranstellen von + least[(<Trennzeichen>)]: + angegeben werden, dass diese Elemente mindestens vorhanden sein + sollen.
        + Wird kein Trennzeichen angegeben wird das Leerzeichen als + Trennzeichen verwendet. +
        • +
      +
      +
    • + 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.
      + Bei dem archetype mit der DEF "derive attributes" können Muster + definiert werden.
      + Beispiel: + + actual_alias %captionRoom|room%: %description%[ %index%][%suffix%] +
      + 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.
      +
      • +
      +
    • + actualTYPE <TYPE>
      + Legt den TYPE des Erben fest. Der Standardwert ist dummy. +
      • +
      +
    • + attributes <attribute> [<attribute>] [...]
      + Leerzeichen-getrennte Liste der zu vererbenden Attribute. +
      • +
      +
    • + + attributesExclude <attribute> [<attribute>] [...] +
      + Leerzeichen-getrennte Liste von Attributen die nicht auf diesen Erben + vererbt werden. +
      • +
      +
    • + autocreate 0
      + Durch das archetype werden Attribute auf neue devices nicht automatisch + vererbt und Erben werden nicht automatisch für neue Beziehungen + angelegt.
      + Der Standardwert ist 1. +
      • +
      +
    • + defined_by <...>
      + Hilfsattribut um zu erkennen, durch welchen archetype der Erbe + definiert wurde. +
      • +
      +
    • + delteAttributes 1
      + Wird ein Attribut im archetype gelöscht, wird es auch bei allen Erben + gelöscht.
      + Der Standardwert ist 0. +
      • +
      +
    • + disable 1
      + Es werden keine Attribute mehr vererbt und keine Erben definiert. +
      • +
      +
    • + initialize <initialize>
      + <initialize> kann als <Text> oder als {perl code} angegeben + werden.
      + 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. +
      • +
      +
    • + metaDEF <metaDEF>
      + <metaDEF> kann als <Text> oder als {perl code} angegeben + 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. +
      • +
      +
    • + readingList +
      • +
      +
    • + relations <devspec> [<devspec>] [...]
      + 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>. +
      • +
      +
    • + setList +
      • +
      +
    • + splitRooms 1
      + Gibt für jede Beziehung jeden Raum separat in $room zurück. +
      • +
      +
    +
    + + Beispiele +
      + + + Die folgenden beispiel Codes können per "Raw defnition" + importiert werden. + + +
      +
      +
    • + + Es sollen alle Plots in die Gruppe "verlaufsdiagramm" verschoben + werden: + +
      +
      defmod SVG_archetype archetype TYPE=SVG
+attr SVG_archetype group verlaufsdiagramm
+attr SVG_archetype attributes group
      +
      • +
      +
    • + + Zusätzlich soll für alle Plots ein weblink angelegt werden: + +
      +
      defmod SVG_link_archetype archetype
+attr SVG_link_archetype relations TYPE=SVG
+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 attributes group
      +
      • +
    +
+
+ +=end html_DE +=cut