From f487b51b77764cef1adaad531c302776bcf70070 Mon Sep 17 00:00:00 2001 From: igami Date: Sun, 2 Jul 2017 08:36:39 +0000 Subject: [PATCH] 98_archetype: removed from contrib git-svn-id: https://svn.fhem.de/fhem/trunk/fhem@14622 2b470e98-0d58-463d-a4d8-8e2adae1ed80 --- FHEM/98_archetype.pm | 2 +- contrib/98_archetype.pm | 1475 --------------------------------------- 2 files changed, 1 insertion(+), 1476 deletions(-) delete mode 100755 contrib/98_archetype.pm diff --git a/FHEM/98_archetype.pm b/FHEM/98_archetype.pm index 6d272920d..e99cfd4e1 100755 --- a/FHEM/98_archetype.pm +++ b/FHEM/98_archetype.pm @@ -79,7 +79,7 @@ sub archetype_Initialize($) { . "disable:0,1 " . "initialize:textField-long " . "metaDEF:textField-long " - . "metaNAME " + . "metaNAME:textField-long " . "readingList " . "relations " . "setList:textField-long " diff --git a/contrib/98_archetype.pm b/contrib/98_archetype.pm deleted file mode 100755 index cd9dde31d..000000000 --- a/contrib/98_archetype.pm +++ /dev/null @@ -1,1475 +0,0 @@ -# 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) = @_; - 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