diff --git a/fhem/FHEM/20_X10.pm b/fhem/FHEM/20_X10.pm index 021653777..c19ecf458 100755 --- a/fhem/FHEM/20_X10.pm +++ b/fhem/FHEM/20_X10.pm @@ -106,6 +106,13 @@ my %models = ( tm13 => 'switch', ); +my %interfaces = ( + lm12 => 'dimmer', + lm15 => 'switch_passive', + am12 => 'switch_passive', + tm13 => 'switch_passive', +); + my @lampmodules = ('lm12','lm15'); # lamp modules @@ -408,12 +415,7 @@ X10_Define($$) $hash->{HOUSE} = $housecode; $hash->{UNIT} = $unitcode; - if($models{$model} eq "switch") { - $hash->{INTERFACES}= "switch" - } - elsif($models{$model} eq "dimmer") { - $hash->{INTERFACES}= "dimmer" - }; + $hash->{internals}{interfaces}= $interfaces{$model}; if(defined($modules{X10}{defptr}{$housecode}{$unitcode})) { return "Error: duplicate X10 device $housecode $unitcode definition " . diff --git a/fhem/FHEM/59_Weather.pm b/fhem/FHEM/59_Weather.pm index 1c992b545..ad36b087c 100755 --- a/fhem/FHEM/59_Weather.pm +++ b/fhem/FHEM/59_Weather.pm @@ -171,6 +171,7 @@ sub Weather_Define($$) { if(int(@a) < 3 && int(@a) > 5); $hash->{STATE} = "Initialized"; + $hash->{internals}{interfaces}= "temperature:humidity:wind"; my $name = $a[0]; my $location = $a[2]; diff --git a/fhem/fhem.pl b/fhem/fhem.pl index 9860873ab..a66f62a4a 100755 --- a/fhem/fhem.pl +++ b/fhem/fhem.pl @@ -85,6 +85,7 @@ sub setGlobalAttrBeforeFork(); sub redirectStdinStdErr(); sub setReadingsVal($$$$); sub addEvent($$); +sub createInterfaceDefinitions(); sub CommandAttr($$); sub CommandDefaultAttr($$); @@ -139,6 +140,7 @@ sub CommandTrigger($$); use vars qw(%modules); # List of loaded modules (device/log/etc) use vars qw(%defs); # FHEM device/button definitions use vars qw(%attr); # Attributes +use vars qw(%interfaces); # Global interface definitions, see createInterfaceDefinitions below use vars qw(%selectlist); # devices which want a "select" use vars qw(%readyfnlist); # devices which want a "readyfn" use vars qw($readytimeout); # Polling interval. UNIX: device search only @@ -187,7 +189,7 @@ $init_done = 0; $modules{Global}{ORDER} = -1; $modules{Global}{LOADED} = 1; $modules{Global}{AttrList} = - "archivecmd allowfrom archivedir configfile lastinclude logfile " . + "archivecmd allowfrom apiversion archivedir configfile lastinclude logfile " . "modpath nrarchive pidfilename port statefile title userattr " . "verbose:1,2,3,4,5 mseclog version nofork logdir holiday2we " . "autoload_undefined_devices dupTimeout latitude longitude backupdir"; @@ -195,6 +197,7 @@ $modules{Global}{AttrFn} = "GlobalAttr"; my $commonAttr = "eventMap"; + %cmds = ( "?" => { Fn=>"CommandHelp", Hlp=>",get this help" }, @@ -345,6 +348,9 @@ if($pfn) { close(PID); } +# create the global interface definitions +createInterfaceDefinitions(); + $init_done = 1; DoTrigger("global", "INITIALIZED"); @@ -1604,6 +1610,12 @@ sub getAllSets($) { my $d = shift; + + if(AttrVal("global", "apiversion", 1)> 1) { + my @setters= getSetters($defs{$d}); + return join(" ", @setters); + } + my $a2 = CommandSet(undef, "$d ?"); $a2 =~ s/.*choose one of //; $a2 = "" if($a2 =~ /^No set implemented for/); @@ -2688,12 +2700,156 @@ addEvent($$) push(@{$hash->{CHANGED}}, $event); } +################################################################ +# +# Meta-information for devices +# This part maintained by Boris Neubert omega at online dot de +# +################################################################ + +sub +Debug($) { + my $msg= shift; + Log 1, "DEBUG>" . $msg; +} + +# get the names of interfaces for the device represented by the $hash +# empty list is returned if interfaces are not defined +sub +getInterfaces($) { + my ($hash)= @_; + #Debug "getInterfaces(" . $hash->{NAME} .")= " . $hash->{internals}{interfaces}; + if(defined($hash->{internals}{interfaces})) { + return split(/:/, $hash->{internals}{interfaces}); + } else { + return (); + } +} + +# get the names of the setters for a named interface +# empty list is returned if interface is not defined +sub +getSettersForInterface($) { + my $interface= shift; + if(defined($interface)) { + return split /:/, $interfaces{$interface}{setters}; + } else { + return (); + } +} + +# get the names of the getters for a named interface +# empty list is returned if interface is not defined +sub +getGettersForInterface($) { + my $interface= shift; + if(defined($interface)) { + return split /:/, $interfaces{$interface}{getters}; + } else { + return (); + } +} + +# get the names of the readings for a named interface +# empty list is returned if interface is not defined +sub +getReadingsForInterface($) { + my $interface= shift; + if(defined($interface)) { + return split /:/, $interfaces{$interface}{readings}; + } else { + return (); + } +} + +# get the names of the setters for the device represented by the $hash +# empty list is returned if interfaces are not defined +sub +getSetters($) { + my ($hash)= @_; + my ($interface, @setters); + #Debug "getSetters..."; + foreach $interface (getInterfaces($hash)) { + #Debug "Interface $interface"; + push @setters, getSettersForInterface($interface); + } + return @setters; +} + +# get the names of the getters for the device represented by the $hash +# empty list is returned if interfaces are not defined +sub +getGetters($) { + my ($hash)= @_; + my @getters; + my $interface; + foreach $interface (getInterfaces($hash)) { + push @getters, getGettersForInterface($interface); + } + return @getters; +} + +sub +concatc($$$) { + my ($separator,$a,$b)= @_;; + return($a && $b ? $a . $separator . $b : $a . $b); +} + + +# this creates the standard interface definitions as in +# http://fhemwiki.de/wiki/DevelopmentInterfaces +sub +createInterfaceDefinitions() { + + Log 2, "Creating interface definitions..."; + # The interfaces list below consists of lines with the + # pipe-separated parts + # - name + # - ancestor + # - colon separated list of readings + # - colon-separated list of getters + # - colon-separated list of setters + # If no getters are listed they are considered identical + # to the readings. + # Ancestors must be listed before descendants. + # Two interfaces can share a subset of readings, getters and setters + # if and only if one interface is the ancestor of the other. + my $IDefs= <"; - FW_pO "
"; - FW_pO ""; # Need for equal width of subtables - - my $rf = ($FW_room ? "&room=$FW_room" : ""); # stay in the room +FW_showRoom1($) { + my $rf= shift; my $row=1; foreach my $type (sort keys %FW_types) { @@ -937,6 +929,39 @@ FW_showRoom() } FW_pO "

"; +} + +# API v1.0 +sub +FW_showRoom2($) { + my $rf= shift; + FW_pO "API v2

"; +} + + + +sub +FW_showRoom() +{ + return if(!$FW_room); + + # (re-) list the icons + FW_ReadIcons(); + + FW_pO "

"; + FW_pO "
"; + FW_pO ""; # Need for equal width of subtables + + my $rf = ($FW_room ? "&room=$FW_room" : ""); # stay in the room + + my $apiversion= AttrVal("global", "apiversion", 1); + if($apiversion==1) { + FW_showRoom1($rf); + } else { + FW_showRoom2($rf); + }; + + # Now the weblinks my $buttons = 1; my @list = ($FW_room eq "all" ? keys %defs : keys %{$FW_rooms{$FW_room}});