Public/fhem-mirror
1
0
Fork 0
mirror of https://github.com/fhem/fhem-mirror.git synced 2025-05-04 22:19:38 +00:00
Code Issues Packages Projects Releases Wiki Activity

new modul 70_SML.pm

Browse Source 
git-svn-id: https://svn.fhem.de/fhem/trunk/fhem@1423 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
bentele 2012-04-08 13:27:48 +00:00
parent 2c5f6a31b1
commit 4fb3b5a66a
125 changed files with 22397 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

153
contrib/contrib/00_TAHR.pm Normal file
View File

@ -0,0 +1,153 @@
###############################################
# Sample fhem module, one-level approach, controlling a single device like a
# directly attached heating regulator.
# The alternative is a two level approach, where a physical device like a CUL
# is a bridge to a large number of logical devices (like FS20 actors, S300
# sensors, etc)
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
sub TAHR_Read($);
sub TAHR_Ready($);
sub TAHR_setbits($$);
sub TAHR_SetReading($$$$);
my %tahr_sets = (
"ww_soll" => "0C07656565%02x6565",
"ww_betriebsart" => "0C0E%02x6565656565",
);
sub
TAHR_Initialize($)
{
my ($hash) = @_;
require "$attr{global}{modpath}/FHEM/DevIo.pm";
$hash->{ReadFn} = "TAHR_Read";
$hash->{ReadyFn} = "TAHR_Ready";
$hash->{DefFn} = "TAHR_Define";
$hash->{UndefFn} = "TAHR_Undef";
$hash->{SetFn} = "TAHR_Set";
$hash->{AttrList}= "do_not_notify:1,0 loglevel:0,1,2,3,4,5,6";
}
#####################################
sub
TAHR_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "wrong syntax: define <name> TAHR [devicename|none]"
if(@a != 3);
DevIo_CloseDev($hash);
my $name = $a[0];
my $dev = $a[2];
if($dev eq "none") {
Log 1, "TAHR device is none, commands will be echoed only";
return undef;
}
$hash->{DeviceName} = $dev;
my $ret = DevIo_OpenDev($hash, 0, "TAHR_Poll");
return $ret;
}
#####################################
sub
TAHR_Undef($$)
{
my ($hash, $arg) = @_;
DevIo_CloseDev($hash);
RemoveInternalTimer($hash);
return undef;
}
#####################################
sub
TAHR_Set($@)
{
my ($hash, @a) = @_;
return "\"set TAHR\" needs at least an argument" if(@a < 2);
my $cmd = $tahr_sets{$a[1]};
return "Unknown argument $a[1], choose one of " .
join(" ", sort keys %tahr_sets) if(!defined($cmd));
# FIXME
DevIo_SimpleWrite($hash, $cmd);
return undef;
}
#####################################
# called from the global loop, when the select for hash->{FD} reports data
sub
TAHR_Read($)
{
my ($hash) = @_;
my $name = $hash->{NAME};
my ($data, $crc);
my $buf = DevIo_SimpleRead($hash);
return "" if(!defined($buf));
$buf = unpack('H*', $buf);
Log 5, "RAW: $buf";
######################################
# Analyze the data
my $tn = TimeNow();
my ($key, $val) = ("key", "val");
# FIXME
TAHR_SetReading($hash, $tn, $key, $val);
}
#####################################
sub
TAHR_Ready($)
{
my ($hash) = @_;
return DevIo_OpenDev($hash, 1, undef)
if($hash->{STATE} eq "disconnected");
# This is relevant for windows/USB only
my $po = $hash->{USBDev};
my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags) = $po->status;
return ($InBytes>0);
}
sub
TAHR_Poll($)
{
my ($hash) = @_;
return if($hash->{STATE} eq "disconnected");
# FIXME
DevIo_SimpleWrite($hash, "02"); # Request data
InternalTimer(gettimeofday()+5, "TAHR_Poll", $hash, 0);
}
sub
TAHR_SetReading($$$$)
{
my ($hash,$tn,$key,$val) = @_;
my $name = $hash->{NAME};
Log GetLogLevel($name,4), "$name: $key $val";
$hash->{READINGS}{$key}{TIME} = $tn;
$hash->{READINGS}{$key}{VAL} = $val;
DoTrigger($name, "$key: $val");
}
1;

1590
contrib/contrib/1-Wire/00_OWX.pm Normal file
View File

File diff suppressed because it is too large Load Diff

1033
contrib/contrib/1-Wire/21_OWAD.pm Normal file
View File

File diff suppressed because it is too large Load Diff

706
contrib/contrib/1-Wire/21_OWCOUNT.pm Normal file
View File

@ -0,0 +1,706 @@
########################################################################################
#
# OWCOUNT.pm BETA Version
#
# FHEM module to commmunicate with 1-Wire Counter/RAM DS2423
#
# Attention: This module may communicate with the OWX module,
# but currently not with the 1-Wire File System OWFS
#
#
# SO FAR ONLY external counter inputs A,B are available ! Neither memory content, nor internal counters are questioned.
#
#
# Prefixes for subroutines of this module:
# OW = General 1-Wire routines Peter Henning)
# OWX = 1-Wire bus master interface (Peter Henning)
# OWFS = 1-Wire file system (??)
#
# Prof. Dr. Peter A. Henning, 2012
#
# Version 1.11 - March, 2012
#
# Setup bus device in fhem.cfg as
#
# define <name> OWCOUNT [<model>] <ROM_ID> [interval]
#
# where <name> may be replaced by any name string
#
# <model> is a 1-Wire device type. If omitted, we assume this to be an
# DS2423 Counter/RAM
# <ROM_ID> is a 12 character (6 byte) 1-Wire ROM ID
# without Family ID, e.g. A2D90D000800
# [interval] is an optional query interval in seconds
#
# get <name> id => FAM_ID.ROM_ID.CRC
# get <name> present => 1 if device present, 0 if not
# get <name> interval => query interval
# get <name> counter A,B => value for counter
#
# set <name> interval => set period for measurement
#
# Additional attributes are defined in fhem.cfg, in some cases per channel, where <channel>=A,B
# Note: attributes are read only during initialization procedure - later changes are not used.
#
# attr <name> <channel>Name <string>|<string> = name for the channel | a type description for the measured value
# attr <name> <channel>Unit <string>|<string> = unit of measurement for this channel | its abbreviation
# attr <name> <channel>Offset <float> = offset added to the reading in this channel
# attr <name> <channel>Factor <float> = factor multiplied to (reading+offset) in this channel
#
########################################################################################
#
# This programm 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.
#
# The GNU General Public License can be found at
# http://www.gnu.org/copyleft/gpl.html.
# A copy is found in the textfile GPL.txt and important notices to the license
# from the author is found in LICENSE.txt distributed with these scripts.
#
# This script 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.
#
########################################################################################
package main;
#-- Prototypes to make komodo happy
use vars qw{%attr %defs};
use strict;
use warnings;
sub Log($$);
#-- channel name - fixed is the first array, variable the second
my @owg_fixed = ("A","B");
my @owg_channel;
#-- channel values - always the raw values from the device
my @owg_val;
my %gets = (
"id" => "",
"present" => "",
"interval" => "",
#"page" => "",
"counter" => "",
);
my %sets = (
"interval" => ""
#"page" => ""
);
my %updates = (
"present" => "",
"counter" => ""
);
########################################################################################
#
# The following subroutines are independent of the bus interface
#
# Prefix = OWCOUNT
#
########################################################################################
#
# OWCOUNT_Initialize
#
# Parameter hash = hash of device addressed
#
########################################################################################
sub OWCOUNT_Initialize ($) {
my ($hash) = @_;
$hash->{DefFn} = "OWCOUNT_Define";
$hash->{UndefFn} = "OWCOUNT_Undef";
$hash->{GetFn} = "OWCOUNT_Get";
$hash->{SetFn} = "OWCOUNT_Set";
#Name = channel name
#Offset = an offset added to the reading
#Factor = a factor multiplied with (reading+offset)
#Unit = a unit of measure
my $attlist = "IODev do_not_notify:0,1 showtime:0,1 model:DS2450 loglevel:0,1,2,3,4,5 ";
for( my $i=0;$i<int(@owg_fixed);$i++ ){
$attlist .= " ".$owg_fixed[$i]."Name";
$attlist .= " ".$owg_fixed[$i]."Offset";
$attlist .= " ".$owg_fixed[$i]."Factor";
$attlist .= " ".$owg_fixed[$i]."Unit";
}
$hash->{AttrList} = $attlist;
}
#########################################################################################
#
# OWCOUNT_Define - Implements DefFn function
#
# Parameter hash = hash of device addressed, def = definition string
#
#########################################################################################
sub OWCOUNT_Define ($$) {
my ($hash, $def) = @_;
# define <name> OWCOUNT [<model>] <id> [interval]
# e.g.: define flow OWCOUNT 525715020000 300
my @a = split("[ \t][ \t]*", $def);
my ($name,$model,$fam,$id,$crc,$interval,$scale,$ret);
#-- default
$name = $a[0];
$interval = 300;
$scale = "";
$ret = "";
#-- check syntax
return "OWCOUNT: Wrong syntax, must be define <name> OWCOUNT [<model>] <id> [interval]"
if(int(@a) < 2 || int(@a) > 5);
#-- check if this is an old style definition, e.g. <model> is missing
my $a2 = $a[2];
my $a3 = defined($a[3]) ? $a[3] : "";
if( $a2 =~ m/^[0-9|a-f|A-F]{12}$/ ) {
$model = "DS2423";
$id = $a[2];
if(int(@a)>=4) { $interval = $a[3]; }
} elsif( $a3 =~ m/^[0-9|a-f|A-F]{12}$/ ) {
$model = $a[2];
return "OWCOUNT: Wrong 1-Wire device model $model"
if( $model ne "DS2423");
$id = $a[3];
} else {
return "OWCOUNT: $a[0] ID $a[2] invalid, specify a 12 digit value";
}
#-- 1-Wire ROM identifier in the form "FF.XXXXXXXXXXXX.YY"
# determine CRC Code - only if this is a direct interface
$crc = defined($hash->{IODev}->{INTERFACE}) ? sprintf("%02x",OWX_CRC("1D.".$id."00")) : "00";
#-- Define device internals
$hash->{ROM_ID} = "1D.".$id.$crc;
$hash->{OW_ID} = $id;
$hash->{OW_FAMILY} = "1D";
$hash->{PRESENT} = 0;
$hash->{INTERVAL} = $interval;
#-- Couple to I/O device
AssignIoPort($hash);
Log 3, "OWCOUNT: Warning, no 1-Wire I/O device found for $name."
if(!defined($hash->{IODev}->{NAME}));
$modules{OWCOUNT}{defptr}{$id} = $hash;
$hash->{STATE} = "Defined";
Log 3, "OWCOUNT: Device $name defined.";
#-- Initialization reading according to interface type
my $interface= $hash->{IODev}->{TYPE};
#-- Start timer for initialization in a few seconds
InternalTimer(time()+1, "OWCOUNT_InitializeDevice", $hash, 0);
#-- Start timer for updates
InternalTimer(time()+$hash->{INTERVAL}, "OWCOUNT_GetValues", $hash, 0);
return undef;
}
########################################################################################
#
# OWCOUNT_InitializeDevice - delayed setting of initial readings and channel names
#
# Parameter hash = hash of device addressed
#
########################################################################################
sub OWCOUNT_InitializeDevice($) {
my ($hash) = @_;
my $name = $hash->{NAME};
#-- Initial readings
@owg_val = (0.0,0.0,0.0,0.0);
#-- Set channel names, channel units and alarm values
for( my $i=0;$i<int(@owg_fixed);$i++) {
#-- name
my $cname = defined($attr{$name}{$owg_fixed[$i]."Name"}) ? $attr{$name}{$owg_fixed[$i]."Name"} : $owg_fixed[$i]."|event";
my @cnama = split(/\|/,$cname);
Log 1, "OWCOUNT: InitializeDevice with insufficient name specification $cname"
if( int(@cnama)!=2 );
$owg_channel[$i] = $cnama[0];
#-- unit
my $unit = defined($attr{$name}{$owg_fixed[$i]."Unit"}) ? $attr{$name}{$owg_fixed[$i]."Unit"} : "counts|";
my @unarr= split(/\|/,$unit);
#Log 1, "OWCOUNT: InitializeDevice with insufficient unit specification $unit"
# if( int(@unarr)!=2 );
#-- offset and scale factor
my $offset = defined($attr{$name}{$owg_fixed[$i]."Offset"}) ? $attr{$name}{$owg_fixed[$i]."Offset"} : 0;
my $factor = defined($attr{$name}{$owg_fixed[$i]."Factor"}) ? $attr{$name}{$owg_fixed[$i]."Factor"} : 1;
#-- put into readings
$hash->{READINGS}{"$owg_channel[$i]"}{TYPE} = defined($cnama[1]) ? $cnama[1] : "unknown";
$hash->{READINGS}{"$owg_channel[$i]"}{UNIT} = $unarr[0];
$hash->{READINGS}{"$owg_channel[$i]"}{UNITABBR} = defined($unarr[1]) ? $unarr[1] : "";
$hash->{READINGS}{"$owg_channel[$i]"}{OFFSET} = $offset;
$hash->{READINGS}{"$owg_channel[$i]"}{FACTOR} = $factor;
}
#-- set status according to interface type
my $interface= $hash->{IODev}->{TYPE};
#-- OWX interface
if( !defined($interface) ){
return "OWCOUNT: Interface missing";
} elsif( $interface eq "OWX" ){
#-- OWFS interface
#}elsif( $interface eq "OWFS" ){
# $ret = OWFSAD_GetPage($hash,"reading");
#-- Unknown interface
}else{
return "OWCOUNT: InitializeDevice with wrong IODev type $interface";
}
#-- Initialize all the display stuff
OWCOUNT_FormatValues($hash);
}
########################################################################################
#
# OWCOUNT_FormatValues - put together various format strings
#
# Parameter hash = hash of device addressed, fs = format string
#
########################################################################################
sub OWCOUNT_FormatValues($) {
my ($hash) = @_;
my $name = $hash->{NAME};
my ($offset,$factor,$vval);
my ($value1,$value2,$value3) = ("","","");
my $galarm = 0;
my $tn = TimeNow();
#-- formats for output
for (my $i=0;$i<int(@owg_fixed);$i++){
$offset = $hash->{READINGS}{"$owg_channel[$i]"}{OFFSET};
$factor = $hash->{READINGS}{"$owg_channel[$i]"}{FACTOR};
#-- correct values for proper offset, factor
if( $factor == 1.0 ){
$vval = ($owg_val[$i] + $offset)*$factor;
} else {
$vval = int(($owg_val[$i] + $offset)*$factor*1000)/1000;
}
#-- put into READINGS
$hash->{READINGS}{"$owg_channel[$i]"}{VAL} = $vval;
$hash->{READINGS}{"$owg_channel[$i]"}{TIME} = $tn;
#-- string buildup for return value and STATE
$value1 .= sprintf( "%s: %5.3f %s", $owg_channel[$i], $vval,$hash->{READINGS}{"$owg_channel[$i]"}{UNITABBR});
$value2 .= sprintf( "%s: %5.2f %s ", $owg_channel[$i], $vval,$hash->{READINGS}{"$owg_channel[$i]"}{UNITABBR});
$value3 .= sprintf( "%s: " , $owg_channel[$i]);
#-- insert comma
if( $i<3 ){
$value1 .= " ";
$value2 .= ", ";
$value3 .= ", ";
}
}
#-- STATE
$hash->{STATE} = $value2;
return $value1;
}
########################################################################################
#
# OWCOUNT_Get - Implements GetFn function
#
# Parameter hash = hash of device addressed, a = argument array
#
########################################################################################
sub OWCOUNT_Get($@) {
my ($hash, @a) = @_;
my $reading = $a[1];
my $name = $hash->{NAME};
my $model = $hash->{OW_MODEL};
my ($value,$value2,$value3) = (undef,undef,undef);
my $ret = "";
my $offset;
my $factor;
#-- check syntax
return "OWCOUNT: Get argument is missing @a"
if(int(@a) < 2);
#-- check argument
return "OWCOUNT: Get with unknown argument $a[1], choose one of ".join(",", sort keys %gets)
if(!defined($gets{$a[1]}));
#-- get id
if($a[1] eq "id") {
$value = $hash->{ROM_ID};
return "$a[0] $reading => $value";
}
#-- get present
if($a[1] eq "present") {
#-- hash of the busmaster
my $master = $hash->{IODev};
$value = OWX_Verify($master,$hash->{ROM_ID});
$hash->{PRESENT} = $value;
return "$a[0] $reading => $value";
}
#-- get interval
if($a[1] eq "interval") {
$value = $hash->{INTERVAL};
return "$a[0] $reading => $value";
}
#-- reset presence
$hash->{PRESENT} = 0;
#-- get memory page/counter according to interface type
my $interface= $hash->{IODev}->{TYPE};
#-- check syntax for getting counter
if( $reading eq "counter" ){
return "OWCOUNT: get needs parameter when reading counter: <channel>"
if( int(@a)<2 );
#-- channle may be addressed by bare channel name (A..D) or by defined channel name
return "OWCOUNT: invalid counter address, must be A or B"
if( !($a[2] =~ m/[AB]/) );
my $page = ($a[2] eq "A") ? 14 : 15;
#-- OWX interface
if( $interface eq "OWX" ){
$ret = OWXCOUNT_GetPage($hash,$page);
#-- OWFS interface
#}elsif( $interface eq "OWFS" ){
# $ret = OWFSAD_GetPage($hash,"reading");
#-- Unknown interface
}else{
return "OWCOUNT: Get with wrong IODev type $interface";
}
#-- process results
if( defined($ret) ){
return "OWCOUNT: Could not get values from device $name";
}
$hash->{PRESENT} = 1;
return "OWCOUNT: $name.$reading => ".OWCOUNT_FormatValues($hash);
}
}
#######################################################################################
#
# OWCOUNT_GetValues - Updates the reading from one device
#
# Parameter hash = hash of device addressed
#
########################################################################################
sub OWCOUNT_GetValues($) {
my $hash = shift;
my $name = $hash->{NAME};
my $model = $hash->{OW_MODEL};
my $value = "";
my $ret = "";
my $offset;
my $factor;
#-- define warnings
my $warn = "none";
$hash->{ALARM} = "0";
#-- restart timer for updates
RemoveInternalTimer($hash);
InternalTimer(time()+$hash->{INTERVAL}, "OWCOUNT_GetValues", $hash, 1);
#-- reset presence
$hash->{PRESENT} = 0;
#-- Get readings, alarms and stati according to interface type
my $interface= $hash->{IODev}->{TYPE};
if( $interface eq "OWX" ){
$ret = OWXCOUNT_GetPage($hash,14);
$ret = OWXCOUNT_GetPage($hash,15);
#}elsif( $interface eq "OWFS" ){
# $ret = OWFSAD_GetValues($hash);
}else{
return "OWCOUNT: GetValues with wrong IODev type $interface";
}
#-- process results
if( defined($ret) ){
return "OWCOUNT: Could not get values from device $name";
}
$hash->{PRESENT} = 1;
$value=OWCOUNT_FormatValues($hash);
#--logging
Log 5, $value;
$hash->{CHANGED}[0] = $value;
DoTrigger($name, undef);
return undef;
}
#######################################################################################
#
# OWCOUNT_Set - Set one value for device
#
# Parameter hash = hash of device addressed
# a = argument array
#
########################################################################################
sub OWCOUNT_Set($@) {
my ($hash, @a) = @_;
my $key = $a[1];
my $value = $a[2];
#-- for the selector: which values are possible
if (@a == 2){
my $newkeys = join(" ", sort keys %sets);
return $newkeys ;
}
#-- check syntax
return "OWCOUNT: Set needs one parameter when setting this value"
if( int(@a)!=3 );
#-- check argument
if( !defined($sets{$a[1]}) ){
return "OWCOUNT: Set with unknown argument $a[1]";
}
#-- define vars
my $ret = undef;
my $channel = undef;
my $channo = undef;
my $factor;
my $offset;
my $condx;
my $name = $hash->{NAME};
my $model = $hash->{OW_MODEL};
#-- set new timer interval
if($key eq "interval") {
# check value
return "OWCOUNT: Set with short interval, must be > 1"
if(int($value) < 1);
# update timer
$hash->{INTERVAL} = $value;
RemoveInternalTimer($hash);
InternalTimer(gettimeofday()+$hash->{INTERVAL}, "OWCOUNT_GetValues", $hash, 1);
return undef;
}
}
########################################################################################
#
# OWCOUNT_Undef - Implements UndefFn function
#
# Parameter hash = hash of device addressed
#
########################################################################################
sub OWCOUNT_Undef ($) {
my ($hash) = @_;
delete($modules{OWCOUNT}{defptr}{$hash->{OW_ID}});
RemoveInternalTimer($hash);
return undef;
}
########################################################################################
#
# The following subroutines in alphabetical order are only for a 1-Wire bus connected
# via OWFS
#
# Prefix = OWFSCOUNT
#
########################################################################################
########################################################################################
#
# The following subroutines in alphabetical order are only for a 1-Wire bus connected
# directly to the FHEM server
#
# Prefix = OWXAD
#
########################################################################################
#
# OWXAD_GetPage - Get one memory page + counter from device
#
# Parameter hash = hash of device addressed
# page = "reading", "alarm" or "status"
#
########################################################################################
sub OWXCOUNT_GetPage($$) {
my ($hash,$page) = @_;
#-- For now, switch on conversion command
my $con=1;
my ($select, $res, $res2, $res3, @data);
#-- ID of the device
my $owx_dev = $hash->{ROM_ID};
my $owx_rnf = substr($owx_dev,3,12);
my $owx_f = substr($owx_dev,0,2);
#-- hash of the busmaster
my $master = $hash->{IODev};
my ($i,$j,$k);
#-- 8 byte 1-Wire device address
my @owx_ROM_ID =(0,0,0,0 ,0,0,0,0);
#-- from search string to byte id
my $devs=$owx_dev;
$devs=~s/\.//g;
for($i=0;$i<8;$i++){
$owx_ROM_ID[$i]=hex(substr($devs,2*$i,2));
}
#=============== wrong value requested ===============================
if( ($page<0) || ($page>15) ){
return "OWXCOUNT: Wrong memory page requested";
}
#=============== get memory + counter ===============================
#-- issue the match ROM command \x55 and the read memory + counter command
# \xA5 TA1 TA2 reading 40 data bytes and 2 CRC bytes
my $ta2 = ($page*32) >> 8;
my $ta1 = ($page*32) & 255;
print "getting page Nr. $ta2 $ ta1\n";
$select=sprintf("\x55%c%c%c%c%c%c%c%c\xA5%c%c",
@owx_ROM_ID,$ta1,$ta2);
#-- reset the bus
OWX_Reset($master);
#-- read the data
$res=OWX_Block($master,$select);
if( $res eq 0 ){
return "OWX: Device $owx_dev not accessible in reading $page page";
}
#-- process results
#print "Have received ".length($res)." bytes\n";
#-- get 32 bytes
$select="";
for( $i=0;$i<42;$i++){
$select .= "\xFF";
}
#-- read the data
$res=OWX_Block($master,$select);
#-- process results
#print "Have received ".length($res)." bytes\n";
#-- get 10 bytes
$select="";
for( $i=0;$i<10;$i++){
$select .= "\xFF";
}
#-- read the data
$res=OWX_Block($master,$select);
#-- reset the bus
OWX_Reset($master);
#-- process results
#print "Have received ".length($res)." bytes\n";
@data=split(//,$res);
if ( ($data[4] | $data[5] | $data[6] | $data[7]) ne "\x00" ){
return "OWXCOUNT: Device $owx_dev returns invalid data";
}
#-- for now ignore memory and only use counter
my $value = ord($data[3])*4096 + ord($data[2])*256 +ord($data[1])*16 + ord($data[0]);
#print "Value received = $value\n";
if( $page == 14) {
$owg_val[0] = $value;
}elsif( $page == 15) {
$owg_val[1] = $value;
}
return undef
}
########################################################################################
#
# OWXCOUNT_SetPage - Set one memory page of device
#
# Parameter hash = hash of device addressed
# page = "alarm" or "status"
#
########################################################################################
sub OWXCOUNT_SetPage($$) {
my ($hash,$page) = @_;
my ($select, $res, $res2, $res3, @data);
#-- ID of the device
my $owx_dev = $hash->{ROM_ID};
my $owx_rnf = substr($owx_dev,3,12);
my $owx_f = substr($owx_dev,0,2);
#-- hash of the busmaster
my $master = $hash->{IODev};
my ($i,$j,$k);
#-- 8 byte 1-Wire device address
my @owx_ROM_ID =(0,0,0,0 ,0,0,0,0);
#-- from search string to byte id
my $devs=$owx_dev;
$devs=~s/\.//g;
for($i=0;$i<8;$i++){
$owx_ROM_ID[$i]=hex(substr($devs,2*$i,2));
}
#=============== set the alarm values ===============================
#if ( $page eq "test" ) {
#-- issue the match ROM command \x55 and the set alarm page command
# \x55\x10\x00 reading 8 data bytes and 2 CRC bytes
# $select=sprintf("\x55%c%c%c%c%c%c%c%c\x55\x10\x00",
# @owx_ROM_ID);
#
#=============== wrong page write attempt ===============================
#} else {
return "OWXCOUNT: Wrong memory page write attempt";
#}
OWX_Reset($master);
$res=OWX_Block($master,$select);
#-- process results
if( $res eq 0 ){
return "OWXCOUNT: Device $owx_dev not accessible for writing";
}
return undef;
}
1;

212
contrib/contrib/1-Wire/21_OWID.pm Normal file
View File

@ -0,0 +1,212 @@
########################################################################################
#
# OWID.pm
#
# FHEM module to commmunicate with general 1-Wire ID-ROMS
#
# Attention: This module may communicate with the OWX module,
# but currently not with the 1-Wire File System OWFS
#
# Prefixes for subroutines of this module:
# OW = General 1-Wire routines Peter Henning)
#
# Prof. Dr. Peter A. Henning, 2012
#
# Version 1.11 - March, 2012
#
# Setup bus device in fhem.cfg as
#
# define <name> OWID <FAM_ID> <ROM_ID>
#
# where <name> may be replaced by any name string
#
# <FAM_ID> is a 2 character (1 byte) 1-Wire Family ID
#
# <ROM_ID> is a 12 character (6 byte) 1-Wire ROM ID
# without Family ID, e.g. A2D90D000800
#
# get <name> id => FAM_ID.ROM_ID.CRC
# get <name> present => 1 if device present, 0 if not
#
#
########################################################################################
#
# This programm 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.
#
# The GNU General Public License can be found at
# http://www.gnu.org/copyleft/gpl.html.
# A copy is found in the textfile GPL.txt and important notices to the license
# from the author is found in LICENSE.txt distributed with these scripts.
#
# This script 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.
#
########################################################################################
package main;
#-- Prototypes to make komodo happy
use vars qw{%attr %defs};
use strict;
use warnings;
sub Log($$);
#-- declare variables
my %gets = (
"present" => "",
"id" => ""
);
my %sets = ();
my %updates = ();
########################################################################################
#
# The following subroutines are independent of the bus interface
#
# Prefix = OWID
#
########################################################################################
#
# OWID_Initialize
#
# Parameter hash = hash of device addressed
#
########################################################################################
sub OWID_Initialize ($) {
my ($hash) = @_;
$hash->{DefFn} = "OWID_Define";
$hash->{UndefFn} = "OWID_Undef";
$hash->{GetFn} = "OWID_Get";
$hash->{SetFn} = undef;
my $attlist = "IODev do_not_notify:0,1 showtime:0,1 loglevel:0,1,2,3,4,5 ";
$hash->{AttrList} = $attlist;
}
#########################################################################################
#
# OWID_Define - Implements DefFn function
#
# Parameter hash = hash of device addressed, def = definition string
#
#########################################################################################
sub OWID_Define ($$) {
my ($hash, $def) = @_;
#-- define <name> OWID <FAM_ID> <ROM_ID>
my @a = split("[ \t][ \t]*", $def);
my ($name,$fam,$id,$crc,$ret);
#-- default
$name = $a[0];
$ret = "";
#-- check syntax
return "OWID: Wrong syntax, must be define <name> OWID <fam> <id>"
if(int(@a) !=4 );
#-- check id
if( $a[2] =~ m/^[0-9|a-f|A-F]{2}$/ ) {
$fam = $a[2];
} else {
return "OWID: $a[0] family id $a[2] invalid, specify a 2 digit value";
}
if( $a[3] =~ m/^[0-9|a-f|A-F]{12}$/ ) {
$id = $a[3];
} else {
return "OWID: $a[0] ID $a[3] invalid, specify a 12 digit value";
}
#-- 1-Wire ROM identifier in the form "FF.XXXXXXXXXXXX.YY"
# determine CRC Code YY - only if this is a direct interface
$crc = defined($hash->{IODev}->{INTERFACE}) ? sprintf("%02x",OWX_CRC($fam.".".$id."00")) : "00";
#-- Define device internals
$hash->{ROM_ID} = $fam.".".$id.$crc;
$hash->{OW_ID} = $id;
$hash->{OW_FAMILY} = $fam;
$hash->{PRESENT} = 0;
#-- Couple to I/O device
AssignIoPort($hash);
Log 3, "OWID: Warning, no 1-Wire I/O device found for $name."
if(!defined($hash->{IODev}->{NAME}));
$modules{OWID}{defptr}{$id} = $hash;
$hash->{STATE} = "Defined";
Log 3, "OWID: Device $name defined.";
#-- Initialization reading according to interface type
my $interface= $hash->{IODev}->{TYPE};
$hash->{STATE} = "Initialized";
return undef;
}
########################################################################################
#
# OWID_Get - Implements GetFn function
#
# Parameter hash = hash of device addressed, a = argument array
#
########################################################################################
sub OWID_Get($@) {
my ($hash, @a) = @_;
my $reading = $a[1];
my $name = $hash->{NAME};
my $model = $hash->{OW_MODEL};
my $value = undef;
my $ret = "";
my $offset;
my $factor;
#-- check syntax
return "OWID: Get argument is missing @a"
if(int(@a) != 2);
#-- check argument
return "OWID: Get with unknown argument $a[1], choose one of ".join(",", sort keys %gets)
if(!defined($gets{$a[1]}));
#-- get id
if($a[1] eq "id") {
$value = $hash->{ROM_ID};
return "$a[0] $reading => $value";
}
#-- get present
if($a[1] eq "present") {
#-- hash of the busmaster
my $master = $hash->{IODev};
$value = OWX_Verify($master,$hash->{ROM_ID});
$hash->{PRESENT} = $value;
return "$a[0] $reading => $value";
}
}
########################################################################################
#
# OWID_Undef - Implements UndefFn function
#
# Parameter hash = hash of device addressed
#
########################################################################################
sub OWID_Undef ($) {
my ($hash) = @_;
delete($modules{OWID}{defptr}{$hash->{OW_ID}});
RemoveInternalTimer($hash);
return undef;
}
1;

970
contrib/contrib/1-Wire/21_OWLCD.pm Normal file
View File

@ -0,0 +1,970 @@
########################################################################################
#
# OWLCD.pm
#
# FHEM module to commmunicate with the 1-Wire LCD hardware
#
# Attention: This module may communicate with the OWX module,
# but currently not with the 1-Wire File System OWFS
#
# Prefixes for subroutines of this module:
# OW = General 1-Wire routines Peter Henning
#
# Prof. Dr. Peter A. Henning, 2012
#
# Version 1.11 - March, 2012
#
# Setup bus device in fhem.cfg as
#
# define <name> OWLCD <ROM_ID>
#
# where <name> may be replaced by any name string
#
# <ROM_ID> is a 12 character (6 byte) 1-Wire ROM ID
# without Family ID, e.g. A2D90D000800
#
# get <name> id => FAM_ID.ROM_ID.CRC
# get <name> present => 1 if device present, 0 if not
# get <name> gpio => current state of the gpio pins (15 = all off, 0 = all on)
# get <name> counter => four values (16 Bit) of the gpio counter
# get <name> version => firmware version of the LCD adapter
#
# Careful: Not ASCII ! strange Codepage
########################################################################################
#
# This programm 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.
#
# The GNU General Public License can be found at
# http://www.gnu.org/copyleft/gpl.html.
# A copy is found in the textfile GPL.txt and important notices to the license
# from the author is found in LICENSE.txt distributed with these scripts.
#
# This script 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.
#
########################################################################################
package main;
#-- Prototypes to make komodo happy
use vars qw{%attr %defs};
use strict;
use warnings;
sub Log($$);
#-- controller may be HD44780 or KS0073
my $lcdcontroller = "KS0073";
my $lcdlines = 4;
my $lcdchars = 20;
#-- declare variables
my %gets = (
"present" => "",
"id" => "",
"gpio" => "",
"counter" => "",
#"memory" => "",
"version" => "",
#"register" => "",
#"data" => ""
);
my %sets = (
"icon" => "",
"line" => "",
"gpio" => "",
"backlight" => "",
"lcd" => "",
"reset" => "",
"test" => ""
);
my %updates = ();
########################################################################################
#
# The following subroutines are independent of the bus interface
#
# Prefix = OWLCD
#
########################################################################################
#
# OWLCD_Initialize
#
# Parameter hash = hash of device addressed
#
########################################################################################
sub OWLCD_Initialize ($) {
my ($hash) = @_;
$hash->{DefFn} = "OWLCD_Define";
$hash->{UndefFn} = "OWLCD_Undef";
$hash->{GetFn} = "OWLCD_Get";
$hash->{SetFn} = "OWLCD_Set";
my $attlist = "IODev do_not_notify:0,1 showtime:0,1 loglevel:0,1,2,3,4,5 ".
"";
$hash->{AttrList} = $attlist;
}
#########################################################################################
#
# OWLCD_Define - Implements DefFn function
#
# Parameter hash = hash of device addressed, def = definition string
#
#########################################################################################
sub OWLCD_Define ($$) {
my ($hash, $def) = @_;
#-- define <name> OWLCD <ROM_ID>
my @a = split("[ \t][ \t]*", $def);
my ($name,$fam,$id,$crc,$ret);
#-- default
$name = $a[0];
$ret = "";
#-- check syntax
return "OWLCD: Wrong syntax, must be define <name> OWLCD <id>"
if(int(@a) !=3 );
#-- check id
if( $a[2] =~ m/^[0-9|a-f|A-F]{12}$/ ) {
$id = $a[2];
} else {
return "OWLCD: $a[0] ID $a[2] invalid, specify a 12 digit value";
}
#-- 1-Wire ROM identifier in the form "FF.XXXXXXXXXXXX.YY"
# determine CRC Code - only if this is a direct interface
$crc = defined($hash->{IODev}->{INTERFACE}) ? sprintf("%02x",OWX_CRC("FF.".$id."00")) : "00";
#-- Define device internals
$hash->{ROM_ID} = "FF.".$id.$crc;
$hash->{OW_ID} = $id;
$hash->{OW_FAMILY} = "FF";
$hash->{PRESENT} = 0;
#-- Couple to I/O device
AssignIoPort($hash);
Log 3, "OWLCD: Warning, no 1-Wire I/O device found for $name."
if(!defined($hash->{IODev}->{NAME}));
$modules{OWLCD}{defptr}{$id} = $hash;
$hash->{STATE} = "Defined";
Log 3, "OWLCD: Device $name defined.";
#-- Initialization reading according to interface type
my $interface= $hash->{IODev}->{TYPE};
#-- OWX interface
if( $interface eq "OWX" ){
OWXLCD_InitializeDevice($hash);
#-- set backlight on
OWXLCD_SetFunction($hash,"bklon",0);
#-- erase all icons
OWXLCD_SetIcon($hash,0,0);
#-- Unknown interface
}else{
return "OWLCD: Wrong IODev type $interface";
}
$hash->{STATE} = "Initialized";
return undef;
}
########################################################################################
#
# OWLCD_Get - Implements GetFn function
#
# Parameter hash = hash of device addressed, a = argument array
#
########################################################################################
sub OWLCD_Get($@) {
my ($hash, @a) = @_;
my $reading = $a[1];
my $name = $hash->{NAME};
my $model = $hash->{OW_MODEL};
my $value = undef;
my $ret = "";
my $offset;
my $factor;
#-- check syntax
return "OWLCD: Get argument is missing @a"
if(int(@a) != 2);
#-- check argument
return "OWLCD: Get with unknown argument $a[1], choose one of ".join(",", sort keys %gets)
if(!defined($gets{$a[1]}));
#-- get id
if($a[1] eq "id") {
$value = $hash->{ROM_ID};
return "$a[0] $reading => $value";
}
#-- get present
if($a[1] eq "present") {
#-- hash of the busmaster
my $master = $hash->{IODev};
$value = OWX_Verify($master,$hash->{ROM_ID});
$hash->{PRESENT} = $value;
return "$a[0] $reading => $value";
}
#-- get gpio states
if($a[1] eq "gpio") {
$value = OWXLCD_Get($hash,"gpio",0);
return "$a[0] $reading => $value";
}
#-- get gpio counters
if($a[1] eq "counter") {
$value = OWXLCD_Get($hash,"counter",0);
return "$a[0] $reading => $value";
}
#-- get EEPROM counters
if($a[1] eq "memory") {
$value = OWXLCD_Get($hash,"memory",0);
return "$a[0] $reading => $value";
}
#-- get version
if($a[1] eq "version") {
$value = OWXLCD_Get($hash,"version",0);
return "$a[0] $reading => $value";
}
#-- get register
if($a[1] eq "register") {
$value = OWXLCD_Get($hash,"register",0);
return "$a[0] $reading => $value";
}
#-- get data
if($a[1] eq "data") {
$value = OWXLCD_Get($hash,"data",0);
return "$a[0] $reading => $value";
}
}
#######################################################################################
#
# OWLCD_Set - Set one value for device
#
# Parameter hash = hash of device addressed
# a = argument array
#
########################################################################################
sub OWLCD_Set($@) {
my ($hash, @a) = @_;
my $key = $a[1];
my $value = $a[2];
my ($line,$icon,$i);
#-- for the selector: which values are possible
return join(" ", keys %sets)
if ( (@a == 2) && !(($key eq "reset") || ($key eq "test")) );
#-- check argument
if( !defined($sets{$a[1]}) ){
return "OWLCD: Set with unknown argument $a[1]";
}
#-- check syntax for setting line
if( $key eq "line" ){
return "OWLCD: Set needs two parameters when setting line value: <#line> <string>"
if( int(@a)<3 );
$line = ($a[2] =~ m/\d/) ? $a[2] : 0;
$value = $a[3];
for( $i=4; $i< int(@a); $i++){
$value .= " ".$a[$i];
}
#-- check syntax for setting icon
} elsif ( $key eq "icon" ){
if( ($a[2] ne "0") && ($a[2] ne "none") ){
return "OWLCD: Set needs two parameters when setting icon value: <#icon> on/off/blink (resp. 0..5/off/blink for #16)"
if( (int(@a)!=4) );
$icon = ($a[2] =~ m/\d\d?/) ? $a[2] : 0;
$value = $a[3];
} else {
return "OWLCD: Set needs only one parameter when resetting icons"
if( (int(@a)!=3) );
$icon = 0;
$value = "OFF";
}
#-- check syntax for reset and test
} elsif ( ($key eq "reset") || ($key eq "test") ){
return "OWLCD: Set needs no parameters when setting $key value"
if( int(@a)!=2 );
#-- other syntax
} else {
return "OWLCD: Set needs one parameter when setting $key value"
if( int(@a)!=3 );
}
#-- define vars
my $name = $hash->{NAME};
my $model = $hash->{OW_MODEL};
#-- set gpio ports from all off = to all on = 7
if($key eq "gpio") {
#-- check value and write to device
return "OWLCD: Set with wrong value for gpio port, must be 0 <= gpio <= 7"
if( ! ((int($value) > 0) && (int($value) < 7)) );
OWXLCD_SetFunction($hash, "gpio", int($value));
return undef;
}
#-- set LCD ON or OFF
if($key eq "lcd") {
#-- check value and write to device
if( uc($value) eq "ON"){
OWXLCD_SetFunction($hash, "lcdon", 0);
}elsif( uc($value) eq "OFF" ){
OWXLCD_SetFunction($hash, "lcdoff", 0);
} else {
return "OWLCD: Set with wrong value for lcd, must be on/off"
}
return undef;
}
#-- set LCD Backlight ON or OFF
if($key eq "backlight") {
#-- check value and write to device
if( uc($value) eq "ON"){
OWXLCD_SetFunction($hash, "bklon", 0);
}elsif( uc($value) eq "OFF" ){
OWXLCD_SetFunction($hash, "bkloff", 0);
} else {
return "OWLCD: Set with wrong value for backlight, must be on/off"
}
return undef;
}
#-- reset
if($key eq "reset") {
OWXLCD_SetFunction($hash,"reset",0);
OWXLCD_SetIcon($hash,0,0);
return undef;
}
#-- set icon
if($key eq "icon") {
return "OWLCD: Wrong icon type, choose 0..16"
if( ( 0 > $icon ) || ($icon > 16) );
#-- check value and write to device
if( $icon == 16 ){
if( uc($value) eq "OFF" ){
OWXLCD_SetIcon($hash, 16, 0);
}elsif( uc($value) eq "BLINK" ){
OWXLCD_SetIcon($hash, 16, 6);
}elsif( ((int($value) > 0) && (int($value) < 6)) ){
OWXLCD_SetIcon($hash, 16, int($value));
} else {
return "OWLCD: Set with wrong value for icon #16, must be 0..5/off/blink"
}
}else{
if( uc($value) eq "OFF"){
OWXLCD_SetIcon($hash, $icon, 0);
}elsif( uc($value) eq "ON" ){
OWXLCD_SetIcon($hash, $icon, 1);
}elsif( uc($value) eq "BLINK" ){
OWXLCD_SetIcon($hash, $icon, 2);
} else {
return "OWLCD: Set with wrong value for icon $icon, must be on/off/blink"
}
}
return undef;
}
#-- set a single LCD line
if($key eq "line") {
return "OWLCD: Wrong line number, choose 0..".$lcdlines
if( ( 0 > $line ) || ($line > ($lcdlines-1)) );
return "OWLCD: Wrong line length, must be < ".$lcdchars
if( length($value) > $lcdchars );
#-- check value and write to device
OWXLCD_SetLine($hash,$line,$value);
return undef;
}
#-- start test
if($key eq "test") {
OWXLCD_SetLine($hash,0,"Hallo Welt");
OWXLCD_SetLine($hash,1,"Mary had a big lamb");
OWXLCD_SetLine($hash,2,"Solar 4.322 kW ");
OWXLCD_SetLine($hash,3,"\x5B\x5C\x5E\x7B\x7C\x7E\xBE");
return undef;
}
}
########################################################################################
#
# OWLCD_Undef - Implements UndefFn function
#
# Parameter hash = hash of device addressed
#
########################################################################################
sub OWLCD_Undef ($) {
my ($hash) = @_;
delete($modules{OWLCD}{defptr}{$hash->{OW_ID}});
RemoveInternalTimer($hash);
return undef;
}
########################################################################################
#
# OWXLCD_Byte - write a single byte to the LCD device
#
# Parameter hash = hash of device addressed
# cmd = register or data
# byte = byte
#
########################################################################################
sub OWXLCD_Byte($$$) {
my ($hash,$cmd,$byte) = @_;
my ($select, $select2, $res, $res2, $res3, @data);
#-- ID of the device
my $owx_dev = $hash->{ROM_ID};
my $owx_rnf = substr($owx_dev,3,12);
my $owx_f = substr($owx_dev,0,2);
#-- hash of the busmaster
my $master = $hash->{IODev};
my ($i,$j,$k);
#-- 8 byte 1-Wire device address
my @owx_ROM_ID =(0,0,0,0 ,0,0,0,0);
#-- from search string to byte id
my $devs=$owx_dev;
$devs=~s/\.//g;
for($i=0;$i<8;$i++){
$owx_ROM_ID[$i]=hex(substr($devs,2*$i,2));
}
#-- issue the match ROM command \x55
$select = sprintf("\x55%c%c%c%c%c%c%c%c",
@owx_ROM_ID);
#=============== write to LCD register ===============================
if ( $cmd eq "register" ) {
#-- issue the read LCD register command \x10
$select .= sprintf("\x10%c",$byte);
#=============== write to LCD data ===============================
}elsif ( $cmd eq "data" ) {
#-- issue the read LCD data command \x12
$select .= sprintf("\x12%c",$byte);
#=============== wrong value requested ===============================
} else {
return "OWXLCD: Wrong byte write attempt";
}
#-- write to device
OWX_Reset($master);
$res=OWX_Block($master,$select);
#-- process results
if( $res eq 0 ){
return "OWLCD: Device $owx_dev not accessible for writing a byte";
}
return undef;
}
########################################################################################
#
# OWXLCD_Get - get values from the LCD device
#
# Parameter hash = hash of device addressed
# cmd = command string
# page = memory page address
#
########################################################################################
sub OWXLCD_Get($$$) {
my ($hash,$cmd,$value) = @_;
my ($select, $select2, $len, $addr, $res, $res2, $res3, @data);
#-- ID of the device
my $owx_dev = $hash->{ROM_ID};
my $owx_rnf = substr($owx_dev,3,12);
my $owx_f = substr($owx_dev,0,2);
#-- hash of the busmaster
my $master = $hash->{IODev};
my ($i,$j,$k);
#-- 8 byte 1-Wire device address
my @owx_ROM_ID =(0,0,0,0 ,0,0,0,0);
#-- from search string to byte id
my $devs=$owx_dev;
$devs=~s/\.//g;
for($i=0;$i<8;$i++){
$owx_ROM_ID[$i]=hex(substr($devs,2*$i,2));
}
#-- issue the match ROM command \x55
$select = sprintf("\x55%c%c%c%c%c%c%c%c",
@owx_ROM_ID);
#-- issue the match ROM command \x55 and the read scratchpad command \xBE
$select2 = $select."\xBE";
#=============== fill scratch with gpio ports ===============================
if ( $cmd eq "gpio" ) {
#-- issue the read GPIO command \x22 (1 byte)
$select .= "\x22";
$len = 1;
#=============== fill scratch with gpio counters ===============================
}elsif ( $cmd eq "counter" ) {
#-- issue the read counter command \x23 (8 bytes)
$select .= "\x23";
$len = 8;
#=============== fill scratch with EEPROM ===============================
#}elsif ( $cmd eq "memory" ) {
# #-- issue the read EEPROM command \x37
# $len=16;
# $select .= "\x37";
#=============== fill scratch with version ===============================
}elsif ( $cmd eq "version" ) {
#-- issue the read version command \x41
$select .= "\x41";
$len = 16;
#=============== fill scratch with LCD register ===============================
#}elsif ( $cmd eq "register" ) {
# #-- issue the read LCD register command \x11
# $select .= "\x11";
# $len = 16;
#=============== fill scratch with LCD data ===============================
#}elsif ( $cmd eq "data" ) {
# #-- issue the read LCD data command \x13
# $addr = 0;
# $len = 16;
# #$select .= sprintf("\x13%c",$addr);
# $select .= "\x13\x00\x10";
#=============== wrong value requested ===============================
} else {
return "OWXLCD: Wrong get attempt";
}
#-- write to device
OWX_Reset($master);
$res=OWX_Block($master,$select);
#-- process results
if( $res eq 0 ){
return "OWLCD: Device $owx_dev not accessible for reading";
}
#-- sleeping for some time
#select(undef,undef,undef,0.5);
#-- fill according to expected length
for($i=0;$i<$len;$i++){
$select2 .= "\xFF";
}
#-- write to device
OWX_Reset($master);
$res=OWX_Block($master,$select2);
#-- process results
if( $res eq 0 ){
return "OWLCD: Device $owx_dev not accessible for reading in 2nd step";
}
#-- process results (10 byes or more have been sent)
$res = substr($res,10);
#my $ress = "OWXLCD: Answer was ";
# for($i=0;$i<length($res);$i++){
# my $j=int(ord(substr($res,$i,1))/16);
# my $k=ord(substr($res,$i,1))%16;
# $ress.=sprintf "0x%1x%1x ",$j,$k;
# }
#Log 1, $ress;
#=============== gpio ports ===============================
if ( $cmd eq "gpio" ) {
return ord($res);
#=============== gpio counters ===============================
}elsif ( $cmd eq "counter" ) {
for( $i=0; $i<4; $i++){
$data[$i] = ord(substr($res,2*$i+1,1))*256+ord(substr($res,2*$i,1));
}
return join(" ",@data);
##=============== EEPROM ===============================
#}elsif ( $cmd eq "memory" ) {
#=============== version ===============================
}elsif ( $cmd eq "version" ) {
return $res;
##=============== LCD register ===============================
#}elsif ( $cmd eq "register" ) {
#=============== fill scratch with LCD data ===============================
#}elsif ( $cmd eq "data" ) {
}
return $res;
}
########################################################################################
#
# OWXLCD_InitializeDevice - initialize the display
#
# Parameter hash = hash of device addressed
#
########################################################################################
sub OWXLCD_InitializeDevice($) {
my ($hash) = @_;
my ($i,$data,$select, $res);
#-- ID of the device
my $owx_dev = $hash->{ROM_ID};
my $owx_rnf = substr($owx_dev,3,12);
my $owx_f = substr($owx_dev,0,2);
#-- hash of the busmaster
my $master = $hash->{IODev};
#-- 8 byte 1-Wire device address
my @owx_ROM_ID =(0,0,0,0 ,0,0,0,0);
#-- from search string to byte id
my $devs=$owx_dev;
$devs=~s/\.//g;
for($i=0;$i<8;$i++){
$owx_ROM_ID[$i]=hex(substr($devs,2*$i,2));
}
#-- supposedly we do not need to do anything with a HD44780
if( $lcdcontroller eq "HD44780"){
return undef;
#-- need some additional sequence for KS0073
}elsif ( $lcdcontroller eq "KS0073"){
#-- Function Set: 4 bit data size, RE => 0 = \x20
#OWXLCD_Byte($hash,"register",32);
#-- Entry Mode Set: cursor auto increment = \x06
#OWXLCD_Byte($hash,"register",6);
#-- Function Set: 4 bit data size, RE => 1, blink Enable = \x26
OWXLCD_Byte($hash,"register",38);
#-- Ext. Function Set: 4 line mode = \x09
OWXLCD_Byte($hash,"register",9);
#-- Function Set: 4 bit data size, RE => 0 = \x20
OWXLCD_Byte($hash,"register",32);
#-- Display ON/OFF: display on, cursor off, blink off = \x0C
OWXLCD_Byte($hash,"register",12);
#-- Clear Display
OWXLCD_Byte($hash,"register",1);
return undef;
#-- or else
} else {
return "OWXLCD: Wrong LCD controller type";
}
}
########################################################################################
#
# OWXLCD_SetFunction - write state and values of the LCD device
#
# Parameter hash = hash of device addressed
# cmd = command string
# value = data value
#
########################################################################################
sub OWXLCD_SetFunction($$$) {
my ($hash,$cmd,$value) = @_;
my ($select, $res, $res2, $res3, @data);
#-- ID of the device
my $owx_dev = $hash->{ROM_ID};
my $owx_rnf = substr($owx_dev,3,12);
my $owx_f = substr($owx_dev,0,2);
#-- hash of the busmaster
my $master = $hash->{IODev};
my ($i,$j,$k);
#-- 8 byte 1-Wire device address
my @owx_ROM_ID =(0,0,0,0 ,0,0,0,0);
#-- from search string to byte id
my $devs=$owx_dev;
$devs=~s/\.//g;
for($i=0;$i<8;$i++){
$owx_ROM_ID[$i]=hex(substr($devs,2*$i,2));
}
#-- issue the match ROM command \x55
$select=sprintf("\x55%c%c%c%c%c%c%c%c",@owx_ROM_ID);
#=============== set gpio ports ===============================
if ( $cmd eq "gpio" ) {
#-- issue the write GPIO command
# \x21 followed by the data value (= integer 0 - 7)
$select .= sprintf("\x21%c",$value);
#=============== switch LCD on ===============================
}elsif ( $cmd eq "lcdon" ) {
#-- issue the lcd on cmd
$select .= "\x03";
#=============== switch LCD off ===============================
}elsif ( $cmd eq "lcdoff" ) {
#-- issue the lcd off cmd
$select .= "\x05";
#=============== switch LCD backlight on ===============================
}elsif ( $cmd eq "bklon" ) {
#-- issue the backlight on cmd
$select .= "\x08";
#=============== switch LCD backlight off ===============================
}elsif ( $cmd eq "bkloff" ) {
#-- issue the backlight off cmd
$select .= "\x07";
#=============== switch LCD backlight off ===============================
}elsif ( $cmd eq "reset" ) {
#-- issue the clear LCD command
$select .= "\x49";
#=============== wrong write attempt ===============================
} else {
return "OWXLCD: Wrong function selected";
}
#-- write to device
OWX_Reset($master);
$res=OWX_Block($master,$select);
#-- process results
if( $res eq 0 ){
return "OWLCD: Device $owx_dev not accessible for writing";
}
return undef;
}
########################################################################################
#
# OWXLCD_SetIcon - set one of the icons
#
# Parameter hash = hash of device addressed
# icon = address of the icon used = 0,1 .. 16 (0 = all off)
# value = data value: 0 = off, 1 = on, 2 = blink
# for battery icon 16: 0 = off, 1 = empty ... 5 = full, 6 = empty blink
#
########################################################################################
sub OWXLCD_SetIcon($$$) {
my ($hash,$icon,$value) = @_;
my ($i,$data,$select, $res);
#-- ID of the device
my $owx_dev = $hash->{ROM_ID};
my $owx_rnf = substr($owx_dev,3,12);
my $owx_f = substr($owx_dev,0,2);
#-- hash of the busmaster
my $master = $hash->{IODev};
#-- 8 byte 1-Wire device address
my @owx_ROM_ID =(0,0,0,0 ,0,0,0,0);
#-- from search string to byte id
my $devs=$owx_dev;
$devs=~s/\.//g;
for($i=0;$i<8;$i++){
$owx_ROM_ID[$i]=hex(substr($devs,2*$i,2));
}
#-- only for KS0073
if ( $lcdcontroller eq "KS0073"){
#-- write 16 zeros to erase all icons
if( $icon == 0){
#-- 4 bit data size, RE => 1, blink Enable = \x26
$select = sprintf("\x55%c%c%c%c%c%c%c%c\x10\x26",@owx_ROM_ID);
OWX_Reset($master);
$res=OWX_Block($master,$select);
#-- SEGRAM addres to 0 = \x40,
$select = sprintf("\x55%c%c%c%c%c%c%c%c\x10\x40",@owx_ROM_ID);
#-- write 16 zeros to scratchpad
$select .= "\x4E\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00\x00";
OWX_Reset($master);
$res=OWX_Block($master,$select);
#-- issue the copy scratchpad to LCD command \x48
$select=sprintf("\x55%c%c%c%c%c%c%c%c\x48",@owx_ROM_ID);
OWX_Reset($master);
$res=OWX_Block($master,$select);
} else {
#-- determine data value
if( int($icon) != 16 ){
if( $value == 0 ){
$data = 0;
} elsif ( $value == 1) {
$data = 16;
} elsif ( $value == 2) {
$data = 80;
} else {
return "OWXLCD: Wrong data value $value for icon $icon";
}
} else {
if( $value == 0 ){
$data = 0;
} elsif ( $value == 1) {
$data = 16;
} elsif ( $value == 2) {
$data = 24;
} elsif ( $value == 3) {
$data = 28;
} elsif ( $value == 4) {
$data = 30;
} elsif ( $value == 5) {
$data = 31;
} elsif ( $value == 6) {
$data = 80;
} else {
return "OWXLCD: Wrong data value $value for icon $icon";
}
}
#-- 4 bit data size, RE => 1, blink Enable = \x26
$select = sprintf("\x55%c%c%c%c%c%c%c%c\x10\x26",@owx_ROM_ID);
OWX_Reset($master);
$res=OWX_Block($master,$select);
#-- SEGRAM addres to 0 = \x40 + icon address
$select = sprintf("\x55%c%c%c%c%c%c%c%c\x10%c",@owx_ROM_ID,63+$icon);
OWX_Reset($master);
$res=OWX_Block($master,$select);
#-- data
$select = sprintf("\x55%c%c%c%c%c%c%c%c\x12%c",@owx_ROM_ID,$data);
OWX_Reset($master);
$res=OWX_Block($master,$select);
}
#-- return to normal state
$select = sprintf("\x55%c%c%c%c%c%c%c%c\x10\x20",@owx_ROM_ID);
OWX_Reset($master);
$res=OWX_Block($master,$select);
#-- or else
} else {
return "OWXLCD: Wrong LCD controller type";
}
}
########################################################################################
#
# OWXLCD_SetLine - set one of the display lines
#
# Parameter hash = hash of device addressed
# line = line number (0..3)
# msg = data string to be written
#
########################################################################################
sub OWXLCD_SetLine($$$) {
my ($hash,$line,$msg) = @_;
my ($select, $res, $res2, $res3, $i, $msgA, $msgB);
$res2 = "";
$line = int($line);
$msg = defined($msg) ? $msg : "";
#-- replace umlaut chars for special codepage
$msg =~ s/ä/\x7B/g;
$msg =~ s/ö/\x7C/g;
$msg =~ s/ü/\x7E/g;
$msg =~ s/Ä/\x5B/g;
$msg =~ s/Ö/\x5C/g;
$msg =~ s/Ü/\x5E/g;
$msg =~ s/ß/\xBE/g;
#-- ID of the device
my $owx_dev = $hash->{ROM_ID};
my $owx_rnf = substr($owx_dev,3,12);
my $owx_f = substr($owx_dev,0,2);
#-- hash of the busmaster
my $master = $hash->{IODev};
#-- 8 byte 1-Wire device address
my @owx_ROM_ID =(0,0,0,0 ,0,0,0,0);
#-- from search string to byte id
my $devs=$owx_dev;
$devs=~s/\.//g;
for($i=0;$i<8;$i++){
$owx_ROM_ID[$i]=hex(substr($devs,2*$i,2));
}
#-- split if longer than 16 bytes, fill each with blanks
if( length($msg) > 16 ) {
$msgA = substr($msg,0,16);
$msgB = substr($msg,16,length($msg)-16);
for($i = 0;$i<32-length($msg);$i++){
$msgB .= "\x20";
}
} else {
$msgA = $msg;
for($i = 0;$i<16-length($msg);$i++){
$msgA .= "\x20";
}
$msgB = undef;
}
#-- issue the match ROM command \x55 and the write scratchpad command \x4E
# followed by LCD page address and the text
$select=sprintf("\x55%c%c%c%c%c%c%c%c\x4E\%c",@owx_ROM_ID,$line*32).$msgA;
OWX_Reset($master);
$res=OWX_Block($master,$select);
#-- issue the copy scratchpad to LCD command \x48
$select=sprintf("\x55%c%c%c%c%c%c%c%c\x48",@owx_ROM_ID);
OWX_Reset($master);
$res3=OWX_Block($master,$select);
#-- if second string available:
if( defined($msgB) ){
#-- issue the match ROM command \x55 and the write scratchpad command \x4E
# followed by LCD page address and the text
$select=sprintf("\x55%c%c%c%c%c%c%c%c\x4E\%c",@owx_ROM_ID,$line*32+16).$msgB;
OWX_Reset($master);
$res2=OWX_Block($master,$select);
#-- issue the copy scratchpad to LCD command \x48
$select=sprintf("\x55%c%c%c%c%c%c%c%c\x48",@owx_ROM_ID);
OWX_Reset($master);
$res3=OWX_Block($master,$select);
}
#-- process results
if( ($res eq 0) || ($res2 eq 0) ){
return "OWLCD: Device $owx_dev not accessible for writing";
}
return undef;
}
1;

821
contrib/contrib/1-Wire/21_OWTEMP.pm Normal file
View File

@ -0,0 +1,821 @@
########################################################################################
#
# OWTEMP.pm
#
# FHEM module to commmunicate with 1-Wire temperature sensors DS1820, DS18S20, DS18B20, DS1822
#
# Attention: This module works as a replacement for the standard 21_OWTEMP.pm,
# therefore may communicate with the 1-Wire File System OWFS,
# but also with the newer and more direct OWX module
#
# Prefixes for subroutines of this module:
# OW = General 1-Wire routines (Martin Fischer, Peter Henning)
# OWFS = 1-Wire file system (Martin Fischer)
# OWX = 1-Wire bus master interface (Peter Henning)
#
# Prof. Dr. Peter A. Henning, 2012
# Martin Fischer, 2011
#
# Version 1.11 - March, 2012
#
# Setup bus device in fhem.cfg as
#
# define <name> OWTEMP [<model>] <ROM_ID> [interval]
#
# where <name> may be replaced by any name string
#
# <model> is a 1-Wire device type. If omitted, we assume this to be an
# DS1820 temperature sensor
# Currently allowed values are DS1820, DS1822
# <ROM_ID> is a 12 character (6 byte) 1-Wire ROM ID
# without Family ID, e.g. A2D90D000800
# [interval] is an optional query interval in seconds
#
# get <name> id => OW_FAMILY.ROM_ID.CRC
# get <name> present => 1 if device present, 0 if not
# get <name> interval => query interval
# get <name> temperature => temperature measurement
# get <name> alarm => alarm temperature settings
#
# set <name> interval => set period for measurement
# set <name> tempLow => lower alarm temperature setting
# set <name> tempHigh => higher alarm temperature setting
#
# Additional attributes are defined in fhem.cfg
# Note: attributes "tempXXXX" are read during every update operation.
#
# attr <name> stateAL "<string>" = character string for denoting low alarm condition, default is red down triangle
# attr <name> stateAH "<string>" = character string for denoting high alarm condition, default is red up triangle
# attr <name> tempOffset <float> = temperature offset in degree Celsius added to the raw temperature reading
# attr <name> tempUnit <string> = unit of measurement, e.g. Celsius/Kelvin/Fahrenheit or C/K/F, default is Celsius
# attr <name> tempLow <float> = measurement value for low alarm
# attr <name> tempHigh <float> = measurement for high alarm
#
########################################################################################
#
# This programm 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.
#
# The GNU General Public License can be found at
# http://www.gnu.org/copyleft/gpl.html.
# A copy is found in the textfile GPL.txt and important notices to the license
# from the author is found in LICENSE.txt distributed with these scripts.
#
# This script 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.
#
########################################################################################
package main;
#-- Prototypes to make komodo happy
use vars qw{%attr %defs};
use strict;
use warnings;
sub Log($$);
#-- temperature globals - always the raw values from the device
my $owg_temp = 0;
my $owg_th = 0;
my $owg_tl = 0;
#-- variables for display strings
my $stateal;
my $stateah;
my %gets = (
"id" => "",
"present" => "",
"interval" => "",
"temperature" => "",
"alarm" => ""
);
my %sets = (
"interval" => "",
"tempHigh" => "",
"tempLow" => ""
);
my %updates = (
"present" => "",
"temperature" => "",
"alarm" => ""
);
########################################################################################
#
# The following subroutines are independent of the bus interface
#
# Prefix = OWTEMP
#
########################################################################################
#
# OWTEMP_Initialize
#
# Parameter hash = hash of device addressed
#
########################################################################################
sub OWTEMP_Initialize ($) {
my ($hash) = @_;
$hash->{DefFn} = "OWTEMP_Define";
$hash->{UndefFn} = "OWTEMP_Undef";
$hash->{GetFn} = "OWTEMP_Get";
$hash->{SetFn} = "OWTEMP_Set";
#tempOffset = a temperature offset added to the temperature reading for correction
#tempUnit = a unit of measure: C/F/K
$hash->{AttrList}= "IODev do_not_notify:0,1 showtime:0,1 loglevel:0,1,2,3,4,5 ".
"stateAL stateAH ".
"tempOffset tempUnit:C,Celsius,F,Fahrenheit,K,Kelvin ".
"tempLow tempHigh";
}
########################################################################################
#
# OWTEMP_Define - Implements DefFn function
#
# Parameter hash = hash of device addressed, def = definition string
#
########################################################################################
sub OWTEMP_Define ($$) {
my ($hash, $def) = @_;
# define <name> OWTEMP [<model>] <id> [interval]
# e.g.: define flow OWTEMP 525715020000 300
my @a = split("[ \t][ \t]*", $def);
my ($name,$model,$fam,$id,$crc,$interval,$ret);
my $tn = TimeNow();
#-- default
$name = $a[0];
$interval = 300;
$ret = "";
#-- check syntax
return "OWTEMP: Wrong syntax, must be define <name> OWTEMP [<model>] <id> [interval]"
if(int(@a) < 2 || int(@a) > 6);
#-- check if this is an old style definition, e.g. <model> is missing
my $a2 = $a[2];
my $a3 = defined($a[3]) ? $a[3] : "";
if( ($a2 eq "none") || ($a3 eq "none") ) {
return "OWTEMP: ID = none is obsolete now, please redefine";
} elsif( $a2 =~ m/^[0-9|a-f|A-F]{12}$/ ) {
$model = "DS1820";
$id = $a[2];
if(int(@a)>=4) { $interval = $a[3]; }
Log 1, "OWTEMP: Parameter [alarminterval] is obsolete now - must be set with I/O-Device"
if(int(@a) == 5);
} elsif( $a3 =~ m/^[0-9|a-f|A-F]{12}$/ ) {
$model = $a[2];
$id = $a[3];
if(int(@a)>=5) { $interval = $a[4]; }
Log 1, "OWTEMP: Parameter [alarminterval] is obsolete now - must be set with I/O-Device"
if(int(@a) == 6);
} else {
return "OWTEMP: $a[0] ID $a[2] invalid, specify a 12 digit value";
}
#-- 1-Wire ROM identifier in the form "FF.XXXXXXXXXXXX.YY"
# FF = family id follows from the model
# YY must be determined from id
if( $model eq "DS1820" ){
$fam = "10";
}elsif( $model eq "DS1822" ){
$fam = "22";
}elsif( $model eq "DS18B20" ){
$fam = "28";
}else{
return "OWTEMP: Wrong 1-Wire device model $model";
}
# determine CRC Code - only if this is a direct interface
$crc = defined($hash->{IODev}->{INTERFACE}) ? sprintf("%02x",OWX_CRC($fam.".".$id."00")) : "00";
#-- define device internals
$hash->{ALARM} = 0;
$hash->{OW_ID} = $id;
$hash->{OW_FAMILY} = $fam;
$hash->{PRESENT} = 0;
$hash->{ROM_ID} = $fam.".".$id.$crc;
$hash->{INTERVAL} = $interval;
#-- Couple to I/O device
AssignIoPort($hash);
Log 3, "OWTEMP: Warning, no 1-Wire I/O device found for $name."
if(!defined($hash->{IODev}->{NAME}));
$modules{OWTEMP}{defptr}{$id} = $hash;
$hash->{STATE} = "Defined";
Log 3, "OWTEMP: Device $name defined.";
#-- Start timer for initialization in a few seconds
InternalTimer(time()+1, "OWTEMP_InitializeDevice", $hash, 0);
#-- Start timer for updates
InternalTimer(time()+$hash->{INTERVAL}, "OWTEMP_GetValues", $hash, 0);
return undef;
}
########################################################################################
#
# OWTEMP_InitializeDevice - delayed setting of initial readings and channel names
#
# Parameter hash = hash of device addressed
#
########################################################################################
sub OWTEMP_InitializeDevice($) {
my ($hash) = @_;
my $name = $hash->{NAME};
$stateal = defined($attr{$name}{stateAL}) ? $attr{$name}{stateAL} : "<span style=\"color:red\">&#x25BE;</span>";
$stateah = defined($attr{$name}{stateAH}) ? $attr{$name}{stateAH} : "<span style=\"color:red\">&#x25B4;</span>";
#-- unit attribute defined ?
$hash->{READINGS}{"temperature"}{UNIT} = defined($attr{$name}{"tempUnit"}) ? $attr{$name}{"tempUnit"} : "Celsius";
$hash->{READINGS}{"temperature"}{TYPE} = "temperature";
#-- Initial readings temperature sensor
$owg_temp = 0.0;
$owg_tl = -15.0;
$owg_th = 70.0;
#-- Initialize all the display stuff
OWTEMP_FormatValues($hash);
}
########################################################################################
#
# OWTEMP_FormatValues - put together various format strings
#
# Parameter hash = hash of device addressed, fs = format string
#
########################################################################################
sub OWTEMP_FormatValues($) {
my ($hash) = @_;
my $name = $hash->{NAME};
my ($unit,$offset,$factor,$abbr,$vval,$vlow,$vhigh,$statef);
my ($value1,$value2,$value3) = ("","","");
my $tn = TimeNow();
#-- attributes defined ?
$unit = defined($attr{$name}{"tempUnit"}) ? $attr{$name}{"tempUnit"} : $hash->{READINGS}{"temperature"}{UNIT};
$offset = defined($attr{$name}{"tempoffset"}) ? $attr{$name}{"tempOffset"} : 0.0 ;
$factor = 1.0;
if( $unit eq "Celsius" ){
$abbr = "&deg;C";
} elsif ($unit eq "Kelvin" ){
$abbr = "K";
$offset += "273.16"
} elsif ($unit eq "Fahrenheit" ){
$abbr = "&deg;F";
$offset = ($offset+32)/1.8;
$factor = 1.8;
} else {
$abbr="?";
Log 1, "OWTEMP_FormatValues: unknown unit $unit";
}
#-- these values are rather coplex to obtain, therefore save them in the hash
$hash->{READINGS}{"temperature"}{UNIT} = $unit;
$hash->{READINGS}{"temperature"}{UNITABBR} = $abbr;
$hash->{tempf}{offset} = $offset;
$hash->{tempf}{factor} = $factor;
#-- correct values for proper offset, factor
$vval = ($owg_temp + $offset)*$factor;
#-- put into READINGS
$hash->{READINGS}{"temperature"}{VAL} = $vval;
$hash->{READINGS}{"temperature"}{TIME} = $tn;
#-- correct alarm values for proper offset, factor
$vlow = ($owg_tl + $offset)*$factor;
$vhigh = ($owg_th + $offset)*$factor;
#-- put into READINGS
$hash->{READINGS}{"tempLow"}{VAL} = $vlow;
$hash->{READINGS}{"tempLow"}{TIME} = $tn;
$hash->{READINGS}{"tempHigh"}{VAL} = $vhigh;
$hash->{READINGS}{"tempHigh"}{TIME} = $tn;
#-- formats for output
$statef = "%5.2f ".$abbr;
$value1 = "temperature: ".sprintf($statef,$vval);
$value2 = sprintf($statef,$vval);
$hash->{ALARM} = 1;
#-- Test for alarm condition
if( ($vval <= $vlow) && ( $vval >= $vhigh ) ){
$value2 .= " ".$stateal.$stateah;
$value3 .= " ".$stateal.$stateah;
}elsif( $vval <= $vlow ){
$value2 .= " ".$stateal;
$value3 .= " ".$stateal;
}elsif( $vval >= $vhigh ){
$value2 .= " ".$stateah;
$value3 .= " ".$stateah;
} else {
$hash->{ALARM} = 0;
}
#-- STATE
$hash->{STATE} = $value2;
#-- alarm
#$hash->{READINGS}{alarms}{VAL} = $value3;
#$hash->{READINGS}{alarms}{TIME} = $tn;
return $value1;
}
########################################################################################
#
# OWTEMP_Get - Implements GetFn function
#
# Parameter hash = hash of device addressed, a = argument array
#
########################################################################################
sub OWTEMP_Get($@) {
my ($hash, @a) = @_;
my $reading = $a[1];
my $name = $hash->{NAME};
my $model = $hash->{OW_MODEL};
my $value = undef;
my $ret = "";
#-- check syntax
return "OWTEMP: Get argument is missing @a"
if(int(@a) != 2);
#-- check argument
return "OWTEMP: Get with unknown argument $a[1], choose one of ".join(",", sort keys %gets)
if(!defined($gets{$a[1]}));
#-- get id
if($a[1] eq "id") {
$value = $hash->{ROM_ID};
return "$a[0] $reading => $value";
}
#-- Get other values according to interface type
my $interface= $hash->{IODev}->{TYPE};
#-- get present
if($a[1] eq "present" ) {
#-- OWX interface
if( $interface eq "OWX" ){
#-- hash of the busmaster
my $master = $hash->{IODev};
$value = OWX_Verify($master,$hash->{ROM_ID});
$hash->{PRESENT} = $value;
return "$a[0] $reading => $value";
} else {
return "OWTEMP: Verification not yet implemented for interface $interface";
}
}
#-- get interval
if($reading eq "interval") {
$value = $hash->{INTERVAL};
return "$a[0] $reading => $value";
}
#-- reset presence
$hash->{PRESENT} = 0;
#-- OWX interface
if( $interface eq "OWX" ){
#-- not different from getting all values ..
$ret = OWXTEMP_GetValues($hash);
#-- OWFS interface
}elsif( $interface eq "OWFS" ){
$ret = OWFSTEMP_GetValues($hash);
#-- Unknown interface
}else{
return "OWTEMP: Get with wrong IODev type $interface";
}
#-- process results
if( defined($ret) ){
return "OWTEMP: Could not get values from device $name, return was $ret";
}
$hash->{PRESENT} = 1;
OWTEMP_FormatValues($hash);
#-- return the special reading
if ($reading eq "temperature") {
return "OWTEMP: $name.temperature => ".
$hash->{READINGS}{"temperature"}{VAL};
} elsif ($reading eq "alarm") {
return "OWTEMP: $name.alarm => L ".$hash->{READINGS}{"tempLow"}{VAL}.
" H ".$hash->{READINGS}{"tempHigh"}{VAL};
}
return undef;
}
#######################################################################################
#
# OWTEMP_GetValues - Updates the readings from device
#
# Parameter hash = hash of device addressed
#
########################################################################################
sub OWTEMP_GetValues($@) {
my $hash = shift;
my $name = $hash->{NAME};
my $value = "";
my $ret = "";
#-- restart timer for updates
RemoveInternalTimer($hash);
InternalTimer(time()+$hash->{INTERVAL}, "OWTEMP_GetValues", $hash, 1);
#-- reset presence
$hash->{PRESENT} = 0;
#-- Get values according to interface type
my $interface= $hash->{IODev}->{TYPE};
if( $interface eq "OWX" ){
$ret = OWXTEMP_GetValues($hash);
}elsif( $interface eq "OWFS" ){
$ret = OWFSTEMP_GetValues($hash);
}else{
return "OWTEMP: GetValues with wrong IODev type $interface";
}
#-- process results
if( defined($ret) ){
return "OWTEMP: Could not get values from device $name";
}
$hash->{PRESENT} = 1;
$value=OWTEMP_FormatValues($hash);
#--logging
Log 5, $value;
$hash->{CHANGED}[0] = $value;
DoTrigger($name, undef);
return undef;
}
#######################################################################################
#
# OWTEMP_Set - Set one value for device
#
# Parameter hash = hash of device addressed
# a = argument string
#
########################################################################################
sub OWTEMP_Set($@) {
my ($hash, @a) = @_;
#-- for the selector: which values are possible
return join(" ", sort keys %sets) if(@a == 2);
#-- check syntax
return "OWTEMP: Set needs one parameter"
if(int(@a) != 3);
#-- check argument
return "OWTEMP: Set with unknown argument $a[1], choose one of ".join(",", sort keys %sets)
if(!defined($sets{$a[1]}));
#-- define vars
my $key = $a[1];
my $value = $a[2];
my $ret = undef;
my $name = $hash->{NAME};
my $model = $hash->{OW_MODEL};
#-- set new timer interval
if($key eq "interval") {
# check value
return "OWTEMP: Set with short interval, must be > 1"
if(int($value) < 1);
# update timer
$hash->{INTERVAL} = $value;
RemoveInternalTimer($hash);
InternalTimer(gettimeofday()+$hash->{INTERVAL}, "OWTEMP_GetValues", $hash, 1);
return undef;
}
#-- set other values depending on interface type
my $interface = $hash->{IODev}->{TYPE};
my $offset = $hash->{tempf}{offset};
my $factor = $hash->{tempf}{factor};
#-- find upper and lower boundaries for given offset/factor
my $mmin = (-55+$offset)*$factor;
my $mmax = (125+$offset)*$factor;
return sprintf("OWTEMP: Set with wrong value $value for $key, range is [%3.1f,%3.1f]",$mmin,$mmax)
if($value < $mmin || $value > $mmax);
#-- seems to be ok, put into the device
$a[2] = int($value/$factor-$offset);
#-- OWX interface
if( $interface eq "OWX" ){
$ret = OWXTEMP_SetValues($hash,@a);
return $ret
if(defined($ret));
#-- OWFS interface
}elsif( $interface eq "OWFS" ){
$ret = OWFSTEMP_SetValues($hash,@a);
return $ret
if(defined($ret));
} else {
return "OWTEMP: Set with wrong IODev type $interface";
}
OWTEMP_FormatValues($hash);
Log 4, "OWTEMP: Set $hash->{NAME} $key $value";
return undef;
}
########################################################################################
#
# OWTEMP_Undef - Implements UndefFn function
#
# Parameter hash = hash of device addressed
#
########################################################################################
sub OWTEMP_Undef ($) {
my ($hash) = @_;
delete($modules{OWTEMP}{defptr}{$hash->{OW_ID}});
RemoveInternalTimer($hash);
return undef;
}
########################################################################################
#
# The following subroutines in alphabetical order are only for a 1-Wire bus connected
# via OWFS
#
# Prefix = OWFSTEMP
#
########################################################################################
#
# OWFSTEMP_GetValues - Get reading from one device
#
# Parameter hash = hash of device addressed
#
########################################################################################
sub OWFSTEMP_GetValues($)
{
my ($hash) = @_;
my $ret = OW::get("/uncached/".$hash->{OW_FAMILY}.".".$hash->{OW_ID}."/temperature");
if( defined($ret) ) {
$hash->{PRESENT} = 1;
$owg_temp = $ret;
$owg_th = OW::get("/uncached/".$hash->{OW_FAMILY}.".".$hash->{OW_ID}."/temphigh");
$owg_tl = OW::get("/uncached/".$hash->{OW_FAMILY}.".".$hash->{OW_ID}."/templow");
} else {
$hash->{PRESENT} = 0;
$owg_temp = 0.0;
$owg_th = 0.0;
$owg_tl = 0.0;
}
return undef;
}
#######################################################################################
#
# OWFSTEMP_SetValues - Implements SetFn function
#
# Parameter hash = hash of device addressed
# a = argument array
#
########################################################################################
sub OWFSTEMP_SetValues($@) {
my ($hash, @a) = @_;
#-- define vars
my $key = lc($a[1]);
my $value = $a[2];
return OW::put($hash->{OW_FAMILY}.".".$hash->{OW_ID}."/$key",$value);
}
########################################################################################
#
# The following subroutines in alphabetical order are only for a 1-Wire bus connected
# directly to the FHEM server
#
# Prefix = OWXTEMP
#
########################################################################################
#
# OWXTEMP_GetValues - Get reading from one device
#
# Parameter hash = hash of device addressed
#
########################################################################################
sub OWXTEMP_GetValues($) {
my ($hash) = @_;
#-- For default, perform the conversion NOT now
my $con=1;
#-- ID of the device
my $owx_dev = $hash->{ROM_ID};
my $owx_rnf = substr($owx_dev,3,12);
my $owx_f = substr($owx_dev,0,2);
#-- hash of the busmaster
my $master = $hash->{IODev};
my ($i,$j,$k);
#-- 8 byte 1-Wire device address
my @owx_ROM_ID =(0,0,0,0 ,0,0,0,0);
#-- from search string to byte id
my $devs=$owx_dev;
$devs=~s/\.//g;
for($i=0;$i<8;$i++){
$owx_ROM_ID[$i]=hex(substr($devs,2*$i,2));
}
#-- check, if the conversion has been called before - only on devices with real power
if( defined($attr{$hash->{IODev}->{NAME}}{buspower}) && ( $attr{$hash->{IODev}->{NAME}}{buspower} eq "real") ){
$con=0;
}
#-- if the conversion has not been called before
if( $con==1 ){
OWX_Reset($master);
#-- issue the match ROM command \x55 and the start conversion command
my $select=sprintf("\x55%c%c%c%c%c%c%c%c\x44",@owx_ROM_ID);
if( OWX_Block($master,$select) eq 0 ){
return "OWXTEMP: Device $owx_dev not accessible";
}
#-- conversion needs some 950 ms - but we may also do it in shorter time !
select(undef,undef,undef,1.0);
}
#-- NOW ask the specific device
OWX_Reset($master);
#-- issue the match ROM command \x55 and the read scratchpad command \xBE
my $select=sprintf("\x55%c%c%c%c%c%c%c%c\xBE\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF\xFF",
@owx_ROM_ID);
my $res=OWX_Block($master,$select);
#-- process results
if( $res eq 0 ){
return "OWXTEMP: Device $owx_dev not accessible in 2nd step";
}
#my $res2 = "====> OWXTEMP Received ";
#for(my $i=0;$i<19;$i++){
# my $j=int(ord(substr($res,$i,1))/16);
# my $k=ord(substr($res,$i,1))%16;
# $res2.=sprintf "0x%1x%1x ",$j,$k;
#}
#Log 1, $res2;
#-- process results
my @data=split(//,$res);
#-- this must be different for the different device types
# family = 10 => DS1820, DS18S20
if( $hash->{OW_FAMILY} eq "10" ) {
if ( (@data == 19) && (ord($data[17])>0) ){
my $count_remain = ord($data[16]);
my $count_perc = ord($data[17]);
my $delta = -0.25 + ($count_perc - $count_remain)/$count_perc;
my $lsb = ord($data[10]);
my $msb = 0;
my $sign = ord($data[11]) & 255;
#-- 2's complement form = signed bytes
if( $sign == 0 ){
$owg_temp = int($lsb/2) + $delta;
} else {
$owg_temp = 128-(int($lsb/2) + $delta);
}
$owg_th = ord($data[12]) > 127 ? 128-ord($data[12]) : ord($data[12]);
$owg_tl = ord($data[13]) > 127 ? 128-ord($data[13]) : ord($data[13]);
return undef;
} else {
return "OWXTEMP: Device $owx_dev returns invalid data";
}
} elsif ( ($hash->{OW_FAMILY} eq "22") || ($hash->{OW_FAMILY} eq "28") ) {
if ( (@data == 19) && (ord($data[17])>0) ){
my $lsb = ord($data[10]);
my $msb = ord($data[11]) & 7;
my $sign = ord($data[11]) & 248;
#-- 2's complement form = signed bytes
$owg_temp = $msb*16+ $lsb/16;
if( $sign !=0 ){
$owg_temp = 128-$owg_temp;
}
$owg_th = ord($data[12]) > 127 ? 128-ord($data[12]) : ord($data[12]);
$owg_tl = ord($data[13]) > 127 ? 128-ord($data[13]) : ord($data[13]);
return undef;
} else {
return "OWXTEMP: Device $owx_dev returns invalid data";
}
} else {
return "OWXTEMP: Unknown device family $hash->{OW_FAMILY}\n";
}
}
#######################################################################################
#
# OWXTEMP_SetValues - Implements SetFn function
#
# Parameter hash = hash of device addressed
# a = argument array
#
########################################################################################
sub OWXTEMP_SetValues($@) {
my ($hash, @a) = @_;
my $name = $hash->{NAME};
#-- ID of the device
my $owx_dev = $hash->{ROM_ID};
my $owx_rnf = substr($owx_dev,3,12);
my $owx_f = substr($owx_dev,0,2);
#-- hash of the busmaster
my $master = $hash->{IODev};
my ($i,$j,$k);
#-- 8 byte 1-Wire device address
my @owx_ROM_ID =(0,0,0,0 ,0,0,0,0);
#-- from search string to byte id
my $devs=$owx_dev;
$devs=~s/\.//g;
for($i=0;$i<8;$i++){
$owx_ROM_ID[$i]=hex(substr($devs,2*$i,2));
}
#-- define vars
my $key = $a[1];
my $value = $a[2];
$owg_tl = $value if( $key eq "tempLow" );
$owg_th = $value if( $key eq "tempHigh" );
#-- put into 2's complement formed (signed byte)
my $tlp = $owg_tl < 0 ? 128 - $owg_tl : $owg_tl;
my $thp = $owg_th < 0 ? 128 - $owg_th : $owg_th;
OWX_Reset($master);
#-- issue the match ROM command \x55 and the write scratchpad command \x4E,
# followed by the write EEPROM command \x48
#
# so far writing the EEPROM does not work properly.
# 1. \x48 directly appended to the write scratchpad command => command ok, no effect on EEPROM
# 2. \x48 appended to match ROM => command not ok.
# 3. \x48 sent by WriteBytePower after match ROM => command ok, no effect on EEPROM
my $select=sprintf("\x55%c%c%c%c%c%c%c%c\x4E%c%c\x48",@owx_ROM_ID,$thp,$tlp);
my $res=OWX_Block($master,$select);
if( $res eq 0 ){
return "OWXTEMP: Device $owx_dev not accessible";
}
#-- issue the match ROM command \x55 and the copy scratchpad command \x48
#$select=sprintf("\x55%c%c%c%c%c%c%c%c",@owx_ROM_ID);
#$res=OWX_Block($hash,$select);
#$res=OWX_WriteBytePower($hash,"\x48");
#if( $res eq 0 ){
# Log 3, "OWXTEMP_SetTemp: Device $romid not accessible in the second step";
# return 0;
#}
DoTrigger($name, undef) if($init_done);
return undef;
}
1;

BIN
contrib/contrib/1-Wire/Schaltplan_Aktives_1-Wire_Interface.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 19 KiB

BIN
contrib/contrib/1-Wire/Schaltplan_Passives_1-Wire_Interface.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 28 KiB

BIN
contrib/contrib/1-Wire/Schaltplan_USB_1-Wire_Interface.png Normal file
View File

Binary file not shown.
Side by Side

After

Width:  |  Height:  |  Size: 40 KiB

247
contrib/contrib/11_FHT8V.pm Executable file
View File

@ -0,0 +1,247 @@
#############################################
package main;
use strict;
use warnings;
use vars qw(%fht8v_c2b); # would Peter like to access it from outside too? ;-)
# defptr{XMIT BTN}{DEVNAME} -> Ptr to global defs entry for this device
my %defptr;
# my %follow;
sub
FHT8V_Initialize($)
{
my ($hash) = @_;
# $hash->{Match} = "^([0-9]{2}:2[0-9A-F]{3} )*([0-9]{2}:2[0-9A-F]{3})\$";
$hash->{SetFn} = "FHT8V_Set";
$hash->{DefFn} = "FHT8V_Define";
$hash->{UndefFn} = "FHT8V_Undef";
$hash->{AttrList} = "IODev do_not_notify:1,0 dummy:1,0 showtime:1,0 loglevel:0,1,2,3,4,5,6";
}
###################################
sub FHT8V_valve_position(@)
{
my ($hash, @a) = @_;
my $na = int(@a);
my $v;
my $arg2_percent=0;
if ( $na > 3 ) {
$arg2_percent=$a[3] eq "%";
}
if ( $a[2] =~ m/^[0-9]{1,3}%$/ || $a[2] =~ m/^[0-9]{1,3}$/ && $arg2_percent ) {
my $num;
if ( $arg2_percent ) {
$num=$a[2];
} else {
$num=substr($a[2],0,-1);
}
return "Out of range." if ( $num > 100 || $num < 0 );
$num=255 if ( $num == 100 );
$v=sprintf("%.0f",2.56*$num);
} else {
return "Argument hast invalid value \"$a[2]\"." if ( $a[2] !~ m/^[0-9]{1,3}$/ );
return "Out of range. Range: 0..255." if ( $a[2] > 255 || $a[2] < 0 );
$v = $a[2];
}
Log GetLogLevel($a[2],2), "FHT8V $a[0]: v: $v";
IOWrite($hash, "", sprintf("T".$hash->{XMIT}."%02X26%02X",$hash->{NO}, $v)) # CUL hack
if($hash->{IODev} && $hash->{IODev}->{TYPE} eq "CUL");
$hash->{STATE}=sprintf("%d%%", $v*0.390625);
return undef;
}
sub FHT8V_beep(@)
{
my ($hash, @a) = @_;
IOWrite($hash, "", sprintf("T".$hash->{XMIT}."%02X2E00",$hash->{NO})) # CUL hack
if($hash->{IODev} && $hash->{IODev}->{TYPE} eq "CUL");
$hash->{STATE}="beep";
return undef;
}
sub FHT8V_open(@)
{
my ($hash, @a) = @_;
IOWrite($hash, "", sprintf("T".$hash->{XMIT}."%02X2100",$hash->{NO})) # CUL hack
if($hash->{IODev} && $hash->{IODev}->{TYPE} eq "CUL");
$hash->{STATE}="open";
return undef;
}
sub FHT8V_off(@)
{
my ($hash, @a) = @_;
IOWrite($hash, "", sprintf("T".$hash->{XMIT}."%02X2000",$hash->{NO})) # CUL hack
if($hash->{IODev} && $hash->{IODev}->{TYPE} eq "CUL");
$hash->{STATE}="off";
return undef;
}
sub FHT8V_close(@)
{
my ($hash, @a) = @_;
IOWrite($hash, "", sprintf("T".$hash->{XMIT}."%02X2200",$hash->{NO})) # CUL hack
if($hash->{IODev} && $hash->{IODev}->{TYPE} eq "CUL");
$hash->{STATE}="close";
return undef;
}
sub
FHT8V_assign(@)
{
my ($hash, @a) = @_;
my $na = int(@a);
my $v = 0;
if ( $na > 2 ) {
return "Parameter \"".$a[3]."\" defining offset must be numerical." if ( $a[3] !~ /[0-9]+/ );
$v=int($a[3]);
}
IOWrite($hash, "", sprintf("T".$hash->{XMIT}."%02X2F%02X",$hash->{NO},$v)) # CUL hack
if($hash->{IODev} && $hash->{IODev}->{TYPE} eq "CUL");
# not sure if this is nessesary but I saw it in the documentation...
IOWrite($hash, "", sprintf("T".$hash->{XMIT}."%02X2600",$hash->{NO},$v)) # CUL hack
if($hash->{IODev} && $hash->{IODev}->{TYPE} eq "CUL");
$hash->{STATE}="assigning";
return undef;
}
sub
FHT8V_Set($@)
{
my ($hash, @a) = @_;
my $na = int(@a);
return "Parameter missing" if ( $na < 2 );
if ( $_[2] eq "valve" ) {
return FHT8V_valve_position(@_);
}
if ( $_[2] eq "open" ) {
return FHT8V_open(@_);
}
if ( $_[2] eq "close" ) {
return FHT8V_close(@_);
}
if ( $_[2] eq "beep" ) {
return FHT8V_beep(@_);
}
if ( $_[2] eq "assign" ) {
return FHT8V_assign(@_);
}
if ( $_[2] eq "off" ) {
return FHT8V_off(@_);
}
return "Could not set undefined parameter \"".$_[2]."\".";
}
#############################
sub
FHT8V_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $na = int(@a);
my $u = "wrong syntax: define <name> FHT8V housecode " .
"addr";
return $u if( $na < 3 );
return "Define $a[0]: wrong housecode format: specify a 4 digit hex value ".
"or an 8 digit quad value"
if( ($a[2] !~ m/^[a-f0-9]{4}$/i) && ($a[2] !~ m/^[1-4]{8}$/i) );
if ( $na > 3 ) {
return "Define $a[0]: wrong valve address format: specify a 2 digit hex value " .
"or a 4 digit quad value"
if( ($a[3] !~ m/^[a-f0-9]{2}$/i) && ($a[3] !~ m/^[1-4]{4}$/i) );
}
my $housecode = $a[2];
$housecode = four2hex($housecode,4) if (length($housecode) == 8);
my $valve_number = 1;
if ( $na > 3 ) {
my $valve_number = $a[3];
$valve_number = four2hex($valve_number,2) if (length($valve_number) == 4);
}
$hash->{XMIT} = lc($housecode);
$hash->{NO} = lc($valve_number);
my $code = "$housecode $valve_number";
my $ncode = 1;
my $name = $a[0];
$hash->{CODE}{$ncode++} = $code;
$defptr{$code}{$name} = $hash;
for(my $i = 4; $i < int(@a); $i += 2) {
return "No address specified for $a[$i]" if($i == int(@a)-1);
$a[$i] = lc($a[$i]);
if($a[$i] eq "fg") {
return "Bad fg address for $name, see the doc"
if( ($a[$i+1] !~ m/^f[a-f0-9]$/) && ($a[$i+1] !~ m/^44[1-4][1-4]$/));
} elsif($a[$i] eq "lm") {
return "Bad lm address for $name, see the doc"
if( ($a[$i+1] !~ m/^[a-f0-9]f$/) && ($a[$i+1] !~ m/^[1-4][1-4]44$/));
} elsif($a[$i] eq "gm") {
return "Bad gm address for $name, must be ff"
if( ($a[$i+1] ne "ff") && ($a[$i+1] ne "4444"));
} else {
return $u;
}
my $grpcode = $a[$i+1];
if (length($grpcode) == 4) {
$grpcode = four2hex($grpcode,2);
}
$code = "$housecode $grpcode";
$hash->{CODE}{$ncode++} = $code;
$defptr{$code}{$name} = $hash;
}
$hash->{TYPE}="FHT8V";
AssignIoPort($hash);
}
#############################
sub
FHT8V_Undef($$)
{
my ($hash, $name) = @_;
foreach my $c (keys %{ $hash->{CODE} } ) {
$c = $hash->{CODE}{$c};
# As after a rename the $name my be different from the $defptr{$c}{$n}
# we look for the hash.
foreach my $dname (keys %{ $defptr{$c} }) {
delete($defptr{$c}{$dname}) if($defptr{$c}{$dname} == $hash);
}
}
return undef;
}
1;

531
contrib/contrib/21_OWTEMP.pm.fork Normal file
View File

@ -0,0 +1,531 @@
################################################################
#
# Copyright notice
#
# (c) 2009 Copyright: Martin Fischer (m_fischer at gmx dot de)
# All rights reserved
#
# This script 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.
#
# The GNU General Public License can be found at
# http://www.gnu.org/copyleft/gpl.html.
# A copy is found in the textfile GPL.txt and important notices to the license
# from the author is found in LICENSE.txt distributed with these scripts.
#
# This script 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.
#
################################################################
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
use OW;
my %gets = (
"address" => "",
"alias" => "",
"crc8" => "",
"family" => "10",
"id" => "",
"locator" => "",
"power" => "",
"present" => "",
# "r_address" => "",
# "r_id" => "",
# "r_locator" => "",
"temperature" => "",
"temphigh" => "",
"templow" => "",
"type" => "",
);
my %sets = (
"alias" => "",
"temphigh" => "",
"templow" => "",
"interval" => "",
"alarminterval" => "",
);
my %updates = (
"present" => "",
"temperature" => "",
"templow" => "",
"temphigh" => "",
);
my %dummy = (
"crc8" => "4D",
"alias" => "dummy",
"locator" => "FFFFFFFFFFFFFFFF",
"power" => "0",
"present" => "1",
"temphigh" => "75",
"templow" => "10",
"type" => "DS18S20",
"warnings" => "none",
);
#####################################
sub
OWTEMP_Initialize($)
{
my ($hash) = @_;
$hash->{DefFn} = "OWTEMP_Define";
$hash->{UndefFn} = "OWTEMP_Undef";
$hash->{GetFn} = "OWTEMP_Get";
$hash->{SetFn} = "OWTEMP_Set";
$hash->{AttrList}= "IODev do_not_notify:0,1 showtime:0,1 model:DS18S20 loglevel:0,1,2,3,4,5";
}
#####################################
sub
OWTEMP_UpdateReading($$$$)
{
my ($hash,$reading,$now,$value) = @_;
# define vars
my $temp;
# exit if empty value
return 0
if(!defined($value) || $value eq "");
# trim value
$value =~ s/\s//g
if($reading ne "warnings");
if($reading eq "temperature") {
$value = sprintf("%.4f",$value);
$temp = $value;
$value = $value . " (".$hash->{OW_SCALE}.")";
}
# update readings
$hash->{READINGS}{$reading}{TIME} = $now;
$hash->{READINGS}{$reading}{VAL} = $value;
Log 4, "OWTEMP $hash->{NAME} $reading: $value";
return $value;
}
#####################################
sub
OWTEMP_GetUpdate($$)
{
my ($hash, $a) = @_;
# define vars
my $name = $hash->{NAME};
my $now = TimeNow();
my $value = "";
my $temp = "";
my $ret = "";
my $count = 0;
# define warnings
my $warn = "none";
$hash->{ALARM} = "0";
# check for real sensor
if($hash->{OW_ID} ne "none") {
# real sensor
if(!$hash->{LOCAL} || $a eq "") {
#####################
# OW::Get is too slow: do it in the background by fork. After receiving
# the data from the OW module, the child contacts the parent, and calls
# "set <NAME> childupdate <data>", which in turn will call this function
# again with a filled CHILDDATA
if(!$hash->{CHILDDATA}) {
if($hash->{CHILDPID}) {
Log 2, "OWTEMP: Child already forked: timeout too short?";
return;
}
return if(($hash->{CHILDPID} = fork));
my @ret;
foreach my $r (sort keys %updates) {
my $ret = OW::get("/uncached/".$hash->{OW_PATH}."/".$r);
$ret = "" if(!defined($ret));
push(@ret, $ret);
last if($ret eq "");
}
my @port = split(" ", $attr{global}{port});
my $server = IO::Socket::INET->new(PeerAddr => "localhost:$port[0]");
Log 0, "OWTEMP: Can't connect to parent\n" if(!$server);
syswrite($server, "set $hash->{NAME} childupdate ".join(":",@ret)."\n");
exit(0);
} else {
#####################
# Digest the data sent by the CHILD.
my @ret = split(":", $hash->{CHILDDATA});
delete($hash->{CHILDPID});
delete($hash->{CHILDDATA});
foreach my $r (sort keys %updates) {
$ret = shift(@ret);
if($ret eq "") {
#
$hash->{PRESENT} = "0";
$r = "present";
$value = "0";
$ret = OWTEMP_UpdateReading($hash,$r,$now,$value);
$hash->{CHANGED}[$count] = "present: ".$value
} else {
$hash->{PRESENT} = "1";
$value = $ret;
if($r eq "temperature") {
$temp = sprintf("%.4f",$value);
$temp =~ s/\s//g;
}
$ret = OWTEMP_UpdateReading($hash,$r,$now,$value);
}
last if($hash->{PRESENT} eq "0");
}
}
} else {
$ret = "";
$ret = OW::get("/uncached/".$hash->{OW_PATH}."/".$a);
if(!defined($ret)) {
$hash->{PRESENT} = "0";
$a = "present";
$value = "0";
$ret = OWTEMP_UpdateReading($hash,$a,$now,$value);
} else {
$hash->{PRESENT} = "1";
$value = $ret;
if($a eq "temperature") {
$temp = sprintf("%.4f",$value);
$temp =~ s/\s//g;
$value = $temp;
}
$ret = OWTEMP_UpdateReading($hash,$a,$now,$value);
}
}
} else {
# dummy sensor
$temp = sprintf("%.4f",rand(85));
$dummy{temperature} = $temp;
$dummy{present} = "1";
$hash->{PRESENT} = $dummy{present};
if(!$hash->{LOCAL} || $a eq "") {
foreach my $r (sort keys %updates) {
$ret = OWTEMP_UpdateReading($hash,$r,$now,$dummy{$r});
}
} else {
$ret = "";
$ret = $dummy{$a};
if($ret ne "") {
$value = $ret;
if($a eq "temperature") {
$temp = sprintf("%.4f",$value);
$temp =~ s/\s//g;
}
$ret = OWTEMP_UpdateReading($hash,$a,$now,$value);
}
}
}
return 1
if($hash->{LOCAL} && $a eq "" && $hash->{PRESENT} eq "0");
# check for warnings
my $templow = $hash->{READINGS}{templow}{VAL};
my $temphigh = $hash->{READINGS}{temphigh}{VAL};
if($hash->{PRESENT} eq "1") {
if($temp <= $templow) {
# low temperature
$hash->{ALARM} = "1";
$warn = "templow";
} elsif($temp >= $temphigh) {
# high temperature
$hash->{ALARM} = "1";
$warn = "temphigh";
}
} else {
# set old state
$temp = $hash->{READINGS}{temperature}{VAL};
($temp,undef) = split(" ",$temp);
# sensor is missing
$hash->{ALARM} = "1";
$warn = "not present";
}
if(!$hash->{LOCAL} || $a eq "") {
$ret = OWTEMP_UpdateReading($hash,"warnings",$now,$warn);
}
$hash->{STATE} = "T: ".$temp." ".
"L: ".$templow." ".
"H: ".$temphigh." ".
"P: ".$hash->{PRESENT}." ".
"A: ".$hash->{ALARM}." ".
"W: ".$warn;
# inform changes
# state
$hash->{CHANGED}[$count++] = $hash->{STATE};
# present
$hash->{CHANGED}[$count++] = "present: ".$hash->{PRESENT}
if(defined($hash->{PRESENT}) && $hash->{PRESENT} ne "");
# temperature
$hash->{CHANGED}[$count++] = "temperature: ".$temp." (".$hash->{OW_SCALE}.")"
if(defined($temp) && $temp ne "");
# temperature raw
$hash->{CHANGED}[$count++] = "tempraw: ".$temp
if(defined($temp) && $temp ne "");
# low temperature
$hash->{CHANGED}[$count++] = "templow: ".$templow
if(defined($templow) && $templow ne "");
# high temperature
$hash->{CHANGED}[$count++] = "temphigh: ".$temphigh
if(defined($temphigh) && $temphigh ne "");
# warnings
$hash->{CHANGED}[$count++] = "warnings: ".$warn
if(defined($warn) && $warn ne "");
if(!$hash->{LOCAL}) {
# update timer
RemoveInternalTimer($hash);
# check alarm
if($hash->{ALARM} eq "0") {
$hash->{INTERVAL} = $hash->{INTV_CHECK};
} else {
$hash->{INTERVAL} = $hash->{INTV_ALARM};
}
InternalTimer(gettimeofday()+$hash->{INTERVAL}, "OWTEMP_GetUpdate", $hash, 1);
} else {
return $value;
}
if(!$hash->{LOCAL}) {
DoTrigger($name, undef) if($init_done);
}
return $hash->{STATE};
}
#####################################
sub
OWTEMP_Get($@)
{
my ($hash, @a) = @_;
# check syntax
return "argument is missing @a"
if(int(@a) != 2);
# check argument
return "Unknown argument $a[1], choose one of ".join(",", sort keys %gets)
if(!defined($gets{$a[1]}));
# define vars
my $value;
# get value
$hash->{LOCAL} = 1;
$value = OWTEMP_GetUpdate($hash,$a[1]);
delete $hash->{LOCAL};
my $reading = $a[1];
if(defined($hash->{READINGS}{$reading})) {
$value = $hash->{READINGS}{$reading}{VAL};
}
return "$a[0] $reading => $value";
}
#####################################
sub
OWTEMP_Set($@)
{
my ($hash, @a) = @_;
# check syntax
return "set needs one parameter"
if(int(@a) != 3);
# check arguments
return "Unknown argument $a[1], choose one of ".join(",", sort keys %sets)
if(!defined($sets{$a[1]}) && $a[1] ne "childupdate");
# define vars
my $key = $a[1];
my $value = $a[2];
my $ret;
if($key eq "childupdate") {
$hash->{CHILDDATA} = $value;
OWTEMP_GetUpdate($hash,undef);
return undef;
}
# set new timer
if($key eq "interval" || $key eq "alarminterval") {
$key = "INTV_CHECK"
if($key eq "interval");
$key = "INTV_ALARM"
if($key eq "alarminterval");
# update timer
$hash->{$key} = $value;
RemoveInternalTimer($hash);
# check alarm
if($hash->{ALARM} eq "0") {
$hash->{INTERVAL} = $hash->{INTV_CHECK};
} else {
$hash->{INTERVAL} = $hash->{INTV_ALARM};
}
InternalTimer(gettimeofday()+$hash->{INTERVAL}, "OWTEMP_GetUpdate", $hash, 1);
}
# set warnings
if($key eq "templow" || $key eq "temphigh") {
# check range
return "wrong value: range -55°C - 125°C"
if(int($value) < -55 || int($value) > 125);
}
# set value
Log 4, "OWTEMP set $hash->{NAME} $key $value";
# check for real sensor
if($hash->{OW_ID} ne "none") {
# real senson
$ret = OW::put($hash->{OW_PATH}."/$key",$value);
} else {
# dummy sensor
$dummy{$key} = $value;
}
# update readings
if($key ne "interval" || $key ne "alarminterval") {
$hash->{LOCAL} = 1;
$ret = OWTEMP_GetUpdate($hash,$key);
delete $hash->{LOCAL};
}
return undef;
}
#####################################
sub
OWTEMP_Define($$)
{
my ($hash, $def) = @_;
# define <name> OWTEMP <id> [interval] [alarminterval]
# e.g.: define flow OWTEMP 332670010800 300
my @a = split("[ \t][ \t]*", $def);
# check syntax
return "wrong syntax: define <name> OWTEMP <id> [interval] [alarminterval]"
if(int(@a) < 2 && int(@a) > 5);
# check ID format
return "Define $a[0]: missing ID or wrong ID format: specify a 12 digit value or set it to none for demo mode"
if(lc($a[2]) ne "none" && lc($a[2]) !~ m/^[0-9|a-f]{12}$/);
# define vars
my $name = $a[0];
my $id = $a[2];
my $interval = 300;
my $alarminterval = 300;
my $scale = "";
my $ret = "";
# overwrite default intervals if set by define
if(int(@a)==4) { $interval = $a[3]; }
if(int(@a)==5) { $interval = $a[3]; $alarminterval = $a[4] }
# define device internals
$hash->{ALARM} = 0;
$hash->{INTERVAL} = $interval;
$hash->{INTV_CHECK} = $interval;
$hash->{INTV_ALARM} = $alarminterval;
$hash->{OW_ID} = $id;
$hash->{OW_FAMILY} = $gets{family};
$hash->{OW_PATH} = $hash->{OW_FAMILY}.".".$hash->{OW_ID};
$hash->{PRESENT} = 0;
$modules{OWTEMP}{defptr}{$a[2]} = $hash;
# assign IO port
AssignIoPort($hash);
return "No I/O device found. Please define a OWFS device first."
if(!defined($hash->{IODev}->{NAME}));
# get scale from I/O device
$scale = $attr{$hash->{IODev}->{NAME}}{"temp-scale"};
# define scale for temperature values
$scale = "Celsius" if ($scale eq "C");
$scale = "Fahrenheit" if ($scale eq "F");
$scale = "Kelvin" if ($scale eq "K");
$scale = "Rankine" if ($scale eq "R");
$hash->{OW_SCALE} = $scale;
$hash->{STATE} = "Defined";
# define dummy values for testing
if($hash->{OW_ID} eq "none") {
my $now = TimeNow();
$dummy{address} = $hash->{OW_FAMILY}.$hash->{OW_ID}.$dummy{crc8};
$dummy{family} = $hash->{OW_FAMILY};
$dummy{id} = $hash->{OW_ID};
$dummy{temperature} = "80.0000 (".$hash->{OW_SCALE}.")";
foreach my $r (sort keys %gets) {
$hash->{READINGS}{$r}{TIME} = $now;
$hash->{READINGS}{$r}{VAL} = $dummy{$r};
Log 4, "OWTEMP $hash->{NAME} $r: ".$dummy{$r};
}
}
$hash->{STATE} = "Initialized";
# initalize
$hash->{LOCAL} = 1;
$ret = OWTEMP_GetUpdate($hash,"");
delete $hash->{LOCAL};
# exit if sensor is not present
return "Define $hash->{NAME}: Sensor is not reachable. Check first your 1-wire connection."
if(defined($ret) && $ret eq 1);
if(!$hash->{LOCAL}) {
if($hash->{ALARM} eq "0") {
$hash->{INTERVAL} = $hash->{INTV_CHECK};
} else {
$hash->{INTERVAL} = $hash->{INTV_ALARM};
}
InternalTimer(gettimeofday()+$hash->{INTERVAL}, "OWTEMP_GetUpdate", $hash, 0);
}
return undef;
}
#####################################
sub
OWTEMP_Undef($$)
{
my ($hash, $name) = @_;
delete($modules{OWTEMP}{defptr}{$hash->{NAME}});
RemoveInternalTimer($hash);
return undef;
}
1;

160
contrib/contrib/64_ESA.pm Normal file
View File

@ -0,0 +1,160 @@
##############################################
# (c) by STefan Mayer (stefan(at)clumsy.ch) #
# #
# please feel free to contact me for any #
# changes, improvments, suggestions, etc #
# #
##############################################
package main;
use strict;
use warnings;
my %codes = (
"19fa" => "ESA2000_LED",
);
#####################################
sub
ESA_Initialize($)
{
my ($hash) = @_;
# S0119FA011E00007D6E003100000007C9 ESA2000_LED
$hash->{Match} = "^S................................\$";
$hash->{DefFn} = "ESA_Define";
$hash->{UndefFn} = "ESA_Undef";
$hash->{ParseFn} = "ESA_Parse";
$hash->{AttrList} = "IODev do_not_notify:0,1 showtime:0,1 model:esa2000-led loglevel:0,1,2,3,4,5,6 ignore:0,1";
}
#####################################
sub
ESA_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "wrong syntax: define <name> ESA CODE" if(int(@a) != 3);
$a[2] = lc($a[2]);
return "Define $a[0]: wrong CODE format: specify a 4 digit hex value"
if($a[2] !~ m/^[a-f0-9][a-f0-9][a-f0-9][a-f0-9]$/);
$hash->{CODE} = $a[2];
$modules{ESA}{defptr}{$a[2]} = $hash;
AssignIoPort($hash);
return undef;
}
#####################################
sub
ESA_Undef($$)
{
my ($hash, $name) = @_;
delete($modules{ESA}{defptr}{$hash->{CODE}})
if(defined($hash->{CODE}) &&
defined($modules{ESA}{defptr}{$hash->{CODE}}));
return undef;
}
#####################################
sub
ESA_Parse($$)
{
my ($hash, $msg) = @_;
# 0123456789012345678901234567890123456789
# S0119FA011E00007D6E003100000007C9F9 ESA2000_LED
$msg = lc($msg);
my $seq = substr($msg, 1, 2);
my $cde = substr($msg, 3, 4);
my $dev = substr($msg, 7, 4);
my $val = substr($msg, 11, 22);
Log 5, "ESA msg $msg";
Log 5, "ESA seq $seq";
Log 5, "ESA device $dev";
Log 5, "ESA code $cde";
my $type = "";
foreach my $c (keys %codes) {
$c = lc($c);
if($cde =~ m/$c/) {
$type = $codes{$c};
last;
}
}
if(!defined($modules{ESA}{defptr}{$dev})) {
Log 3, "Unknown ESA device $dev, please define it";
$type = "ESA" if(!$type);
return "UNDEFINED ${type}_$dev ESA $dev";
}
my $def = $modules{ESA}{defptr}{$dev};
my $name = $def->{NAME};
return "" if(IsIgnored($name));
my (@v, @txt);
if($type eq "ESA2000_LED") {
@txt = ( "repeat", "sequence", "total_ticks", "actual_ticks", "ticks_kwh", "raw", "total_kwh", "actual_kwh" );
# Codierung Hex
$v[0] = int(hex($seq) / 128) ? "+" : "-"; # repeated
$v[1] = hex($seq) % 128;
$v[2] = hex(substr($val,0,8));
$v[3] = hex(substr($val,8,4));
$v[4] = hex(substr($val,18,4)) ^ 25; # XOR 25, whyever bit 1,4,5 are swapped?!?!
$v[5] = sprintf("CNT: %d%s CUM: %d CUR: %d TICKS: %d",
$v[1], $v[0], $v[2], $v[3], $v[4]);
$v[6] = $v[2]/$v[4]; # calculate kW
$v[7] = $v[3]/$v[4]; # calculate kW
$val = sprintf("CNT: %d%s CUM: %0.3f CUR: %0.3f TICKS: %d",
$v[1], $v[0], $v[6], $v[7], $v[4]);
# $v[0] = "$v[0] (Repeated)";
# $v[1] = "$v[1] (Sequence)";
# $v[2] = "$v[2] (Total)";
# $v[3] = "$v[3] (Actual)";
# $v[4] = "$v[4] (T/kWh)";
} else {
Log 3, "ESA Device $dev (Unknown type: $type)";
return "";
}
my $now = TimeNow();
my $max = int(@txt);
if ( $def->{READINGS}{"sequence"}{VAL} ne $v[1] ) {
Log GetLogLevel($name,4), "ESA $name: $val";
for( my $i = 0; $i < $max; $i++) {
$def->{READINGS}{$txt[$i]}{TIME} = $now;
$def->{READINGS}{$txt[$i]}{VAL} = $v[$i];
$def->{CHANGED}[$i] = "$txt[$i]: $v[$i]";
}
$def->{READINGS}{type}{TIME} = $now;
$def->{READINGS}{type}{VAL} = $type;
$def->{STATE} = $val;
$def->{CHANGED}[$max++] = $val;
} else {
Log GetLogLevel($name,4), "(ESA/DISCARDED $name: $val)";
return "($name)";
}
return $name;
}
1;

1098
contrib/contrib/70_NT5000.pm Executable file
View File

File diff suppressed because it is too large Load Diff

354
contrib/contrib/70_SolarView.pm Normal file
View File

@ -0,0 +1,354 @@
##############################################################################
#
# 70_SolarView.pm
#
# A FHEM module to read power/energy values from solarview.
#
# written 2012 by Tobe Toben <fhem@toben.net>
#
# $Id$
#
##############################################################################
#
# SolarView is a powerful datalogger for photovoltaic systems that runs on
# an AVM Fritz!Box (and also on x86 systems). For details see the SV homepage:
# http://www.amhamberg.de/solarview_fritzbox.aspx
#
# SV supports many different inverters. To read the SV power values using
# this module, a TCP-Server must be enabled for SV by adding the parameter
# "-TCP <port>" to the startscript (see the SV manual).
#
# usage:
# define <name> SolarView <host> <port> [<interval> [<timeout>]]
#
# If <interval> is positive, new values are read every <interval> seconds.
# If <interval> is 0, new values are read whenever a get request is called
# on <name>. The default for <interval> is 300 (i.e. 5 minutes).
#
# get <name> <key>
#
# where <key> is one of currentPower, totalEnergy, totalEnergyDay,
# totalEnergyMonth, totalEnergyYear, UDC, IDC, UDCB, IDCB, UDCC, IDCC,
# gridVoltage, gridCurrent and temperature.
#
##############################################################################
#
# Copyright notice
#
# (c) 2012 Tobe Toben <fhem@toben.net>
#
# This script 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.
#
# The GNU General Public License can be found at
# http://www.gnu.org/copyleft/gpl.html.
#
# This script 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.
#
# This copyright notice MUST APPEAR in all copies of the script!
#
##############################################################################
package main;
use strict;
use warnings;
use IO::Socket::INET;
my @gets = ('totalEnergyDay', # kWh
'totalEnergyMonth', # kWh
'totalEnergyYear', # kWh
'totalEnergy', # kWh
'currentPower', # W
'UDC', 'IDC', 'UDCB', # V, A, V
'IDCB', 'UDCC', 'IDCC', # A, V, A
'gridVoltage', 'gridCurrent', # V, A
'temperature'); # oC
sub
SolarView_Initialize($)
{
my ($hash) = @_;
$hash->{DefFn} = "SolarView_Define";
$hash->{UndefFn} = "SolarView_Undef";
$hash->{GetFn} = "SolarView_Get";
$hash->{AttrList} = "loglevel:0,1,2,3,4,5";
}
sub
SolarView_Define($$)
{
my ($hash, $def) = @_;
my @args = split("[ \t]+", $def);
if (int(@args) < 4)
{
return "SolarView_Define: too few arguments. Usage:\n" .
"define <name> SolarView <host> <port> [<interval> [<timeout>]]";
}
$hash->{Host} = $args[2];
$hash->{Port} = $args[3];
$hash->{Interval} = int(@args) >= 5 ? int($args[4]) : 300;
$hash->{Timeout} = int(@args) >= 6 ? int($args[5]) : 4;
# config variables
$hash->{Invalid} = -1; # default value for invalid readings
$hash->{Sleep} = 0; # seconds to sleep before connect
$hash->{Debounce} = 50; # minimum level for debouncing (0 to disable)
$hash->{Rereads} = 2; # number of retries when reading curPwr of 0
$hash->{NightOff} = 'yes'; # skip connection to SV at night?
$hash->{UseSVNight} = 'yes'; # use the on/off timings from SV (else: SUNRISE_EL)
$hash->{UseSVTime} = ''; # use the SV time as timestamp (else: TimeNow())
# internal variables
$hash->{Debounced} = 0;
$hash->{STATE} = 'Initializing';
my $timenow = TimeNow();
for my $get (@gets)
{
$hash->{READINGS}{$get}{VAL} = $hash->{Invalid};
$hash->{READINGS}{$get}{TIME} = $timenow;
}
SolarView_Update($hash);
Log 2, "$hash->{NAME} will read from solarview at $hash->{Host}:$hash->{Port} " .
($hash->{Interval} ? "every $hash->{Interval} seconds" : "for every 'get $hash->{NAME} <key>' request");
return undef;
}
sub
SolarView_Update($)
{
my ($hash) = @_;
if ($hash->{Interval} > 0) {
InternalTimer(gettimeofday() + $hash->{Interval}, "SolarView_Update", $hash, 0);
}
# if NightOff is set and there has been a successful
# reading before, then skip this update "at night"
#
if ($hash->{NightOff} and SolarView_IsNight($hash) and
$hash->{READINGS}{currentPower}{VAL} != $hash->{Invalid})
{
$hash->{STATE} = '0 W, '.$hash->{READINGS}{totalEnergyDay}{VAL}.' kWh (Night)';
return undef;
}
sleep($hash->{Sleep}) if $hash->{Sleep};
Log 4, "$hash->{NAME} tries to contact solarview at $hash->{Host}:$hash->{Port}";
my $success = 0;
my %readings = ();
my $timenow = TimeNow();
my $rereads = $hash->{Rereads};
eval {
local $SIG{ALRM} = sub { die 'timeout'; };
alarm $hash->{Timeout};
READ_SV:
my $socket = IO::Socket::INET->new(PeerAddr => $hash->{Host},
PeerPort => $hash->{Port},
Timeout => $hash->{Timeout});
if ($socket and $socket->connected())
{
$socket->autoflush(1);
print $socket "00*\r\n";
my $res = <$socket>;
close($socket);
if ($res and $res =~ /^\{(00,[\d\.,]+)\},/)
{
my @vals = split(/,/, $1);
if ($hash->{UseSVTime})
{
$timenow = sprintf("%04d-%02d-%02d %02d:%02d:00",
$vals[3], $vals[2], $vals[1], $vals[4], $vals[5]);
}
for my $i (6..19)
{
if (defined($vals[$i]))
{
$readings{$gets[$i - 6]} = 0 + $vals[$i];
}
}
if ($rereads and $readings{currentPower} == 0)
{
sleep(1);
$rereads = $rereads - 1;
goto READ_SV;
}
alarm 0;
# if Debounce is enabled (>0), then skip one! drop of
# currentPower from 'greater than Debounce' to 'Zero'
#
if ($hash->{Debounce} > 0 and
$hash->{Debounce} < $hash->{READINGS}{currentPower}{VAL} and
$readings{currentPower} == 0 and not $hash->{Debounced})
{
# revert to the previous value
$readings{currentPower} = $hash->{READINGS}{currentPower}{VAL};
$hash->{Debounced} = 1;
} else {
$hash->{Debounced} = 0;
}
$success = 1;
}
}
};
alarm 0;
if ($success)
{
for my $get (@gets)
{
# update and notify readings if they have changed
if ($hash->{READINGS}{$get}{VAL} != $readings{$get})
{
$hash->{READINGS}{$get}{VAL} = $readings{$get};
$hash->{READINGS}{$get}{TIME} = $timenow;
#
push @{$hash->{CHANGED}}, "$get: $readings{$get}";
}
}
DoTrigger($hash->{NAME}, undef) if ($init_done);
}
$hash->{STATE} = $hash->{READINGS}{currentPower}{VAL}.' W, '.$hash->{READINGS}{totalEnergyDay}{VAL}.' kWh';
if ($success) {
Log 4, "$hash->{NAME} got fresh values from solarview";
} else {
$hash->{STATE} .= ' (Fail)';
Log 4, "$hash->{NAME} was unable to get fresh values from solarview";
}
return undef;
}
sub
SolarView_Get($@)
{
my ($hash, @args) = @_;
return 'SolarView_Get needs two arguments' if (@args != 2);
SolarView_Update($hash) unless $hash->{Interval};
my $get = $args[1];
my $val = $hash->{Invalid};
if (defined($hash->{READINGS}{$get})) {
$val = $hash->{READINGS}{$get}{VAL};
} else {
return "SolarView_Get: no such reading: $get";
}
Log 3, "$args[0] $get => $val";
return $val;
}
sub
SolarView_Undef($$)
{
my ($hash, $args) = @_;
RemoveInternalTimer($hash) if $hash->{Interval};
return undef;
}
sub
SolarView_IsNight($)
{
my ($hash) = @_;
my $isNight = 0;
my ($sec,$min,$hour,$mday,$mon) = localtime(time);
# reset totalEnergyX if needed
if ($hour == 0)
{
my $timenow = TimeNow();
$hash->{READINGS}{totalEnergyDay}{VAL} = 0;
$hash->{READINGS}{totalEnergyDay}{TIME} = $timenow;
#
if ($mday == 1)
{
$hash->{READINGS}{totalEnergyMonth}{VAL} = 0;
$hash->{READINGS}{totalEnergyMonth}{TIME} = $timenow;
#
if ($mon == 0)
{
$hash->{READINGS}{totalEnergyYear}{VAL} = 0;
$hash->{READINGS}{totalEnergyYear}{TIME} = $timenow;
}
}
}
if ($hash->{UseSVNight})
{
# These are the on/off timings from Solarview, see
# http://www.amhamberg.de/solarview-fb_Installieren.pdf
#
if ($mon == 0) { # Jan
$isNight = ($hour < 7 or $hour > 17);
} elsif ($mon == 1) { # Feb
$isNight = ($hour < 7 or $hour > 18);
} elsif ($mon == 2) { # Mar
$isNight = ($hour < 6 or $hour > 19);
} elsif ($mon == 3) { # Apr
$isNight = ($hour < 5 or $hour > 20);
} elsif ($mon == 4) { # May
$isNight = ($hour < 5 or $hour > 21);
} elsif ($mon == 5) { # Jun
$isNight = ($hour < 5 or $hour > 21);
} elsif ($mon == 6) { # Jul
$isNight = ($hour < 5 or $hour > 21);
} elsif ($mon == 7) { # Aug
$isNight = ($hour < 5 or $hour > 21);
} elsif ($mon == 8) { # Sep
$isNight = ($hour < 6 or $hour > 20);
} elsif ($mon == 9) { # Oct
$isNight = ($hour < 7 or $hour > 19);
} elsif ($mon == 10) { # Nov
$isNight = ($hour < 7 or $hour > 17);
} elsif ($mon == 11) { # Dec
$isNight = ($hour < 8 or $hour > 16);
}
} else { # we use SUNRISE_EL
$isNight = not isday();
}
return $isNight;
}
1;

166
contrib/contrib/86_FS10.pm Normal file
View File

@ -0,0 +1,166 @@
##############################################
package main;
use strict;
use warnings;
use Device::SerialPort;
use IO::Socket::INET;
my $fs10data = "";
my $pcwsdsocket;
#####################################
sub
FS10_Initialize($)
{
my ($hash) = @_;
# Consumer
$hash->{DefFn} = "FS10_Define";
$hash->{AttrList}= "model:FS10 loglevel:0,1,2,3,4,5,6";
}
#####################################
sub
FS10_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
Log 3, "FS10 Define: $a[0] $a[1] $a[2] $a[3]";
return "Define the host and portnr as a parameter i.e. 127.0.0.1 4711"
if(@a != 4);
$hash->{Timer} = 600;
$hash->{Host} = $a[2];
$hash->{Port} = $a[3];
$hash->{STATE} = "Initialized";
my $dev = $a[2];
Log 1, "FS10 device is none, commands will be echoed only"
if($dev eq "none");
$hash->{DeviceName} = $dev;
FS10_GetStatus($hash);
return undef;
}
#####################################
sub
FS10_GetStatus($)
{
my ($hash) = @_;
my $buf;
#my $banner;
my $reqcmd;
my $fs10time;
my $dt;
my $x;
my $result = "";
Log 3, "FS10_GetStatus";
# Call us in 5 minutes again.
InternalTimer(gettimeofday()+300, "FS10_GetStatus", $hash, 0);
my $dnr = $hash->{DEVNR};
my $name = $hash->{NAME};
my $host = $hash->{Host};
my $port = $hash->{Port};
my %vals;
my $pcwsd ="$host:$port";
my $pcwsdsocket = IO::Socket::INET->new( $pcwsd )
or return "FS10 Can't bind to pcwsd" if(!$pcwsdsocket);
my $banner = $pcwsdsocket->getline();
my @x = split(" ", $banner);
my @y;
my $fs10name;
for(my $i = 0; $i < 8; $i++) #Outdoor
{
$fs10name ="Ta$i";
$reqcmd = "get od2temp $i\r\n";
$pcwsdsocket->print($reqcmd);
$buf = $pcwsdsocket->getline();
$result = "$result $buf";
@x = split(" ", $buf);
$fs10time = FmtDateTime($x[1]);
$hash->{CHANGED}[$i] = "Ta$i: $x[0]";
$hash->{READINGS}{$fs10name}{TIME} = $fs10time;
$hash->{READINGS}{$fs10name}{VAL} = $x[0];
}
$fs10name="Ti";
$reqcmd = "get idtemp 7\r\n";
$pcwsdsocket->print($reqcmd);
$buf = $pcwsdsocket->getline();
@x = split(" ", $buf);
$fs10time = FmtDateTime($x[1]);
$hash->{CHANGED}[8] = "Ti: $x[0]";
$hash->{READINGS}{$fs10name}{TIME} = $fs10time;
$hash->{READINGS}{$fs10name}{VAL} = $x[0];
$fs10name="Rain";
$reqcmd = "get rain 7\r\n";
$pcwsdsocket->print($reqcmd);
$buf = $pcwsdsocket->getline();
@x = split(" ", $buf);
$fs10time = FmtDateTime($x[1]);
$hash->{CHANGED}[9] = "Rain: $x[0]";
$hash->{READINGS}{$fs10name}{TIME} = $fs10time;
$hash->{READINGS}{$fs10name}{VAL} = $x[0];
$fs10name="Sun";
$reqcmd = "get bright 7\r\n";
$pcwsdsocket->print($reqcmd);
$buf = $pcwsdsocket->getline();
@x = split(" ", $buf);
$fs10time = FmtDateTime($x[1]);
$hash->{CHANGED}[10] = "Sun: $x[0]";
$hash->{READINGS}{$fs10name}{TIME} = $fs10time;
$hash->{READINGS}{$fs10name}{VAL} = $x[0];
$fs10name="Windspeed";
$reqcmd = "get wspd 7\r\n";
$pcwsdsocket->print($reqcmd);
$buf = $pcwsdsocket->getline();
@x = split(" ", $buf);
$fs10time = FmtDateTime($x[1]);
$hash->{CHANGED}[11] = "Windspeed: $x[0]";
$hash->{READINGS}{$fs10name}{TIME} = $fs10time;
$hash->{READINGS}{$fs10name}{VAL} = $x[0];
close($pcwsdsocket);
$result =~ s/[\r\n]//g;
DoTrigger($name, undef) if($init_done);
$hash->{STATE} = "$result";
Log 3,"FS10 Result: $result";
return $hash->{STATE};
}
#####################################
sub
FS10Log($$)
{
my ($a1, $a2) = @_;
#define n31 notify fs10 {FS10Log("@", "%")}
#define here notify action
Log 2,"FS10 $a1 = $a2 old: $oldvalue{$a1}{TIME}=> $oldvalue{$a1}{VAL});";
}
1;

211
contrib/contrib/90_EIBUPDOWN.pm Normal file
View File

@ -0,0 +1,211 @@
##############################################
package main;
use strict;
use warnings;
my %eib_c2b1 = (
"alloff" => "00",
"off" => "01",
"on" => "00",
"up" => "01",
"down" => "00",
"up-for-timer" => "01",
"down-for-timer" => "00",
);
my %eib_c2b2 = (
"alloff" => "00",
"off" => "00",
"on" => "01",
"up" => "00",
"down" => "01",
"up-for-timer" => "00",
"down-for-timer" => "01",
);
my %readonly = (
"dummy" => 1,
);
my $eib_simple ="alloff off on up down up-for-timer down-for-timer";
my %models = (
);
sub
EIBUPDOWN_Initialize($)
{
my ($hash) = @_;
$hash->{Match} = "^B.*";
$hash->{SetFn} = "EIBUPDOWN_Set";
$hash->{StateFn} = "EIBUPDOWN_SetState";
$hash->{DefFn} = "EIBUPDOWN_Define";
$hash->{UndefFn} = "EIBUPDOWN_Undef";
$hash->{ParseFn} = "EIBUPDOWN_Parse";
$hash->{AttrList} = "IODev do_not_notify:1,0 ignore:0,1 dummy:1,0 showtime:1,0 model:EIB loglevel:0,1,2,3,4,5,6";
}
#############################
sub
EIBUPDOWN_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $u = "wrong syntax: define <name> EIBUPDOWN <up group name> <down group name>";
return $u if(int(@a) < 4);
return "Define $a[0]: wrong up group name format: specify as 0-255/0-255/0-255"
if( ($a[2] !~ m/^[0-9]{1,3}\/[0-9]{1,3}\/[0-9]{1,3}$/i));
return "Define $a[0]: wrong down group name format: specify as 0-255/0-255/0-255"
if( ($a[3] !~ m/^[0-9]{1,3}\/[0-9]{1,3}\/[0-9]{1,3}$/i));
my $groupname_up = eibupdown_name2hex($a[2]);
my $groupname_down = eibupdown_name2hex($a[3]);
$hash->{GROUP_UP} = lc($groupname_up);
$hash->{GROUP_DOWN} = lc($groupname_down);
my $code = "$groupname_up$groupname_down";
my $ncode = 1;
my $name = $a[0];
$hash->{CODE}{$ncode++} = $code;
$modules{EIB}{defptr}{$code}{$name} = $hash;
AssignIoPort($hash);
}
#############################
sub
EIBUPDOWN_Undef($$)
{
my ($hash, $name) = @_;
foreach my $c (keys %{ $hash->{CODE} } ) {
$c = $hash->{CODE}{$c};
# As after a rename the $name may be different from the $defptr{$c}{$n}
# we look for the hash.
foreach my $dname (keys %{ $modules{EIB}{defptr}{$c} }) {
delete($modules{EIB}{defptr}{$c}{$dname})
if($modules{EIB}{defptr}{$c}{$dname} == $hash);
}
}
return undef;
}
#####################################
sub
EIBUPDOWN_SetState($$$$)
{
my ($hash, $tim, $vt, $val) = @_;
$val = $1 if($val =~ m/^(.*) \d+$/);
return "Undefined value $val" if(!defined($eib_c2b1{$val}));
return undef;
}
###################################
sub
EIBUPDOWN_Set($@)
{
my ($hash, @a) = @_;
my $ret = undef;
my $na = int(@a);
return "no set value specified" if($na < 2 || $na > 3);
return "Readonly value $a[1]" if(defined($readonly{$a[1]}));
my $c_off = $eib_c2b1{"alloff"};
my $c_up = $eib_c2b1{$a[1]};
my $c_down = $eib_c2b2{$a[1]};
if(!defined($c_off) || !defined($c_up) || !defined($c_down)) {
return "Unknown argument $a[1], choose one of " .
join(" ", sort keys %eib_c2b1);
}
my $v = join(" ", @a);
Log GetLogLevel($a[0],2), "EIB set $v";
(undef, $v) = split(" ", $v, 2); # Not interested in the name...
# first of all switch off all channels
# just for being sure
IOWrite($hash, "B", "w" . $hash->{GROUP_UP} . $c_off);
select(undef,undef,undef,0.5);
IOWrite($hash, "B", "w" . $hash->{GROUP_DOWN} . $c_off);
select(undef,undef,undef,0.5);
# now switch on the right channel
if($c_up ne $c_off) {
IOWrite($hash, "B", "w" . $hash->{GROUP_UP} . $c_up);
}
elsif($c_down ne $c_off) {
IOWrite($hash, "B", "w" . $hash->{GROUP_DOWN} . $c_down);
}
###########################################
# Delete any timer for on-for_timer
if($modules{EIB}{ldata}{$a[0]}) {
CommandDelete(undef, $a[0] . "_timer");
delete $modules{EIB}{ldata}{$a[0]};
}
###########################################
# Add a timer if any for-timer command has been chosen
if($a[1] =~ m/for-timer/ && $na == 3) {
my $dur = $a[2];
my $to = sprintf("%02d:%02d:%02d", $dur/3600, ($dur%3600)/60, $dur%60);
$modules{EIB}{ldata}{$a[0]} = $to;
Log 4, "Follow: +$to set $a[0] alloff";
CommandDefine(undef, $a[0] . "_timer at +$to set $a[0] alloff");
}
##########################
# Look for all devices with the same code, and set state, timestamp
my $code = "$hash->{GROUP_UP}$hash->{GROUP_DOWN}";
my $tn = TimeNow();
foreach my $n (keys %{ $modules{EIB}{defptr}{$code} }) {
my $lh = $modules{EIB}{defptr}{$code}{$n};
$lh->{CHANGED}[0] = $v;
$lh->{STATE} = $v;
$lh->{READINGS}{state}{TIME} = $tn;
$lh->{READINGS}{state}{VAL} = $v;
}
return $ret;
}
sub
EIBUPDOWN_Parse($$)
{
my ($hash, $msg) = @_;
Log(5,"EIBUPDOWN_Parse is not defined. msg: $msg");
}
#############################
sub
eibupdown_name2hex($)
{
my $v = shift;
my $r = $v;
Log(5, "name2hex: $v");
if($v =~ /^([0-9]{1,2})\/([0-9]{1,2})\/([0-9]{1,3})$/) {
$r = sprintf("%01x%01x%02x",$1,$2,$3);
}
elsif($v =~ /^([0-9]{1,2})\.([0-9]{1,2})\.([0-9]{1,3})$/) {
$r = sprintf("%01x%01x%02x",$1,$2,$3);
}
return $r;
}
1;

97
contrib/contrib/91_DbLog.pm Executable file
View File

@ -0,0 +1,97 @@
##############################################
# Example for logging KS300 data into a DB.
#
# Prerequisites:
# - The DBI and the DBD::<dbtype> modules must be installed.
# - a Database is created/configured
# - a db table: create table FHZLOG (TIMESTAMP varchar(20), TEMP varchar(5),
# HUM varchar(3), WIND varchar(4), RAIN varchar(8));
# - Change the content of the dbconn variable below
# - extend your FHEM config file with
# notify .*H:.* {DbLog("@","%")}
# - copy this file into the <modpath>/FHEM and restart fhem.pl
#
# If you want to change this setup, your starting point is the DbLog function
my $dbconn = "Oracle:DBNAME:user:password";
package main;
use strict;
use warnings;
use DBI;
my $dbh;
sub DbDo($);
sub DbConnect();
################################################################
sub
DbLog_Initialize($)
{
my ($hash) = @_;
# Lets connect here, so we see the error at startup
DbConnect();
}
################################################################
sub
DbLog($$)
{
my ($a1, $a2) = @_;
# a2 is like "T: 21.2 H: 37 W: 0.0 R: 0.0 IR: no"
my @a = split(" ", $a2);
my $tm = TimeNow();
DbDo("insert into FHZLOG (TIMESTAMP, TEMP, HUM, WIND, RAIN) values " .
"('$tm', '$a[1]', '$a[3]', '$a[5]', '$a[7]')");
}
################################################################
sub
DbConnect()
{
return 1 if($dbh);
Log 5, "Connecting to database $dbconn";
my @a = split(":", $dbconn);
$dbh = DBI->connect("dbi:$a[0]:$a[1]", $a[2], $a[3]);
if(!$dbh) {
Log 1, "Can't connect to $a[1]: $DBI::errstr";
return 0;
}
Log 5, "Connection to db $a[1] established";
return 1;
}
################################################################
sub
DbDo($)
{
my $str = shift;
return 0 if(!DbConnect());
Log 5, "Executing $str";
my $sth = $dbh->do($str);
if(!$sth) {
Log 2, "DB: " . $DBI::errstr;
$dbh->disconnect;
$dbh = 0;
return 0 if(!DbConnect());
#retry
$sth = $dbh->do($str);
if($sth)
{
Log 2, "Retry ok: $str";
return 1;
}
#
return 0;
}
return 1;
}
1;

611
contrib/contrib/95_FLOORPLAN/95_FLOORPLAN.pm Normal file
View File

@ -0,0 +1,611 @@
################################################################################
# 95 FLOORPLAN
# Feedback: http://groups.google.com/group/fhem-users
# Define Custom Floorplans
# Released : 26.02.2012
# Version : 1.01
# Revisions:
# 0001: Released to testers
# 0002: use local FP_select and FP_submit after clash with FHEMWEB update
# 0003: FP_arrange_default repaired
# 0004: WebApp-enabled links in floorplanlist, fixed message 'use of uninitialized value' (FW_pO - $FP_name)
# 0005: Change arrange-mode: When selected, display device-name instead of selection
# 0006: kicked out various routines previously copied from FHEMWEB - now using FW_*-versions thanks to addtl. global variables $FW_RET, $FW_wname, $FW_subdir, %FW_pos
# 0007: Added fp_default
# 0008: Changed name of background-picture from <floorplan-name> to fp_<floorplan-name> to avoid display of picture in device-list at fhem-menu 'Everything'
# -> general release
# 0009: updated selection of add-device-list: suppress CUL$ only (instead of CUL.*)
# 0010: Added Style3, fp_stylesheetPrefix, fp_noMenu (Mar 13, 2012)
# 0011: Added Style4, code beautification, css review, minor $text2-fix (SVN 1342)
# 0012: Added startscreen-text when no floorplans defined, fixed startscreen-stylesheet, added div for bg-img, added arrangeByMouse (1368)
# 0013: implemented redirectCmd, fixed minor </td></tr>-error in html-output, fp_arrange for single web-devices, fp_arrange detail (Mar 23, 2012)
#
################################################################
#
# Copyright notice
#
# (c) 2012 Copyright: Ulrich Maass
# All rights reserved
#
# This script 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.
#
# The GNU General Public License can be found at
# http://www.gnu.org/copyleft/gpl.html.
# A copy is found in the textfile GPL.txt and important notices to the license
# from the author is found in LICENSE.txt distributed with these scripts.
#
# This script 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.
#
################################################################################
# Usage
# define <NAME> FLOORPLAN
#
# Step-by-Step HowTo - mind all is case sensitive:
# Step 1:
# define <name> FLOORPLAN
# Example: define Groundfloor FLOORPLAN
#
# Step 2:
# store picture fp_<name>.png in your modpath. This will be used as background-picture.
# Example: fhem/FHEM/Groundfloor.png
#
# Step 3:
# Activate 'Arrange-Mode' to have user-friendly fields to move items:
# attr <floorplanname> fp_arrange 1
# Delete this attribute when you're done with setup
# To make objects display, they will thereby get assigned
# attr <device> fp_<name> <top>,<left>,<style>,<text>
# displays device <device> on floorplan <name> at position top:<top>,left:<left> with style <style> and description <text>
# styles: 0: icon/state only, 1: name+icon, 2: name+icon+commands 3:Device-Readings(+name)
# Example: attr lamp fp_Groundfloor 100,100,1,TableLamp #displays lamp at position 100px,100px
#
# Repeat step 3 to add further devices. Delete attr fp_<name> when all devices are arranged on your screen. Enjoy.
#
# Check the colorful pdf-docu in http://fhem.svn.sourceforge.net/viewvc/fhem/trunk/fhem/contrib/95_FLOORPLAN/?sortby=file
#
################################################################################
package main;
use strict;
use warnings;
use vars qw(%data);
#########################
# Forward declaration
sub FLOORPLAN_Initialize($); # Initialize
sub FP_define(); # define <name> FLOORPLAN
sub FP_CGI(); # analyze URL
sub FP_digestCgi($); # digest CGI
sub FP_htmlHeader($); # html page - header
sub FP_menu(); # html page - menu left - floorplan-list
sub FP_menuArrange(); # html page - menu bottom - arrange-mode
sub FP_showstart(); # html page - startscreen
sub FP_show(); # produce floorplan
sub FP_input(@); # prepare selection list for forms
#########################
# Global variables
# $ret_html; # from FHEMWEB: Returned data (html)
my $FP_name; # current floorplan-name
my $fhem_url; # URL-Basis "floorplan"
my $FP_arrange; # arrange-mode
my $FP_arrange_selected; # device selected to be arranged
my $FP_arrange_default; # device selected in previous round
my %FP_webArgs = (); # sections of analyzed URL
# $FW_encoding # from FHEMWEB: html-encoding
my $FW_encoding="UTF-8"; # like in FHEMWEB: encoding hardcoded
# $FW_ME # from FHEMWEB: fhem URL
# $FW_tp # from FHEMWEB: is touchpad
# $FW_ss # from FHEMWEB: is smallscreen
my $FW_longpoll=0; # like FHEMWEB: longpoll doesn't work (yet) for floorplans
# $FW_wname; # from FHEMWEB: name of web-instance
# %FW_pos=(); # from FHEMWEB: scroll position
my $FW_plotmode=""; # like in FHEMWEB: SVG
my $FW_plotsize; # like in FHEMWEB: like in fhemweb dependent on regular/smallscreen/touchpad
my $FW_detail; # copied from FHEMWEB - using local version to avoid global variable
my %FW_zoom; # copied from FHEMWEB - using local version to avoid global variable
my @FW_zoom; # copied from FHEMWEB - using local version to avoid global variable
# $FW_subdir # from FHEMWEB: path of floorplan-subdir - enables reusability of FHEMWEB-routines for sub-URLS like floorplan
# $FW_cname # from FHEMWEB: Current connection name
#-------------------------------------------------------------------------------
sub
FLOORPLAN_Initialize($)
{
my ($hash) = @_;
$hash->{DefFn} = "FP_define";
$hash->{AttrList} = "loglevel:0,1,2,3,4,5,6 refresh fp_arrange commandfield fp_default fp_stylesheetPrefix fp_noMenu";
# fp_arrange : show addtl. menu for attr fp_<name> ....
# commandfield : shows an fhem-commandline inputfield on floorplan
# fp_default : set for ONE floorplan. If set, floorplan-startscreen is skipped.
# fp_stylesheetPrefix : e.g. for darkstyle, set value dark -> uses darkfloorplanstyle.css
# fp_noMenu : suppresses display of the floorplan-menu on the floorplan
# CGI
my $name = "floorplan";
$fhem_url = "/" . $name ;
$data{FWEXT}{$fhem_url}{FUNC} = "FP_CGI";
$data{FWEXT}{$fhem_url}{LINK} = $name;
$data{FWEXT}{$fhem_url}{NAME} = "Floorplans";
# $data{FWEXT}{$fhem_url}{EMBEDDED} = 1; # not using embedded-mode to save screen-space
$data{FWEXT}{$fhem_url}{STYLESHEET} = "floorplanstyle.css";
# Global-Config for CSS
$modules{_internal_}{AttrList} .= " VIEW_CSS";
my $n = 0;
@FW_zoom = ("qday", "day","week","month","year"); #copied from FHEMWEB - using local version to avoid global variable
%FW_zoom = map { $_, $n++ } @FW_zoom; #copied from FHEMWEB - using local version to avoid global variable
return undef;
}
#-------------------------------------------------------------------------------
##################
# method 'define'
sub
FP_define(){
my ($hash, $def) = @_;
$hash->{STATE} = $hash->{NAME};
return undef;
}
#-------------------------------------------------------------------------------
##################
# FP MAIN: Answer URL call
sub
FP_CGI(){
my ($htmlarg) = @_; #URL
## reset parameters
$FP_name = undef;
my ($p,$v) = ("",""); #parameter and value of analyzed URL
$FW_RET = ""; # blank out any html-code written so far by fhemweb
# $FW_longpoll = (AttrVal($FW_wname, "longpoll", undef)); # longpoll doesn't work (yet) for floorplans
$FW_detail = 0;
$FW_plotmode = AttrVal($FW_wname, "plotmode", "SVG");
$FW_plotsize = AttrVal($FW_wname, "plotsize", $FW_ss ? "480,160" :
$FW_tp ? "640,160" : "800,160");
$FW_subdir = "";
$htmlarg =~ s/^\///;
# URL: http(s)://IP:port/fhem/floorplan
my @params = split(/\//,$htmlarg); # split URL by /
# possible parameters: [0]:floorplan, [1]:FP_fp?command(s)
# URL with CGI-parameters has addtl / -> use $FP_name
if ($params[2]) {
$FP_name = $params[1];
$params[1] = $params[2];
}
my @htmlpart = ();
@htmlpart = split("\\?", $params[1]) if ($params[1]); #split URL by ?
# htmlpart[0] = FP_name, htmlpart[1] = commandstring
### set global parameters, check florplan-name
$FP_name = $htmlpart[0] if (!$FP_name);
if ($FP_name) { # a floorplan-name is part of URL
addToAttrList("fp_$FP_name"); # create userattr fp_<name> if it doesn't exist yet
$FP_arrange = AttrVal($FP_name, "fp_arrange", 0) if ($FP_name); # set arrange mode
if(!defined($defs{$FP_name})){
$FW_RET = "ERROR: Floorplan $FP_name not defined \n"; # check for typo in URL
return ("text/plain; charset=$FW_encoding", $FW_RET);
}
$FW_subdir = "/floorplan/$FP_name";
} else { # no floorplan-name in URL
$FW_subdir = "/floorplan";
$FP_arrange_default = undef;
$FP_arrange_selected = undef;
my $dev = undef;
my @devs = devspec2array("*");
foreach my $fp (@devs) {
if (AttrVal($fp, "fp_default", undef)) { # use floorplan with attr fp_default
$FP_name = $fp;
$FW_subdir = "/floorplan/$fp";
$FP_arrange = AttrVal($fp, "fp_arrange", undef);
}
}
}
my $commands = FP_digestCgi($htmlpart[1]) if $htmlpart[1]; # analyze URL-commands
my $FP_ret = AnalyzeCommand(undef, $commands) if $commands; # Execute commands
#####redirect commands - to suppress repeated execution of commands upon browser refresh
my $me = $defs{$FW_cname}; # from FHEMWEB: Current connection name
if( AttrVal($FW_wname, "redirectCmds", 1) && $me && $commands && !$FP_ret) {
my $tgt = $FW_ME;
if($FP_name) { $tgt .= "/floorplan/$FP_name" }
else { $tgt .= "/floorplan" }
my $c = $me->{CD};
print $c "HTTP/1.1 302 Found\r\n",
"Content-Length: 0\r\n",
"Location: $tgt\r\n",
"\r\n";
}
######################################
### output html-pages
if($FP_name) {
FP_show(); # show floorplan
}
else {
FP_showStart(); # show startscreen
}
# finish HTML & leave
FW_pO "</html>\n";
$FW_subdir = "";
return ("text/html; charset=$FW_encoding", $FW_RET); # $FW_RET composed by FW_pO, FP_pH etc
}
#-------------------------------------------------------------------------------
###########################
# Digest CGI parameters - portion after '?' in URL
sub
FP_digestCgi($) {
my ($arg) = @_;
my (%arg, %val, %dev, %deva, %attr, %top, %left, %style, %text);
my ($cmd, $c) = ("","","");
%FW_pos = ();
%FP_webArgs = ();
$arg =~ s,^[?/],,;
foreach my $pv (split("&", $arg)) { #per each URL-section devided by &
$pv =~ s/\+/ /g;
$pv =~ s/%(..)/chr(hex($1))/ge;
my ($p,$v) = split("=",$pv, 2); #$p = parameter, $v = value
# Multiline: escape the NL for fhem
$v =~ s/[\r]\n/\\\n/g if($v && $p && $p ne "data");
$FP_webArgs{$p} = $v;
if($p eq "arr.dev") { $v =~ m,^(\w*)\s\(,; $v = $1 if ($1); $FP_arrange_selected = $v; $FP_arrange_default = $v; }
if($p eq "add.dev") { $v =~ m,^(\w*)\s\(,; $v = $1 if ($1); $cmd = "attr $v fp_$FP_name 50,100"; }
if($p eq "cmd") { $cmd = $v; }
if($p =~ m/^cmd\.(.*)$/) { $cmd = $v; $c = $1; }
if($p =~ m/^dev\.(.*)$/) { $dev{$1} = $v; }
if($p =~ m/^arg\.(.*)$/) { $arg{$1} = $v; }
if($p =~ m/^val\.(.*)$/) { $val{$1} = $v; }
if($p =~ m/^deva\.(.*)$/) { $deva{$1} = $v; $FP_arrange_selected = undef;}
if($p =~ m/^attr\.(.*)$/) { $attr{$1} = $v; }
if($p =~ m/^top\.(.*)$/) { $top{$1} = $v; }
if($p =~ m/^left\.(.*)$/) { $left{$1} = $v; }
if($p =~ m/^style\.(.*)$/) { $style{$1} = $v; }
if($p =~ m/^text\.(.*)$/) { $text{$1} = $v; }
if($p eq "pos") { %FW_pos = split(/[=;]/, $v); }
}
$cmd.=" $dev{$c}" if(defined($dev{$c})); #FHT device
$cmd.=" $arg{$c}" if(defined($arg{$c})); #FHT argument (e.g. desired-temp)
$cmd.=" $val{$c}" if(defined($val{$c})); #FHT value
$cmd.=" $deva{$c}" if(defined($deva{$c})); #arrange device
$cmd.=" $attr{$c}" if(defined($attr{$c})); #arrange attr
$cmd.=" $top{$c}" if(defined($top{$c})); #arrange top
$cmd.=",$left{$c}" if(defined($left{$c})); #arrange left
$cmd.=",$style{$c}" if(defined($style{$c})); #arrange style
$cmd.=",$text{$c}" if(defined($text{$c})); #arrange text
return $cmd;
}
#-------------------------------------------------------------------------------
##################
# Page header, set webapp & css
sub
FP_htmlHeader($) {
my $title = shift;
$title = "FHEM floorplan" if (!$title);
### Page start
$FW_RET = "";
$FW_RET .= '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">'."\n";
$FW_RET .= '<html xmlns="http://www.w3.org/1999/xhtml">'."\n";
FW_pO "<head>";
FW_pO "<title>".$title."</title>";
# Enable WebApp
if($FW_tp || $FW_ss) {
FW_pO "<link rel=\"apple-touch-icon-precomposed\" href=\"$FW_ME/fhemicon.png\"/>";
FW_pO "<meta name=\"apple-mobile-web-app-capable\" content=\"yes\"/>";
if($FW_ss) {
FW_pO "<meta name=\"viewport\" content=\"width=320\"/>";
} elsif($FW_tp) {
FW_pO "<meta name=\"viewport\" content=\"width=768\"/>";
}
}
# refresh-value
my $rf = AttrVal($FW_wname, "refresh", "");
FW_pO "<meta http-equiv=\"refresh\" content=\"$rf\">" if($rf); # use refresh-value from Web-Instance
# stylesheet
if ($FP_name) {
my $prf = AttrVal($FP_name, "fp_stylesheetPrefix", "");
FW_pO ("<link href=\"$FW_ME/$prf"."floorplanstyle.css\" rel=\"stylesheet\"/>"); #use floorplanstyle.css for floorplans, evtl. with fp_stylesheetPrefix
$data{FWEXT}{$fhem_url}{STYLESHEET} = "$prf"."floorplanstyle.css";
} else {
my $css = AttrVal($FW_wname, "stylesheetPrefix", "") . "floorplanstyle.css";
FW_pO "<link href=\"$FW_ME/$css\" rel=\"stylesheet\"/>"; #use floorplanstyle.css (incl. FW-stylesheetPrefix) for fp-start-screen
$data{FWEXT}{$fhem_url}{STYLESHEET} = $css;
}
#set sripts
FW_pO "<script type=\"text/javascript\" src=\"$FW_ME/svg.js\"></script>"
if($FW_plotmode eq "SVG");
# FW_pO "<script type=\"text/javascript\" src=\"$FW_ME/longpoll.js\"></script>"
# if($FW_longpoll); # longpoll not yet implemented for floorplans
FW_pO "</head>\n";
}
#-------------------------------------------------------------------------------
##################
# show startscreen
sub
FP_showStart() {
FP_htmlHeader("Floorplans");
FW_pO "<body>";
FW_pO "<div id=\"logo\"></div>";
FP_menu();
FW_pO "<div class=\"screen\" id=\"hdr\">";
FW_pO "<form method=\"get\" action=\"" . $FW_ME . "\">";
FW_pO "<table WIDTH=\"100%\"><tr>";
FW_pO "<td><input type=\"text\" name=\"cmd\" size=\"30\"/></td>"; #input-field
FW_pO "</tr></table>";
FW_pO "</form></div>";
# add edit *floorplanstyle.css if FP_arrange ?
# no floorplans defined? -> show message
my $count=0;
foreach my $f (sort keys %defs) {
next if ($defs{$f}{TYPE} ne "FLOORPLAN");
$count++;
}
if ($count == 0) {
FW_pO '<div id="startcontent">';
FW_pO "<br><br><br><br>No floorplans have been defined yet. For definition, use<br>";
FW_pO "<ul><code>define &lt;name&gt; FLOORPLAN</code></ul>";
FW_pO 'Also check the <a href="/fhem/commandref.html#FLOORPLAN">commandref</a><br>';
FW_pO "</div>";
}
FW_pO "</body>";
}
#-------------------------------------------------------------------------------
##################
# show floorplan
sub
FP_show(){
### Page start
FP_htmlHeader("$FP_name");
## body
FW_pO "<body id=\"$FP_name-body\">\n";
FW_pO "<div id=\"backimg\" style=\"width: 100%; height: 100%;\">";
FW_pO "<img src=\"$FW_ME/fp_$FP_name.png\">"; # alternative: jpg - how?
FW_pO "</div>\n";
## menus
FP_menu();
FP_menuArrange() if ($FP_arrange && ($FP_arrange eq "1" || ($FP_arrange eq $FW_wname) || $FP_arrange eq "detail")); #shows the arrange-menu
# (re-) list the icons
FW_ReadIcons();
## start floorplan
FW_pO "<div class=\"screen\" id=\"floorplan\">";
FW_pO "<div id=\"logo\"></div>";
#commandfield in floorplan
if (AttrVal("$FP_name", "commandfield", undef)) {
FW_pO "<div id=\"hdr\">\n";
FW_pO " <form>";
FW_pO " <input type=\"text\" name=\"cmd\" size=\"30\"/>\n"; #fhem-commandfield
FW_pO " </form>";
FW_pO "</div>\n";
}
foreach my $d (sort keys %defs) { # loop all devices
my $type = $defs{$d}{TYPE};
my $attr = AttrVal("$d","fp_$FP_name", undef);
next if(!$attr || $type eq "weblink"); # skip if device-attribute not set for current floorplan-name
my ($top, $left, $style, $text, $text2) = split(/,/ , $attr);
# $top = position in px, top
# $left = position in px, left
# $style = style (0=icon only, 1=name+icon, 2=name+icon+commands, 3=device-Reading + name from $text2)
# $text = alternativeCaption
# $text2 = special for style3: $text = ReadingID, $text2=alternativeCaption
$left = 0 if (!$left);
$style = 0 if (!$style);
FW_pO "\n<div style=\"position:absolute; top:".$top."px; left:".$left."px;\" id=\"div-$d\">";
FW_pO "<form method=\"get\" action=\"$FW_ME/floorplan/$FP_name/$d\">";
FW_pO " <table class=\"$type fp_$FP_name\" id=\"$d\" align=\"center\">"; # Main table per device
my ($allSets, $cmdlist, $txt) = FW_devState($d, "");
$txt = ReadingsVal($d, $text, "Undefined Reading $d-<b>$text</b>") if ($style == 3); # Style3 = DeviceReading given in $text
my $cols = ($cmdlist ? (split(":", $cmdlist)) : 0); # Need command-count for colspan of devicename+state
########################
# Device-name per device
if ($style gt 0) {
FW_pO " <tr class=\"devicename fp_$FP_name\" id=\"$d\">"; # For css: class=devicename, id=devicename
my $devName = "";
if ($style == 3) {
$devName = $text2 ? $text2 : ""; # Style 3 = Reading - use last part of comma-separated description
} else {
$devName = ($text ? $text : AttrVal($d, "alias", $d));
}
if ($style == 4 && $txt =~ /T: ([\-0-9\.]+)[ ]+H: ([\-0-9\.]+).*/) { # S300TH-specific
$txt = "<span class='fp_tempvalue'>".$1."&deg;C</span><BR><span class='fp_humvalue'>".$2."%</span>";
}
FW_pO "<td colspan=\"$cols\">";
FW_pO "$devName" ;
FW_pO "</td></tr>";
}
########################
# Device-state per device
FW_pO "<tr class=\"devicestate fp_$FP_name\" id=\"$d\">"; # For css: class=devicestate, id=devicename
FW_pO "<td colspan=\"$cols\">$txt";
FW_pO "</td></tr>";
########################
# Commands per device
if($style == 2 && $cols gt 0) {
FW_pO " <tr class=\"devicecommands\" id=\"$d\">"; # For css: class=devicecommands, id=devicename
foreach my $cmd (split(":", $cmdlist)) {
FW_pH "cmd.$d=set $d $cmd", ReplaceEventMap($d,$cmd,1), 1, "devicecommands";
}
FW_pO " </tr>";
} elsif($type eq "FileLog") {
# devices with desired-temp-reading, e.g. FHT
} elsif($style == 2 && $allSets =~ m/ desired-temp /) { # FHT-set
FW_pO " <tr class=\"devicecommands\" id=\"$d\">";
$txt = ReadingsVal($d, "measured-temp", "");
$txt =~ s/ .*//;
$txt = sprintf("%2.1f", int(2*$txt)/2) if($txt =~ m/[0-9.-]/);
my @tv = split(" ", getAllSets("$d desired-temp"));
$txt = int($txt*20)/$txt if($txt =~ m/^[0-9].$/);
FW_pO "<td>".
FP_input("dev.$d", $d, "hidden") .
FP_input("arg.$d", "desired-temp", "hidden") .
FW_select("val.$d", \@tv, ReadingsVal($d, "desired-temp", $txt),"devicecommands") .
FW_submit("cmd.$d", "set").
"</td></tr>";
}
FW_pO "</table></form>";
FW_pO "</div>\n";
}
########################
# Now the weblinks
my $buttons = 1;
my @list = (keys %defs);
foreach my $d (sort @list) {
my $attr = AttrVal("$d","fp_$FP_name", undef);
next if(IsIgnored($d) || !$attr);
my $type = $defs{$d}{TYPE};
next if(!$type);
next if($type ne "weblink");
# set position per weblink
my ($top, $left, $style, $text) = split(/,/ , AttrVal("$d", "fp_$FP_name", undef));
FW_pO "\n<div style=\"position:absolute; top:".$top."px; left:".$left."px\" id = \"div-$d\">"; # div to position the weblink
FW_pO "<div class = \"fp_$type fp_$FP_name weblink\" id = \"$d\">"; # div to make it accessible to arrangeByMouse
# print weblink
$buttons = FW_showWeblink($d, $defs{$d}{LINK}, $defs{$d}{WLTYPE}, $buttons);
FW_pO "</div></div>";
}
FW_pO "</div>";
# FP_menuArrange() if ($FP_arrange); #shows the arrange-menu
FW_pO "</body>\n";
}
#-------------------------------------------------------------------------------
##################
# Floorplan menu left
sub
FP_menu() {
return if ($FP_name && AttrVal($FP_name, "fp_noMenu", 0)); # fp_noMenu suppresses menu
FW_pO "<div class=\"floorplan\" id=\"menu\">";
# List FPs
FW_pO "<table class=\"start\" id=\"floorplans\">";
FW_pO "<tr>";
FW_pH "$FW_ME", "fhem", 1;
FW_pO "</tr>";
foreach my $f (sort keys %defs) {
next if ($defs{$f}{TYPE} ne "FLOORPLAN");
FW_pO "<tr><td>";
FW_pH "$FW_ME/floorplan/$f", $f, 0;
FW_pO "</td></tr>";
}
FW_pO "</table><br>";
FW_pO "</div>\n";
}
#-------------------------------------------------------------------------------
##################
# Arrange-menu
sub
FP_menuArrange() {
my %desc=();
# collect data
$FP_arrange_default = "" if (!$FP_arrange_default);
my @fpl;
my @nfpl;
foreach my $d (sort keys %defs) { # loop all devices
my $type = $defs{$d}{TYPE};
# exclude these types from list of available devices
next if($type =~ m/^(WEB|CUL$|FHEM.*|FileLog|PachLog|PID|SUNRISE.*|FLOORPLAN|holiday|Global|notify|autocreate)/ );
my $disp = $d;
if ($FP_arrange eq "detail") {
$disp .= ' (' . AttrVal($d,"room","Unsorted").") $type";
my $alias = AttrVal($d, "alias", undef);
$disp .= ' (' . $alias . ')' if ($alias);
}
$desc{$d} = $disp;
if (AttrVal("$d","fp_$FP_name", undef)) {
push(@fpl, $disp);
} else {
push(@nfpl, $disp);
}
}
my $attrd = "";
my $d = $FP_arrange_selected;
$attrd = AttrVal($d, "fp_$FP_name", undef) if ($d);
FW_pO "<div style=\"z-index:999\" class=\"fp_arrange\" id=\"fpmenu\">";
# add device to floorplan
if (!defined($FP_arrange_selected)) {
FW_pO "<form method=\"get\" action=\"$FW_ME/floorplan/$FP_name\">"; #form1
FW_pO "<div class=\"menu-add\" id=\"fpmenu\">\n" .
FW_select("add.dev", \@nfpl, "", "menu-add") .
FW_submit("ccc.one", "add");
FW_pO "</div></form>\n"; #form1
}
# select device to be arranged
if (!defined($FP_arrange_selected)) {
my $dv = $FP_arrange_default;
$dv = $desc{$dv} if ($dv && $FP_arrange eq "detail");
FW_pO "<form method=\"get\" action=\"$FW_ME/floorplan/$FP_name\">"; #form2
FW_pO "<div class=\"menu-select\" id=\"fpmenu\">\n" .
FW_select("arr.dev", \@fpl, $dv, "menu-select") .
FW_submit("ccc.one", "select");
FW_pO "</div></form>"; #form2
}
# fields for top,left,style,text
if ($attrd) {
#### arrangeByMouse by Torsten
FW_pO "<script type=\"text/javascript\">";
FW_pO "function show_coords(e){";
FW_pO " var device = document.getElementById(\"fp_ar_input_top\").name.replace(/top\./,\"\");"; # get device-ID from 'top'-field
FW_pO " var X = e.pageX;"; # e is the event, pageX and pageY the click-ccordinates
FW_pO " var Y = e.pageY;";
FW_pO " document.getElementById(\"fp_ar_input_top\").value = Y;"; # updates the input-fields top and left with the click-coordinates
FW_pO " document.getElementById(\"fp_ar_input_left\").value = X;";
FW_pO " document.getElementById(\"div-\"+device).style.top = Y+\"px\";"; # moves the device
FW_pO " document.getElementById(\"div-\"+device).style.left = X+\"px\";";
FW_pO "}";
FW_pO "document.getElementById(\"backimg\").addEventListener(\"click\",show_coords,false);"; # attach event-handler to background-picture
FW_pO "</script>";
### build the form
my $disp = $FP_arrange eq "detail" ? $desc{$d} : $d;
FW_pO "<form method=\"get\" action=\"$FW_ME/floorplan/$FP_name\">"; #form3
my ($top, $left, $style, $text, $text2) = split(",", $attrd);
$text .= ','.$text2 if ($text2); # re-append Description after reading-ID for style3
my @styles = ("0","1","2","3","4");
FW_pO "<div class=\"menu-arrange\" id=\"fpmenu\">\n" .
FP_input("deva.$d", $d, "hidden") . "\n" .
FP_input("dscr.$d", $disp, "text", "Selected device", 45, "", "disabled") . "\n<br>\n" .
FP_input("attr.$d", "fp_$FP_name", "hidden") . "\n" .
FP_input("top.$d", $top ? $top : 10, "text", "Top", 4, 4, 'id="fp_ar_input_top"') . "\n" .
FP_input("left.$d", $left ? $left : 10, "text", "Left", 4, 4, 'id="fp_ar_input_left"' ) . "\n" .
FW_select("style.$d", \@styles, $style ? $style : 0, "menu-arrange") . "\n" .
FP_input("text.$d", $text ? $text : "", "text", "Description", 15) . "\n" .
FW_submit("cmd.$d", "attr") ;
FW_pO "</div></form>"; # form3
}
FW_pO "</div>";
}
#-------------------------------------------------------------------------------
##################
# input-fields for html-forms
sub
FP_input(@)
{
my ($n, $v, $type, $title, $size, $maxlength, $addition) = @_;
$title = $title ? " title=\"$title\"" : "";
$size = $size ? " size=\"$size\"" : "";
$maxlength = $maxlength ? " maxlength=\"$maxlength\"" : "";
$addition = "" if (!defined($addition));
return "<input type=\"$type\"$title$size$maxlength $addition name=\"$n\" value=\"$v\"/>\n";
}
1;

75
contrib/contrib/95_FLOORPLAN/99_myFloorplanList.pm Normal file
View File

@ -0,0 +1,75 @@
package main;
use strict;
use warnings;
use POSIX;
my @wert;
my $div_class;
sub doMakeHtml($@);
######################################################################################
sub
myFloorplanList_Initialize($$)
{
my ($hash) = @_;
}
###################################################################################
# Define in fhem by
# define w_WertListe1 weblink htmlCode {doWertListe1()}
# attr w_WertListe1 room Listen
#
sub
doWertListe1() {
$div_class = "WertListe"; #format in css-file using #WertListe
# vvvvvvvvvvvvv Change this list as needed vvvvvvvvvvvvvvv
$wert[0] = "FHT Ist:" .','. ReadingsVal("ez_FHT","measured-temp","ezFHT measured-temp Fehler");
$wert[1] = "FHT Soll:" .','. ReadingsVal("ez_FHT","desired-temp","ezFHT desired-temp Fehler");
$wert[2] = "FHT Actuator:" .','. ReadingsVal("ez_FHT","actuator","ezFHT actuator Fehler");
$wert[3] = "Aussen:" .','. ReadingsVal("ez_Aussensensor","temperature","ez_Aussensensor temperature Fehler");
$wert[4] = "HomeStatus:" .','. Value("HomeStatus");
$wert[5] = "GoogleTemp:" .','. ReadingsVal("MunichWeather","temperature","MunichWeather temperature Error");
$wert[6] = "GoogleSky:" .','. ReadingsVal("MunichWeather","condition","MunichWeather condition Error");
$wert[7] = "GoogleIcon:" .','. "<img src=\"http://www.google.com".ReadingsVal("MunichWeather","icon","MunichWeather icon Error")."\">";
my $FritzTemp = `ctlmgr_ctl r power status/act_temperature` ; # read FritzBox internal temperature
$wert[8] = "FritzBoxTemp:" .','. $FritzTemp . "&deg"; # print FritzBox internal temperature
# ^^^^^^^^^^^^^ Change this list as needed ^^^^^^^^^^^^^^^
return doMakeHtml($div_class, @wert);
}
###################################################################################
# Define in fhem by
# define w_WertListe2 weblink htmlCode {doWertListe2()}
# attr w_WertListe2 room Listen
#
#sub
#doWertListe2() {
# $div_class = "WertListe"; #format in css-file using #WertListe
#
#
# vvvvvvvvvvvvv Change this list as needed vvvvvvvvvvvvvvv
# $wert[0] = "FHT Ist:" .','. ReadingsVal("ez_FHT","measured-temp","ezFHT measured-temp Fehler");
# $wert[1] = "FHT Soll:" .','. ReadingsVal("ez_FHT","desired-temp","ezFHT desired-temp Fehler");
# $wert[2] = "FHT Actuator:" .','. ReadingsVal("ez_FHT","actuator","ezFHT actuator Fehler");
# and so on
# ^^^^^^^^^^^^^ Change this list as needed ^^^^^^^^^^^^^^^
#
# return doMakeHtml($div_class, @wert);
#}
###################################################################################
# Create html-code
#
sub
doMakeHtml($@) {
my ($div_class, @line ) = @_;
my $htmlcode = '<div class="'.$div_class."\"><table>\n";
foreach (@line) {
my ($title, $value) = split (",",$_);
my $cssTitle = $title;
$cssTitle =~ s,[: -],,g;
$htmlcode .= "<tr><td><span \"$cssTitle-title\">$title</span></td><td><span \"$cssTitle-value\">$value</span></td></tr>\n";
}
$htmlcode .= "</table></div>";
return $htmlcode;
}
1;

131
contrib/contrib/95_FLOORPLAN/commandref - floorplan.html Normal file
View File

@ -0,0 +1,131 @@
<a name="FLOORPLAN"></a>
<h3>FLOORPLAN</h3>
<ul>
Implements an additional entry "Floorplans" to your fhem menu, leading to a userinterface without fhem-menu, rooms or devicelists.
Devices can be displayed at a defined coordinate on the screen, usually with a clickable icon allowing to switch
the device on or off by clicking on it. A background-picture can be used - use e.g. a floorplan of your house, or any picture.
Use floorplanstyle.css to adapt the representation.<br>
FLOORPLAN is not part of the fhem standard delivery. Download it from
<a href="http://fhem.svn.sourceforge.net/viewvc/fhem/trunk/fhem/contrib/95_FLOORPLAN/?sortby=file">this SVN folder</a>,
where you also find pdf-files (english and german) with a step-by-step guide for setup. <br>
<br>
<a name="FLOORPLANdefine"></a>
<b>Define</b>
<ul>
<code>define &lt;name&gt; FLOORPLAN </code>
<br><br>
<b>Hint:</b> Store fp_&lt;name&gt;.png in your modpath folder (FHEM) to use it as background picture.<br><br>
Example:
<ul>
<code>
define Groundfloor FLOORPLAN<br>
fp_Groundfloor.png
</code><br>
</ul>
</ul>
<br>
<a name="FLOORPLANset"></a>
<b>Set </b>
<ul>
<li>N/A</li>
</ul>
<br>
<a name="FLOORPLANget"></a>
<b>Get </b>
<ul>
<li>N/A</li>
</ul>
<br>
<a name="FLOORPLANattr"></a>
<b>Attributes</b>
<ul>
<li><a name="fp_fpname">userattr fp_&lt;name&gt; &lt;top&gt;,&lt;left&gt;[,&lt;style&gt;[,&lt;description&gt;]]</a><br><br>
A <a href="#userattr">userattr</a> fp_&lt;name&gt; will be created automatically if it does not exist yet.<br>
<ul>
<li>top = screen-position, pixels from top of screen
<li>left = screen-position, pixels from left of screen
<li>style =
<ul>
<li>0 icon/state only
<li>1 devicename and icon/state
<li>2 devicename, icon/state and commands
<li>3 device-reading and optional description
<li>4 S300TH-specific, displays temperature above humidity
</ul>
<li>description will be displayed instead of the original devicename
</ul><br>
Examples:<br>
<ul>
<table>
<tr><td><code>attr lamp1 fp_Groundfloor 100,100</code></td><td><code>#display lamp1 with icon only at screenposition 100,100</code></td></tr>
<tr><td><code>attr lamp2 fp_Groundfloor 100,140,1,Art-Deco</code></td><td><code>#display lamp2 with description 'Art-Deco-Light' at 100,140</code></td></tr>
<tr><td><code>attr lamp2 fp_FirstFloor 130,100,1</code></td><td><code>#display the same device at different positions on other floorplans</code></td></tr>
<tr><td><code>attr myFHT fp_Groundfloor 300,20,10,Temperature</code></td><td><code>#display given Text + FHT-temperature</code></td></tr>
</table>
</ul>
<b>Hint:</b> no blanks between parameters<br><br>
<li><a name="fp_arrange">fp_arrange</a><br>
Activates the "arrange mode" which shows an additional menu on the screen,
allowing to place devices easily on the screen.<br>
Example:
<ul>
<code>attr Groundfloor fp_arrange 1</code><br><br>
</ul>
</li>
<li><a name="fp_stylesheetPrefix">fp_stylesheetPrefix</a><br>
Allows the usage of a separate stylesheet like <a href="#stylesheetPrefix">stylesheetPrefix</a>.<br>
The prefix is prepended the standard stylesheet floorplanstyle.css .<br>
Example:
<ul>
<code>attr Groundfloor fp_stylesheetPrefix dark # use darkfloorplanstyle.css</code><br><br>
</ul>
</li>
<li><a name="fp_default">fp_default</a><br>
The floorplan startscreen is skipped if this attribute is assigned to one of the floorplans in your installation.
</li>
Example:
<ul>
<code>attr Groundfloor fp_default 1</code><br><br>
</ul>
<li><a name="fp_noMenu">fp_noMenu</a><br>
Suppresses the menu which usually shows the links to all your floorplans.
</li>
Example:
<ul>
<code>attr Groundfloor fp_noMenu 1</code><br><br>
</ul>
<li><a name="commandfield">commandfield</a><br>
Adds a fhem-commandfield to the floorplan screen.
</li>
Example:
<ul>
<code>attr Groundfloor commandfield 1</code><br><br>
</ul>
<li><a name="fp_inherited">Inherited from FHEMWEB</a><br>
The following attributes are inherited from the underlying <a href="#FHEMWEB">FHEMWEB</a> instance:<br>
<ul>
<a href="#smallscreen">smallscreen</a><br>
<a href="#touchpad">touchpad</a><br>
<a href="#refresh">refresh</a><br>
<a href="#plotmode">plotmode</a><br>
<a href="#plotsize">plotsize</a><br>
<a href="#webname">webname</a><br>
</ul>
</li><br>
</ul>
<br>
</ul>

48
contrib/contrib/95_FLOORPLAN/darkfloorplanstyle.css Normal file
View File

@ -0,0 +1,48 @@
body { background-color: #444444; font-family:Verdana; font-size:9px; background-image:url(darklogo.png); background-repeat:no-repeat; }
body[id~=Media] { background-color: #A5A5A5; font-family:Verdana; font-size:9px; background-image:url(Media.bak.png); background-repeat:no-repeat; }
#backimg {position:absolute; top:15px; left:190px;}
#logo { position:absolute; top: 10px; left: 10px; width:180px; height:600px; background-image:url(darklogo.png); visibility:hidden;}
#fpmenu.fp_arrange { position:absolute; bottom:20px; left:30px; min-width:310px; font-size:9px; border:1px solid #CCCCCC; background: #111111; -moz-border-radius:8px; border-radius:8px; border-spacing: 6px; padding: 6px;
box-shadow:5px 5px 5px #000; }
#menu { position:absolute; top:180px; left:30px; width:140px; -moz-border-radius:8px; border-radius:8px; border-spacing: 6px; padding-bottom: 6px; padding-top: 6px;}
#menu.floorplan { position:absolute; top:180px; left:30px; width:128px; font-size:12px; border:1px solid #CCCCCC; background: #111111; box-shadow:5px 5px 5px #000; padding: 6px;}
#hdr { position:absolute; top:15px; left:190px; border:1px solid #CCCCCC; background: #111111; -moz-border-radius:8px; border-radius:8px; border-spacing: 6px; padding: 6px;
box-shadow:5px 5px 5px #000; margin-bottom: 10px;}
#content { position:absolute; top:50px; left:180px; bottom:10px; right:10px; text-align:center}
#startcontent {position:absolute; top:20px; left:200px; text-align:left; font-size: 16px; color:gray; }
a { color:#CCCCCC; }
img { -moz-border-radius:8px; border-radius:8px;}
table { -moz-border-radius:8px; border-radius:8px; }
table tr.sel { backround: #333333;}
table a:hover {color: #ffffff;}
.fp_Erdgeschoss { }
.devicename { font-size: 14px; text-align:center; color: #111111; }
.devicestate { text-align:center; color: #111111; }
.devicecommands { font-size:14px; text-align:center; color: #111111; }
#sz_Rollo.devicename {font-size:14px;}
#sz_Rollo.devicecommands {font-size:12px; text-align:center; }
#ez_Aussentemperatur_dummy.devicestate {color:green; font-size:30px; }
#HomeStatus.devicestate {color:green; font-size:30px; }
table.dummy {width:100px;}
table.FHT {width:100px; }
#wakeup.devicestate {color:green; font-size:11px; }
#ez_FHT.devicestate {color:green; font-size:30px; }
#Home.fp_Grundriss {font-size:14px; width:100px; }
#Home.fp_Media {font-size:14px; text-align:left; }
#Media {font-size:14px; }
#Grundriss {font-size:14px; text-align:left; }
#w_MucWeather {font-size:16px; color:#D4D4D4}
#w_WertListe1 {font-size:20px; color:gray}
h2,h3,h4 { color:#52865D; line-height:1.3; margin-top:1.5em; font-family:Verdana; }

BIN
contrib/contrib/95_FLOORPLAN/fhem-floorplan-installation-guide.pdf Normal file
View File

Binary file not shown.

BIN
contrib/contrib/95_FLOORPLAN/fhem-floorplan-installation-guide_de.pdf Normal file
View File

Binary file not shown.

48
contrib/contrib/95_FLOORPLAN/floorplanstyle.css Normal file
View File

@ -0,0 +1,48 @@
body { background-color: #F0F0F0;
font-family:Arial, sans-serif;
font-size:9px; background-image:url(Grundriss.bak.png);
background-repeat:no-repeat; }
body[id~=Media] { background-color: #A5A5A5;
font-family:Arial, sans-serif;
font-size:9px;
background-image:url(Media.bak.png);
background-repeat:no-repeat; }
#logo { position:absolute; top: 10px; left: 10px;
width:64px; height:67px; background-image:url(fhem_smallscreen.png); }
#backimg {position:absolute; top:15px; left:190px;}
#menu { position:absolute; top:120px; left:20px; min-width:60px; }
#menu.floorplan { position:absolute; top:120px; left:20px; min-width:80px; font-size:14px; line-height:22px; }
#fpmenu.fp_arrange { position:absolute; bottom:20px; left:20px; min-width:310px; font-size:9px; border:1px solid gray;}
#startcontent {position:absolute; top:20px; left:180px; text-align:left; font-size: 16px; }
table a:hover {font-weight:bold;}
#hdr { position:absolute; top:10px; left:180px; border:1px solid gray; }
#content { position:absolute; top:50px; left:180px; bottom:10px; right:10px; text-align:center}
a { color: #278727; }
img { border-style: none; }
table { -moz-border-radius:8px; border-radius:8px; }
.fp_Grundriss {border:0px solid gray;}
.devicename {font-size: 11px; text-align:center; }
.devicestate {text-align:center; }
.devicecommands {font-size:14px; text-align:center; }
#sz_Rollo.devicename {font-size:14px;}
#sz_Rollo.devicecommands {font-size:12px; text-align:center; }
#ez_Aussensensor.devicestate {color:green; font-size:30px; }
#HomeStatus.devicestate {color:green; font-size:30px; }
table.dummy {width:100px; }
table.FHT {width:100px; }
#wakeup.devicestate {color:green; font-size:11px; }
#ez_FHT.devicestate {color:green; font-size:30px; }
#Home.fp_Grundriss {font-size:14px; width:100px; }
#Home.fp_Media {font-size:14px; text-align:left; }
#Media {font-size:14px; }
#Grundriss {font-size:14px; text-align:left; }
.fp_tempvalue {color:red; font-size:20px; }
.fp_humvalue {color:blue; font-size:20px; }
h2,h3,h4 { color:#52865D; line-height:1.3;
margin-top:1.5em; font-family:Arial,Sans-serif; }

299
contrib/contrib/95_VIEW.pm Executable file
View File

@ -0,0 +1,299 @@
################################################################################
# 95 VIEW
# Feedback: http://groups.google.com/group/fhem-users
# Define Custom View
# Stand: 04.2011
# Version: 1.0
################################################################
#
# Copyright notice
#
# (c) 2011 Copyright: Axel Rieger (fhem bei anax punkt info)
# All rights reserved
#
# This script 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.
#
# The GNU General Public License can be found at
# http://www.gnu.org/copyleft/gpl.html.
# A copy is found in the textfile GPL.txt and important notices to the license
# from the author is found in LICENSE.txt distributed with these scripts.
#
# This script 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.
#
################################################################################
# Usage
# define <NAME> VIEW
# attr <NAME> ViewRegExType -> Chose Device-Type (Perl-RegExp)
# attr <NAME> ViewRegExName -> Chose Device-Name (Perl-RegExp)
# attr <NAME> ViewRegExReading -> Chose Readings (Perl-RegExp)
# attr <Name> ViewRegExReadingStringCompare -> Chose ReadingValue (Perl-RegEx)
#
# Examples:
# Show all Device with Type FHT
# attr MyFHT ViewRegExType FHT
# attr MyFHT ViewRegExName * or NotSet
# attr MyFHT ViewRegExReading * or NotSet
# attr MyFHT ViewRegExReadingStringCompare * or Notset
#
# Show all Warnings of ALL Devices without "none"-Values
# attr MyFHT ViewRegExType * or NotSet
# attr MyFHT ViewRegExName * or NotSet
# attr MyFHT ViewRegExReading warnings
# attr MyFHT ViewRegExReadingStringCompare [^none]
################################################################################
package main;
use strict;
use warnings;
use Data::Dumper;
use vars qw(%data);
#-------------------------------------------------------------------------------
sub VIEW_Initialize($)
{
my ($hash) = @_;
$hash->{DefFn} = "VIEW_Define";
$hash->{AttrList} = "ViewRegExType ViewRegExName ViewRegExReading ViewRegExReadingStringCompare loglevel:0,5";
# CGI
my $name = "MyVIEWS";
my $fhem_url = "/" . $name ;
$data{FWEXT}{$fhem_url}{FUNC} = "VIEW_CGI";
$data{FWEXT}{$fhem_url}{LINK} = $name;
$data{FWEXT}{$fhem_url}{NAME} = $name;
# Global-Config for CSS
# $attr{global}{VIEW_CSS} = "";
$modules{_internal_}{AttrList} .= " VIEW_CSS";
return undef;
}
#-------------------------------------------------------------------------------
sub VIEW_Define(){
my ($hash, $def) = @_;
$hash->{STATE} = $hash->{NAME};
return undef;
}
#-------------------------------------------------------------------------------
sub VIEW_CGI(){
my ($htmlarg) = @_;
# Remove trailing slash
$htmlarg =~ s/^\///;
# Log 0,"VIEW: htmlarg: " . $htmlarg ."\n";
# URL: http(s)://[FHEM:xxxx]/fhem/MyVIEWS/<View-Name>
my @params = split(/\//,$htmlarg);
my $ret_html;
if(int(@params) > 2) {
$ret_html = "ERROR: Wrong URL \n";
return ("text/plain; charset=ISO-8859-1", $ret_html);
}
my $view = $params[1];
if($htmlarg ne "MyVIEWS"){
if(!defined($defs{$view})){
$ret_html = "ERROR: View $view not definde \n";
return ("text/plain; charset=ISO-8859-1", $ret_html);
}
}
$ret_html = "<!DOCTYPE html PUBLIC \"-\/\/W3C\/\/DTD HTML 4.01\/\/EN\" \"http:\/\/www.w3.org\/TR\/html4\/strict.dtd\">\n";
$ret_html .= "<html>\n";
$ret_html .= "<head>\n";
# Select CSS-Style-Sheet
my $css = $attr{global}{VIEW_CSS};
if($css eq ""){$ret_html .= "<link href=\"$FW_ME/style.css\" rel=\"stylesheet\"/>\n";}
else {$ret_html .= "<link href=\"$FW_ME/$css\" rel=\"stylesheet\"/>\n";}
$ret_html .= "<title>FHEM VIEWS<\/title>\n";
$ret_html .= "<\/head>\n";
$ret_html .= "<body>\n";
# DIV HDR
$ret_html .= &VIEW_CGI_TOP($view);
# DIV LEFT
$ret_html .= &VIEW_CGI_LEFT();
# DIV RIGHT
if($view) {
$ret_html .= &VIEW_CGI_RIGHT($view);
}
else{
$ret_html .= "<div id=\"content\">\n";
$ret_html .= "</div>\n";
}
# HTML
$ret_html .= "</body>\n";
$ret_html .= "</html>\n";
return ("text/html; charset=ISO-8859-1", $ret_html);
}
#-------------------------------------------------------------------------------
sub VIEW_CGI_TOP($) {
my $v = shift(@_);
# rh = return-Html
my $rh;
$rh = "<div id=\"hdr\">\n";
$rh .= "<form method=\"get\" action=\"" . $FW_ME . "\">\n";
$rh .= "<table WIDTH=\"100%\">\n";
$rh .= "<tr>";
if($v) {
$rh .= "<td><a href=\"" . $FW_ME . "\">FHEM:</a>$v</td>";
}
else {
$rh .= "<td><a href=\"" . $FW_ME . "\">FHEM:</a></td>";
}
$rh .= "<td><input type=\"text\" name=\"cmd\" size=\"30\"/></td>";
$rh .= "</tr>\n";
$rh .= "</table>\n";
$rh .= "</form>\n";
$rh .= "<br>\n";
$rh .= "</div>\n";
return $rh;
}
#-------------------------------------------------------------------------------
sub VIEW_CGI_LEFT(){
# rh = return-Html
my $rh;
$rh = "<div id=\"logo\"><img src=\"" . $FW_ME . "/fhem.png\"></div>";
$rh .= "<div id=\"menu\">\n";
# Print VIEWS
$rh .= "<table class=\"room\">\n";
foreach my $d (sort keys %defs) {
next if ($defs{$d}{TYPE} ne "VIEW");
$rh .= "<tr><td>";
$rh .= "<a href=\"" . $FW_ME . "/MyVIEWS/$d\">$d</a></h3>";
$rh .= "</td></tr>\n";
}
$rh .= "</table><br>\n";
$rh .= "</div>\n";
return $rh;
}
#-------------------------------------------------------------------------------
sub VIEW_CGI_RIGHT(){
my ($v) = @_;
# rh = return-Html
my $rh;
# Filters ViewRegExType ViewRegExName ViewRegExReading
my $f_type = ".*";
if(defined($attr{$v}{ViewRegExType})) {
$f_type = $attr{$v}{ViewRegExType};
}
my $f_name = ".*";
if(defined($attr{$v}{ViewRegExName})){
$f_name = $attr{$v}{ViewRegExName};
}
my $f_reading = ".*";
if(defined($attr{$v}{ViewRegExReading})) {
$f_reading = $attr{$v}{ViewRegExReading};
}
my $f_reading_val = ".*";
if(defined($attr{$v}{ViewRegExReadingStringCompare})) {
$f_reading_val = $attr{$v}{ViewRegExReadingStringCompare};
}
my $row = 1;
$rh = "<div id=\"content\">\n";
$rh .= "<hr>\n";
$rh .= "[RegEx] Type: \"$f_type\" Name: \"$f_name\" Reading: \"$f_reading\" Value:\"$f_reading_val\"\n";
$rh .= "<hr>\n";
my ($d,$r,$tr_class);
my $th = undef;
# Get Devices and Readings
foreach $d (sort keys %defs){
if($defs{$d}{TYPE} =~ m/$f_type/ && $d =~ m/$f_name/){
# Log 0,"VIEW-RIGHT: Device-Match $d";
# Weblink
my $web_rt;
if($defs{$d}{TYPE} eq "weblink" && $f_reading eq ".*" && $f_reading_val eq ".*") {
$rh .= "<table class=\"block\">\n";
$rh .="<tr><td>WEBLINK: $d</td></tr>\n";
# $rh .= FW_showWeblink($d, $defs{$d}{LINK}, $defs{$d}{WLTYPE});
$rh .= VIEW_showWeblink($d, $defs{$d}{LINK}, $defs{$d}{WLTYPE});
# Log 0,"VIEW-RIGHT: FW_showWeblink \n $web_rt\n";
# FW_showWeblink($d, $defs{$d}{LINK}, $defs{$d}{WLTYPE});
# Log 0,"VIEW-RIGHT: Render-Weblink $d";
$rh .= "</table>\n";
}
else {
foreach $r (sort keys %{$defs{$d}{READINGS}}) {
if($r =~ m/$f_reading/) {
# ViewRegExReadingStringCompare
if($defs{$d}{READINGS}{$r}{VAL} =~ m/$f_reading_val/){
$tr_class = $row?"odd":"even";
if(!$th) {
$rh .= "<br>\n";
$rh .= "<table class=\"block\" id=\"" . $defs{$d}{TYPE} . "\" >\n";
$rh .= "<tr class=\"" . $tr_class . "\">";
$rh .= "<td align=\"left\"><a href=\"$FW_ME?detail=$d\">$d</a></td>";
if(defined($attr{$d}{comment})) {
$rh .= "<td>" . $attr{$d}{comment} . "</td>";
}
else {
$rh .= "<td>" . $defs{$d}{TYPE} . "</td>";
}
$rh .= "<td>" . $defs{$d}{STATE} . "</td>";
$rh .= "</tr>\n";
$th = 1;
$row = ($row+1)%2;
$tr_class = $row?"odd":"even";
}
$rh .= "<tr class=\"" . $tr_class . "\">";
$rh .= "<td>$r</td>";
$rh .= "<td>" . $defs{$d}{READINGS}{$r}{VAL} . "</td>";
$rh .= "<td>" . $defs{$d}{READINGS}{$r}{TIME} . "</td>";
$rh .= "</tr>\n";
$row = ($row+1)%2;
# ViewRegExReadingStringCompare
}
}
}
$rh .= "</table>\n";
}
}
$th = undef;
}
$rh .= "</div>\n";
return $rh;
}
#-------------------------------------------------------------------------------
sub VIEW_showWeblink($$$)
{
# Customized Function from 01_FHEMWEB.pm
my $FW_plotmode = "gnuplot-scroll";
my $FW_plotsize = "800,225";
my ($d, $v, $t) = @_;
my $rh;
if($t eq "link") {
$rh .= "<td><a href=\"$v\">$d</a></td>\n"; # no pH, want to open extra browser
}
elsif($t eq "image") {
$rh .= "<td><img src=\"$v\"><br>";
$rh .= "<a href=\"$FW_ME?detail=$d\">$d</a>";
$rh .= "</td>\n";
}
elsif($t eq "fileplot") {
my @va = split(":", $v, 3);
if(@va != 3 || !$defs{$va[0]} || !$defs{$va[0]}{currentlogfile}) {
$rh .= "<td>Broken definition: $v</td>\n";
}
else {
if($va[2] eq "CURRENT") {
$defs{$va[0]}{currentlogfile} =~ m,([^/]*)$,;
$va[2] = $1;
}
$rh .= "<table><tr><td>";
my $wl = "&amp;pos=";
my $arg="$FW_ME?cmd=showlog $d $va[0] $va[1] $va[2]$wl";
if(AttrVal($d,"plotmode",$FW_plotmode) eq "SVG") {
my ($w, $h) = split(",", AttrVal($d,"plotsize",$FW_plotsize));
$rh .= "<embed src=\"$arg\" type=\"image/svg+xml\"" .
"width=\"$w\" height=\"$h\" name=\"$d\"/>\n";
}
else {
$rh .= "<img src=\"$arg\"/>";
}
$rh .= "</td>\n";
$rh .= "<td><a href=\"$FW_ME?detail=$d\">$d</a></td>\n";
$rh .= "</tr></table>";
}
}
}
#-------------------------------------------------------------------------------
1;

365
contrib/contrib/97_GROUP.pm Normal file
View File

@ -0,0 +1,365 @@
################################################################################
# 97 GROUP
# Feedback: http://groups.google.com/group/fhem-users
# Logging to RRDs
# Autor: a[PUNKT]r[BEI]oo2p[PUNKT]net
# Stand: 31.03.2010
# Version: 1.1.0
# Update 08/2010
# Support for New-Style-Sheets div=menu div=content
# Added SpecialReading DNW
################################################################################
# Usage:
# define <New-Group-Name> GROUP <CATEGORY>
# set <New-Group-Name> ADD/DEL <NAME>:<DEVICENAME>:<READING>
# READING-VALUES are first searched there $hash{<DEVICENAME>}{READINGS}{<READING>}
# and for the second there $hash{<DEVICENAME>}{<READING>}
#
# Special READINGs
# FHT-Device and READING = DNW
# Displays: Day-Temp Night-Temp WindowOpen-Temp: D:22.00 N:18.00 W:5.50
#
# Special Categories:
# SHOWLEFT -> DisplayName & Value appear on the Left-Side (DIV-Left)
#
# Unkown READINGS appear as "???"
# Unkown TimeStamps appear as "****-**-** **:**:**"
################################################################################
package main;
use strict;
use warnings;
use Data::Dumper;
use vars qw(%data);
#-------------------------------------------------------------------------------
sub GROUP_Initialize($)
{
my ($hash) = @_;
$hash->{DefFn} = "GRP_Define";
$hash->{SetFn} = "GRP_Set";
$hash->{UndefFn} = "GRP_Undef";
$hash->{AttrList} = "loglevel:0,5";
# CGI
my $name = "GROUPS";
my $fhem_url = "/" . $name ;
$data{FWEXT}{$fhem_url}{FUNC} = "GRP_CGI";
$data{FWEXT}{$fhem_url}{LINK} = $name;
$data{FWEXT}{$fhem_url}{NAME} = $name;
# Special READINGs
$data{GROUP}{READINGS}{DNW} = "GRP_GET_READING_DNW";
return undef;
}
#-------------------------------------------------------------------------------
sub GRP_Define(){
# define <GROUP-NMAE> GROUP <CATEGORY-NAME>
# If no Cat is defined:<GROUP-NMAE> = <CATEGORY-NAME>
my ($self, $defs) = @_;
my $name = $self->{NAME};
# defs = $a[0] <GROUP-DEVICE-NAME> $a[1] GROUP $a[2]<CATEGORY-NAME>;
my @a = split(/ /, $defs);
# CATEGORY
my $cat = $name;
if(int(@a) gt 2){$cat = $a[2];}
my $ret = &GRP_HANDLE_CAT($name,$cat);
# Save cat to State
$self->{STATE} = $cat;
#Default ROOM DEF.GROUP
$attr{$self->{NAME}}{room} = "DEF.GROUP";
return undef;
}
#-------------------------------------------------------------------------------
sub GRP_Undef(){
my ($self, $name) = @_;
# $dc = Device-Count in categorie
my $dc = 1;
if(defined($modules{GROUP}{defptr})) {
foreach my $d (sort keys %{$modules{GROUP}{defptr}}){
if(defined($modules{GROUP}{defptr}{$d}{$name})){
delete $modules{GROUP}{defptr}{$d}{$name};
$dc = keys(%{$modules{GROUP}{defptr}{$d}});
}
# Delete empty Categories
if($dc eq 0) {
Log 0, "GROUP UNDEF DELETE CAT: $d";
delete $modules{GROUP}{defptr}{$d};
};
}
}
$dc = 1;
if(defined($modules{GROUP}{conf})) {
foreach my $c (sort keys %{$modules{GROUP}{conf}}){
if(defined($modules{GROUP}{conf}{$c}{$name})){
delete $modules{GROUP}{conf}{$c}{$name};
$dc = keys(%{$modules{GROUP}{conf}{$c}});
}
# Delete empty Categories
if($dc eq 0) {
Log 0, "GROUP UNDEF DELETE CAT: $c";
delete $modules{GROUP}{defptr}{$c};
};
}
}
# ??? empty CAT is left ???
# Check for empty categories
return undef;
}
#-------------------------------------------------------------------------------
sub GRP_Set()
{
# set <NAME> ADD/DEL <NAME>:<DEVICE-NAME>:<READING>
# @a => a[0]:<NAME>; a[1]=ADD; a[2]= <DEVICE-NAME>:<READING>
my ($self, @a) = @_;
# FHEMWEB Question....select
return "GROUP Unknown argument $a[1], choose one of ". join(" ",sort keys %{$self->{READINGS}}) if($a[1] eq "?");
# ADD
if($a[1] eq "ADD") {
my ($name,$dev,$reading) = split(/:/,$a[2]);
if(!defined($defs{$dev})){return "Device unkwon";}
$self->{READINGS}{$name}{VAL} = $dev . ":" . $reading;
$self->{READINGS}{$name}{TIME} = TimeNow();
}
if($a[1] eq "DEL") {
delete $self->{READINGS}{$a[2]};
}
# Set GROUP-CAT
# set <NAME> CAT <CATEGORY-NAME>
if($a[1] eq "CAT") {
$self->{STATE} = $a[2];
}
return undef;
}
#-------------------------------------------------------------------------------
sub GRP_CGI()
{
my ($htmlarg) = @_;
# htmlarg = /GROUPS/<CAT-NAME>
my $Cat = GRP_CGI_DISPTACH_URL($htmlarg);
Log 0,"GROUPS-FW-FEHM: $FW_ME";
if(!defined($Cat)){$Cat = ""};
my ($ret_html);
$ret_html = "<!DOCTYPE html PUBLIC \"-\/\/W3C\/\/DTD HTML 4.01\/\/EN\" \"http:\/\/www.w3.org\/TR\/html4\/strict.dtd\">\n";
$ret_html .= "<html>\n";
$ret_html .= "<head>\n";
$ret_html .= &GRP_CGI_CSS();
$ret_html .= "<title>FHEM GROUPS<\/title>\n";
$ret_html .= "<link href=\"$FW_ME/style.css\" rel=\"stylesheet\"/>\n";
$ret_html .= "<\/head>\n";
$ret_html .= "<body>\n";
# DIV HDR
$ret_html .= &GRP_CGI_TOP($Cat);
# DIV LEFT
$ret_html .= &GRP_CGI_LEFT($Cat);
# DIV RIGHT
$ret_html .= &GRP_CGI_RIGHT($Cat);
# HTML
$ret_html .= "</body>\n";
$ret_html .= "</html>\n";
return ("text/html; charset=ISO-8859-1", $ret_html);
}
#-------------------------------------------------------------------------------
sub GRP_CGI_CSS() {
my $css;
$css = "<style type=\"text/css\"><!--\n";
$css .= "\#left {float: left; width: 15%; height:100%;}\n";
$css .= "table.GROUP { border:thin solid; background: #E0E0E0; text-align:left;}\n";
$css .= "table.GROUP tr.odd { background: #F0F0F0;}\n";
$css .= "table.GROUP td {nowrap;}";
$css .= "\/\/--><\/style>";
# TEST
#$css = "<link href=\"$FW_ME/group.css\" rel=\"stylesheet\"/>\n";
return $css;
}
#-------------------------------------------------------------------------------
sub GRP_CGI_TOP($) {
my $CAT = shift(@_);
# rh = return-Html
my $rh;
$rh = "<div id=\"hdr\">\n";
$rh .= "<form method=\"get\" action=\"" . $FW_ME . "\">\n";
$rh .= "<table WIDTH=\"100%\">\n";
$rh .= "<tr>";
$rh .= "<td><a href=\"" . $FW_ME . "\">FHEM:</a>$CAT</td>";
$rh .= "<td><input type=\"text\" name=\"cmd\" size=\"30\"/></td>";
$rh .= "</tr>\n";
$rh .= "</table>\n";
$rh .= "</form>\n";
$rh .= "<br>\n";
$rh .= "</div>\n";
return $rh;
}
#-------------------------------------------------------------------------------
sub GRP_CGI_LEFT(){
# rh = return-Html
my $rh;
# $rh = "<div id=\"left\">\n";
$rh = "<div id=\"logo\"><img src=\"" . $FW_ME . "/fhem.png\"></div>";
$rh .= "<div id=\"menu\">\n";
# Print Groups
$rh .= "<table class=\"room\">\n";
foreach my $g (sort keys %{$modules{GROUP}{defptr}}){
$rh .= "<tr><td>";
$rh .= "<a href=\"" . $FW_ME . "/GROUPS/$g\">$g</a></h3>";
$rh .= "</td></tr>\n";
}
$rh .= "</table><br>\n";
#SHOWLEFT
if(defined($modules{GROUP}{conf}{SHOWLEFT})){
$rh .= "<table class=\"room\">\n";
foreach my $g (sort keys %{$modules{GROUP}{conf}{SHOWLEFT}}){
#Tabelle
$rh .= "<tr><th>$g</th><th></th></tr>\n";
foreach my $r (sort keys %{$defs{$g}{READINGS}}){
# $dn = DeviceName + $rn = Readingname to get ReadingValue
my ($dn,$rn) = split(/:/,$defs{$g}{READINGS}{$r}{VAL});
# $rv = ReadingValue; $rt = ReadingTime; $ru = ReadingUnit
my ($rv,undef,undef) = &GRP_GET_READING_VAL($dn,$rn);
$rh .= "<tr><td>$r</td><td>$rv</td></tr>\n";
}
}
$rh .= "</table>\n";
}
$rh .= "</div>\n";
return $rh;
}
#-------------------------------------------------------------------------------
sub GRP_CGI_RIGHT(){
my ($CAT) = @_;
my ($name,$device,$reading,$value,$vtime,$rh,$tr_class,$comment);
# rh = return-Html
my $row = 1;
# Table GROUP
# Name | Value | Time | Device-Type
# $rh = "<div id=\"right\">\n";
$rh = "<div id=\"content\">\n";
# Category -> DEVICE
foreach my $c (sort keys %{$modules{GROUP}{defptr}{$CAT}}){
# Log 0,"GROUP CGI-RIGHT DEV: $c";
$rh .= "<table class=\"GROUP\" WIDTH=\"85%\">\n";
$rh .= "<tr>";
$rh .= "<th align=\"left\" WIDTH=\"10%\"><a href=\"$FW_ME?detail=$c\">$c</a></th>";
$rh .= "<th align=\"left\" WIDTH=\"8%\"></th>";
if(defined($attr{$c}{comment})){
$comment = $attr{$c}{comment};
$rh .= "<th align=\"left\" WIDTH=\"20%\" colspan=\"2\">$comment</th>";}
else {
$rh .= "<th align=\"left\" WIDTH=\"10%\"></th>";
$rh .= "<th align=\"left\" WIDTH=\"10%\"></th>";}
$rh .= "</tr>\n";
# GROUP -> READING
foreach my $r (sort keys %{$defs{$c}{READINGS}}){
# $dn = DeviceName + $rn = Readingname to get ReadingValue
my ($dn,$rn) = split(/:/,$defs{$c}{READINGS}{$r}{VAL});
# $rv = ReadingValue; $rt = ReadingTime; $ru = ReadingUnit
my ($rv,$rt,$ru) = &GRP_GET_READING_VAL($dn,$rn);
$tr_class = $row?"odd":"even";
$rh .= "<tr class=\"" . $tr_class . "\"><td>$r</td><td>$rv&nbsp;$ru</td><td>$rt</td>";
$rh .= "<td><a href=\"$FW_ME?detail=$dn\">$dn</a></td></tr>\n";
$row = ($row+1)%2;
}
$rh .= "</table><br>\n";
}
$rh .= "</div>\n";
return $rh;
}
#-------------------------------------------------------------------------------
sub GRP_CGI_DISPTACH_URL($){
my ($htmlarg) = @_;
my @params = split(/\//,$htmlarg);
my $CAT = undef;
if($params[2]) {
$CAT = $params[2];
# Log 0,"GRP URL-DISP-CAT: " . $CAT;
}
return $CAT;
}
#-------------------------------------------------------------------------------
sub GRP_HANDLE_CAT($$){
my($device,$cat) = @_;
# Normal Categories -> %modules{GROUP}{defptr}{<CAT-NAME>}{<GROUP-DEVICE-NAME>}
# Spezial Categories -> %modules{GROUP}{conf}{<CAT-NAME>}{<GROUP-DEVICE-NAME>}
if($cat eq "SHOWLEFT") {
# Log 0,"GRP CAT-DISP-> SHOWLEFT -> $cat -> $device";
$modules{GROUP}{conf}{$cat}{$device} = 1;
return undef;
}
$modules{GROUP}{defptr}{$cat}{$device} = 1;
return undef;
}
#-------------------------------------------------------------------------------
sub GRP_GET_READING_VAL($$){
# IN $dn = DeviceName; $rn = ReadingName
my($dn,$rn) = @_;
# OUT $rv = ReadingValue; $rt = ReadingTime; $ru = ReadingUnit
# Default Values
my $rv = "???";
my $rt = "****-**-** **:**:**";
my $ru = "";
# First $hash->{READINGS}
if(defined($defs{$dn}{READINGS}{$rn}{VAL})) {
$rv = $defs{$dn}{READINGS}{$rn}{VAL};
$rt = $defs{$dn}{READINGS}{$rn}{TIME};
}
if($rv =~ m/ /){
my @a = split(/ /, $rv);
$rv = $a[0];
$ru = $a[1];
}
if($rv =~ /\d{1}/) {
$rv = sprintf("%.2f", $rv);
}
# Log 0,"GROUP GET-READING: $rv,$rt,$ru";
# Second $hash
# First Wins
if(defined($defs{$dn}{$rn}) && $rv eq "???"){
$rv = $defs{$dn}{$rn};
$rt = " ";
}
# third Special READINGs
if(defined($data{GROUP}{READINGS}{$rn}) && $rv eq "???" ){
my $rv_function = $data{GROUP}{READINGS}{$rn};
Log 0, "GROUP SP-READINGS Func: " . $rv_function;
no strict "refs";
if(defined(&$rv_function)){
my ($rv_return,$rt_return) = &$rv_function($dn,$rn);
# On ERROR return undef
if($rv_return) {
$rv = $rv_return;
$rt = $rt_return;
}
}
use strict "refs";
}
# Log 0,"GROUP GET-READING: $rv,$rt,$ru";
return ($rv,$rt,$ru);
}
#-------------------------------------------------------------------------------
sub GRP_GET_READING_DNW($$){
# FHT-Device and READING = DNW
# Displays: Day-Temp Night-Temp WindowOpen-Temp: D:22.00 N:18.00 W:5.50
# IN $dn = DeviceName; $rn = ReadingName
my($dn,$rn) = @_;
# Type = FHT ???
if($defs{$dn}{TYPE} ne "FHT"){return undef;}
my($day,$night,$window,$rv_time);
$day = "??";
$night = "??";
$window = "??";
$rv_time = "--";
if(defined($defs{$dn}{READINGS}{'day-temp'}{VAL})) {
$day = $defs{$dn}{READINGS}{'day-temp'}{VAL};
}
if(defined($defs{$dn}{READINGS}{'day-temp'}{TIME})) {
$rv_time = $defs{$dn}{READINGS}{'day-temp'}{TIME};
}
if(defined($defs{$dn}{READINGS}{'night-temp'}{VAL})) {
$night = $defs{$dn}{READINGS}{'night-temp'}{VAL};
}
if(defined($defs{$dn}{READINGS}{'windowopen-temp'}{VAL})) {
$window = $defs{$dn}{READINGS}{'windowopen-temp'}{VAL};
}
# Retunr Value
my $rv = "D:$day N:$night W:$window";
return ($rv,$rv_time);
}
1;

519
contrib/contrib/98_FHTCONF.pm Executable file
View File

@ -0,0 +1,519 @@
################################################################################
# 98_FHTCONF.pm
#
# Version: 1.5
# Stand: 09/2010
# Autor: Axel Rieger
# a[PUNKT]r[BEI]oo2p[PUNKT]net
#
# Configure multiple FHT´s
# Usage: define <NAME> FHTCONF
# FHTConf-Name: FHTC01
# Assign FHTROOM...All FHT´s in this Room will be configured
# FHEM: define FHTC01 FHTCONF
# FHEM: attr FHTC01 FHTRoom R01
# Assign FHT-Device to FHTRoom
# FHEM: attr <FHT-Name> room R01
# Get a list of FHT-Devices in FHTRoom:
# FHEM: set FHTC01 A0_FHT_DEVICES
#
# Update:
# 09/2010 Added PRIV-CGI OverView
#
################################################################################
package main;
use strict;
use warnings;
use Data::Dumper;
use vars qw(%data);
use vars qw(%cmds);
use vars qw(%attr);
# FHEM Command to Update FHTs
sub Commandfhtconf($);
################################################################################
sub FHTCONF_Initialize($)
{
my ($hash) = @_;
$hash->{SetFn} = "FHTCONF_Set";
$hash->{DefFn} = "FHTCONF_Define";
$hash->{AttrList} = "loglevel:0,5 disable:0,1 FHTRoom";
# FHEM Command to Update FHTs
$cmds{fhtconf}{Fn} = "Commandfhtconf";
$cmds{fhtconf}{Hlp} = "FHTCONF[HELP]: fhtconf <FHTCONF-NAME>";
# FHTCONF CGI
my $name = "FHTCONF";
my $fhem_url = "/" . $name ;
$data{FWEXT}{$fhem_url}{FUNC} = "FHTCONF_CGI";
$data{FWEXT}{$fhem_url}{LINK} = $name;
$data{FWEXT}{$fhem_url}{NAME} = $name;
Log 0, "FHEM-MODUL[98_FHTCONF.pm] LOADED";
}
################################################################################
sub FHTCONF_Define($)
{
my ($hash, @a) = @_;
return "Wrong syntax: use define <name> fht_conf" if(int(@a) !=1 );
# Default Room
my $room = "GRP.FHTCONF";
my $name = $hash->{NAME};
#Room
$attr{$name}{room} = $room;
# State
$hash->{STATE} = "Created " . TimeNow();
return undef;
}
################################################################################
sub FHTCONF_Set($)
{
my ($hash, @a) = @_;
# 4 Argumente
# 1. Device Selbst als HASH
# $a[0] => Device Name als String
# $a[1] => Reading
# $a[2] => Value for READING
my $fields;
$fields = join(" ",sort keys %{$hash->{READINGS}});
$fields = "A1_mode A2_day_temp A2_night_temp ";
$fields .= "A2_windowopen_temp A2_lowtemp_offset ";
$fields .= "B0_MONTAG B1_DIENSTAG B2_MITTWOCH B3_DONNERSTAG B4_FREITAG B5_SAMSTAG B6_SONNTAG ";
return "Unknown argument $a[1], choose one of ". $fields if($a[1] eq "?");
my ($name,$room);
$name = $hash->{NAME};
# LogLevel
my $ll = 0;
if(defined($attr{$name}{loglevel})) {$ll = $attr{$name}{loglevel};}
# INIT READINGS
if(!defined($defs{$name}{READINGS}{Z0_INIT})) {
&FHTCONF_init_READINGS($name);
}
# A0_FHT_DEVICES => List of FHT-Devices in Room <FHTRoom>
if($a[1] eq "A0_FHT_DEVICES") {
if(defined($attr{$name}{FHTRoom})){
$room = $attr{$name}{FHTRoom};
my $fht_devices = GetDevType_Room($room);
Log 0, "FHTCONF[SET] => FHT_DEVICES Room:$room -> " . $fht_devices;
$a[2] = $fht_devices;
}
else {return "FHTCONF[ERROR] no FHTRoom defined";}
}
# A1_mode FHT Modes ----------------------------------------------------------
if($a[1] eq "A1_mode") {
Log 0, "FHT_CONF|SET|MODE-Values: auto,manual,holiday,holiday_short";
my $mode_value_ok = undef;
my @mode_values = ("auto","manual","holiday","holiday_short");
foreach my $value(@mode_values) {
if($a[2] =~ /$value/){
$mode_value_ok = 1;
}
}
if(!$mode_value_ok) {return "FHTCONF[ERROR] MODE $a[2]: choose on of auto,manual,holiday,holiday_short";}
}
# FHT-Temperatures => NUR Ziffern und EIN Punkt [0-9.] -----------------------
if($a[1] =~ /^A2/) {
if($a[2] =~ /[^0-9.]/) {
return "FHTCONF|$a[2]|ERROR|wrong format: 00.00";
}
if($a[1] ne "A2_lowtemp_offset" && $a[2] < 5.5) {$a[2] = 5.5};
Log 0, "FHTCONF[SET] => Temperatures => $a[1] = $a[2]";
}
# B* FHT-Times
if($a[1] =~ /^B/) {
# Time Values
# Sort-Array @b = sort(@b)
# Values = 12:00;13:00 => mindestens 2 maximal 4; kein Wert über 24
my @times = split(/\|/,$a[2]);
Log 0, "FHT_TIMES[INFO] times = " . @times;
if (@times ne 2 && @times ne 4) {
return "FHT_TIMES[ERROR] Wrong Argument count";}
foreach my $time (@times) {
if (not ($time =~ /([01][0-9]:[0-4])|[0-5][0-9]/) ) {
return "FHT_TIMES[ERROR] $time => 00:00";}
}
# Allwas 4 Values 24:00|24:00|24:00|24:00
if(@times == 2) {push(@times,"24:00");}
if(@times == 3) {push(@times,"24:00");}
# Sort
@times = sort(@times);
$a[2] = join("|", @times);
}
# Set READINGs
$hash->{READINGS}{$a[1]}{TIME} = TimeNow();
$hash->{READINGS}{$a[1]}{VAL} = $a[2];
return undef;
}
################################################################################
sub Commandfhtconf($)
{
my ($cl, $dn) = @_;
# $dn = FHTCONF Device-Name
# Device exists
if(!defined($defs{$dn})){
Log 0, "FHTCONF CMD Device $dn not found";
return undef;
}
# Type FHTCONF
if($defs{$dn}{TYPE} ne "FHTCONF") {
Log 0, "FHTCONF CMD $dn wrong Device-Type";
return undef;
}
# Device disabled
if(defined($attr{$dn}{disable})) {
Log 0, "FHTCONF CMD $dn disabled";
$defs{$dn}{STATE} = "[DISBALED] ". TimeNow();
return undef;
}
#LogLevel
my $ll = 0;
if(defined($attr{$dn}{'loglevel'})) {
$ll = $attr{$dn}{'loglevel'};
}
Log $ll, "FHTCONF-CMD: $dn";
# FHT_Devices
my ($room,$device_list_reading);
if(defined($attr{$dn}{FHTRoom})){
$room = $attr{$dn}{FHTRoom};
$device_list_reading = GetDevType_Room($room);
# GetDevType_ROOM[ERROR]: No Room"
if($device_list_reading =~ m/\[ERROR\]/) {
$defs{$dn}{STATE} = "[ERROR] ". TimeNow();
Log $ll ,"FHTCONF-CMD[ERROR] $dn: $device_list_reading";
return undef;
}
$defs{$dn}{READINGS}{A0_FHT_DEVICES}{VAL} = $device_list_reading;
$defs{$dn}{READINGS}{A0_FHT_DEVICES}{TIME} = TimeNow();
}
else {
Log 0,"FHTCONF[ERROR] no FHTRoom defined";
$defs{$dn}{STATE} = "[ERROR] No FHTRoom defined ". TimeNow();
return undef;
}
#-----------------------------------------------------------------------------
# Building FHEM-Commands to send
# fhem "set <DAVEICE-NAME> params
my (%params);
$params{"mode"} = $defs{$dn}{READINGS}{A1_mode}{VAL};
$params{"day-temp"} = $defs{$dn}{READINGS}{A2_day_temp}{VAL};
$params{"night-temp"} = $defs{$dn}{READINGS}{A2_night_temp}{VAL};
$params{"windowopen-temp"} = $defs{$dn}{READINGS}{A2_windowopen_temp}{VAL};
$params{"lowtemp-offset"} = $defs{$dn}{READINGS}{A2_lowtemp_offset}{VAL};
# Times ----------------------------------------------------------------------
# Mapping ersten drei Buchstaben Wochentag => from1 to1 bzw. from2 to2
my ($reading,@times,$j,$index);
my %weekdays = (
B0_MONTAG => ["mon-from1", "mon-to1", "mon-from2","mon-to2"],
B1_DIENSTAG=> ["tue-from1", "tue-to1", "tue-from2","tue-to2"],
B2_MITTWOCH => ["wed-from1", "wed-to1", "wed-from2","wed-to2"],
B3_DONNERSTAG => ["thu-from1", "thu-to1", "thu-from2","thu-to2"],
B4_FREITAG => ["fri-from1", "fri-to1", "fri-from2","fri-to2"],
B5_SAMSTAG => ["sat-from1", "sat-to1", "sat-from2","sat-to2"],
B6_SONNTAG => ["sun-from1", "sun-to1", "sun-from2","sun-to2"],
);
foreach $reading (sort keys %{$defs{$dn}{READINGS}}) {
next if($reading !~ /^B/);
@times = split(/\|/,$defs{$dn}{READINGS}{$reading}{VAL});
for ($j=0; $j < @times; $j++) {
$index = $weekdays{$reading}[$j];
$params{$index} = $times[$j];
}
}
# FHT-Devices ----------------------------------------------------------------
my (@fht_devices,$fht);
Log $ll ,"FHTCONF $dn update FHT-DEVICES: $device_list_reading";
@fht_devices = split(/\|/,$device_list_reading);
my ($sec,$min,$hour,$mday,$month,$year,$wday,$yday,$isdst) = localtime(time());
$month = $month + 1;
$year = $year + 1900;
my ($p,$old,$new,$at_time,$at_name,$tsecs);
# SendList
my $fhemcmd = "";
foreach $fht (@fht_devices){
foreach $p (sort keys %params){
# Send only Changes
$old = $defs{$fht}{READINGS}{$p}{VAL};
$new = $params{$p};
Log $ll, "FHTCONF-CMD-OLD: $fht -> $p -> OLD:$old NEW:$new";
if($old ne $new){
# Commands to Send
$fhemcmd .= " $p $new";
}
}
# Send Out
if($fhemcmd ne "") {
my $cmd = "set $fht" . $fhemcmd;
Log $ll, "FHTCONF-CMD-SEND: $fhemcmd";
fhem $cmd;
#Reset
$fhemcmd = "";
$cmd = "";
}
else {
Log 0, "FHTCONF-CMD-SEND: $fht No Changes";}
# Report 1&2
fhem "set $fht report1 255 report2 255";
# FHT Time&Date
fhem "set $fht hour $hour minute $min year $year month $month day $mday";
}
# Set STATE
$defs{$dn}{STATE} = "LastUpdate ". TimeNow();
return undef;
}
################################################################################
sub GetDevType_Room($){
# Get All Dives By Type from Room
# Params: GetDevType_Room <ROOM>
# GetDevType_Room
# Return: List of Devices seperated by | <PIPE>
my ($room) = @_;
my $type = "FHT";
if(!defined($room)) {return "GetDevType_ROOM[ERROR]: No Room";}
if(!defined($type)) {return "GetDevType_ROOM[ERROR]: No Type";}
my (@devices);
foreach my $d (sort keys %attr) {
if($defs{$d}{TYPE} eq $type && $attr{$d}{room} =~ /$room/ ) {
push(@devices,$d);
}
}
return join("|",@devices);
}
################################################################################
sub FHTCONF_init_READINGS($) {
my ($name) = @_;
Log 0,"FHTCONF:$name ------INIT--------------";
# Set DEFAULT Values
# FHT's
$defs{$name}{READINGS}{A0_FHT_DEVICES}{TIME} = TimeNow();
$defs{$name}{READINGS}{A0_FHT_DEVICES}{VAL} = "";
#Mode
# Values auto, manual, holiday or holiday_short
$defs{$name}{READINGS}{A1_mode}{TIME} = TimeNow();
$defs{$name}{READINGS}{A1_mode}{VAL} = "auto";
# Temperaturen...defualt 5.5 = disable
$defs{$name}{READINGS}{A2_day_temp}{TIME} = TimeNow();
$defs{$name}{READINGS}{A2_day_temp}{VAL} = "5.5";
$defs{$name}{READINGS}{A2_night_temp}{TIME} = TimeNow();
$defs{$name}{READINGS}{A2_night_temp}{VAL} = "5.5";
$defs{$name}{READINGS}{A2_windowopen_temp}{TIME} = TimeNow();
$defs{$name}{READINGS}{A2_windowopen_temp}{VAL} = "5.5";
# LowTemp-Offest
$defs{$name}{READINGS}{A2_lowtemp_offset}{TIME} = TimeNow();
$defs{$name}{READINGS}{A2_lowtemp_offset}{VAL} = "2.0";
# Montag = Monday
$defs{$name}{READINGS}{B0_MONTAG}{TIME} = TimeNow();
$defs{$name}{READINGS}{B0_MONTAG}{VAL} = "24:00|24:00|24:00|24:00";
# Dienstag = Tuesday
$defs{$name}{READINGS}{B1_DIENSTAG}{TIME} = TimeNow();
$defs{$name}{READINGS}{B1_DIENSTAG}{VAL} = "24:00|24:00|24:00|24:00";
# Mittwoch = Wednesday
$defs{$name}{READINGS}{B2_MITTWOCH}{TIME} = TimeNow();
$defs{$name}{READINGS}{B2_MITTWOCH}{VAL} = "24:00|24:00|24:00|24:00";
# Donnerstag = Thursday
$defs{$name}{READINGS}{B3_DONNERSTAG}{TIME} = TimeNow();
$defs{$name}{READINGS}{B3_DONNERSTAG}{VAL} = "24:00|24:00|24:00|24:00";
# Freitag = Friday
$defs{$name}{READINGS}{B4_FREITAG}{TIME} = TimeNow();
$defs{$name}{READINGS}{B4_FREITAG}{VAL} = "24:00|24:00|24:00|24:00";
# Samstag = Saturday
$defs{$name}{READINGS}{B5_SAMSTAG}{TIME} = TimeNow();
$defs{$name}{READINGS}{B5_SAMSTAG}{VAL} = "24:00|24:00|24:00|24:00";
# Sonntag = Sunday
$defs{$name}{READINGS}{B6_SONNTAG}{TIME} = TimeNow();
$defs{$name}{READINGS}{B6_SONNTAG}{VAL} = "24:00|24:00|24:00|24:00";
# INIT done
$defs{$name}{READINGS}{Z0_INIT}{VAL} = 1;
$defs{$name}{READINGS}{Z0_INIT}{TIME} = TimeNow();
return undef;
}
################################################################################
# FHTCONF CGI
################################################################################
sub FHTCONF_CGI() {
my ($htmlarg) = @_;
# htmlarg = /GROUPS/<CAT-NAME>
my $Cat = FHTCONF_CGI_DISPTACH_URL($htmlarg);
if(!defined($Cat)){$Cat = ""};
my ($ret_html);
$ret_html = "<!DOCTYPE html PUBLIC \"-\/\/W3C\/\/DTD HTML 4.01\/\/EN\" \"http:\/\/www.w3.org\/TR\/html4\/strict.dtd\">\n";
$ret_html .= "<html>\n";
$ret_html .= "<head>\n";
$ret_html .= &FHTCONF_CGI_CSS();
$ret_html .= "<title>FHEM GROUPS<\/title>\n";
$ret_html .= "<link href=\"$__ME/style.css\" rel=\"stylesheet\"/>\n";
$ret_html .= "<\/head>\n";
$ret_html .= "<body>\n";
# DIV HDR
$ret_html .= &FHTCONF_CGI_TOP($Cat);
# DIV LEFT
$ret_html .= &FHTCONF_CGI_LEFT($Cat);
# DIV RIGHT
if($Cat ne "") {
$ret_html .= &FHTCONF_CGI_RIGHT($Cat);
}
# HTML
$ret_html .= "</body>\n";
$ret_html .= "</html>\n";
return ("text/html; charset=ISO-8859-1", $ret_html);
}
#-------------------------------------------------------------------------------
sub FHTCONF_CGI_DISPTACH_URL($){
my ($htmlarg) = @_;
my @params = split(/\//,$htmlarg);
my $CAT = undef;
if($params[2]) {
$CAT = $params[2];
# Log 0,"GRP URL-DISP-CAT: " . $CAT;
}
return $CAT;
}
#-------------------------------------------------------------------------------
sub FHTCONF_CGI_CSS() {
my $css;
$css = "<style type=\"text/css\"><!--\n";
$css .= "\#left {float: left; width: 15%; height:100%;}\n";
$css .= "table.GROUP { border:thin solid; background: #E0E0E0; text-align:left;}\n";
$css .= "table.GROUP tr.odd { background: #F0F0F0;}\n";
$css .= "table.GROUP td {nowrap;}";
$css .= "\/\/--><\/style>";
# TEST
#$css = "<link href=\"$__ME/group.css\" rel=\"stylesheet\"/>\n";
return $css;
}
#-------------------------------------------------------------------------------
sub FHTCONF_CGI_TOP($) {
my $CAT = shift(@_);
# rh = return-Html
my $rh;
$rh = "<div id=\"hdr\">\n";
$rh .= "<form method=\"get\" action=\"" . $__ME . "\">\n";
$rh .= "<table WIDTH=\"100%\">\n";
$rh .= "<tr>";
$rh .= "<td><a href=\"" . $__ME . "\">FHEM:</a>$CAT</td>";
$rh .= "<td><input type=\"text\" name=\"cmd\" size=\"30\"/></td>";
$rh .= "</tr>\n";
$rh .= "</table>\n";
$rh .= "</form>\n";
$rh .= "<br>\n";
$rh .= "</div>\n";
return $rh;
}
#-------------------------------------------------------------------------------
sub FHTCONF_CGI_LEFT(){
# rh = return-Html
my $rh;
$rh = "<div id=\"logo\"><img src=\"" . $__ME . "/fhem.png\"></div>";
$rh .= "<div id=\"menu\">\n";
# Print FHTCONF-Devices
$rh .= "<table class=\"room\">\n";
foreach my $d (sort keys %defs) {
next if($defs{$d}{TYPE} ne "FHTCONF");
$rh .= "<tr><td>";
$rh .= "<a href=\"" . $__ME . "/FHTCONF/$d\">$d</a></h3>";
$rh .= "</td></tr>\n";
}
$rh .= "</table>\n";
$rh .= "</div>\n";
return $rh;
}
#-------------------------------------------------------------------------------
sub FHTCONF_CGI_RIGHT(){
my ($CAT) = @_;
my ($rh,$fhtroom,$fht,@fhts,@ft,@fp,$fht_list);
$fhtroom = $attr{$CAT}{FHTRoom};
$fht_list = GetDevType_Room($fhtroom);
$rh = "<div id=\"content\">\n";
if($CAT eq "") {$CAT = "***";}
# $rh .="CAT: " . $CAT . " FHTROOM:" . $fhtroom . "<br>\n";
# $rh .= "FHT-Devices: " . $fht_list . "<br>\n";
$rh .= "<table>\n";
# Tabelle
# Zeile - Row Namen FHTCONFDevice FHT-Devices
$fp[0] .= "<th></th>";
$fp[1] .= "<td></td>";
$fp[2] .= "<td>IODEV</td>";
$fp[3] .= "<td>Warnings</td>";
$fp[4] .= "<td></td>";
$fp[5] .= "<td>Mode</td>";
$fp[6] .= "<td>Day-Temp</td>";
$fp[7] .= "<td>LowTemp-OffSet</td>";
$fp[8] .= "<td>Night-Temp</td>";
$fp[9] .= "<td>WindowOpen-Temp</td>";
$fp[10] .= "<td></td>";
$fp[11] .= "<td>Montag</td>";
$fp[12] .= "<td>Dienstag</td>";
$fp[13] .= "<td>Mittwoch</td>";
$fp[14] .= "<td>Donnerstag</td>";
$fp[15] .= "<td>Freitag</td>";
$fp[16] .= "<td>Samstag</td>";
$fp[17] .= "<td>Sonntag</td>";
$fp[18] .= "<td></td>";
#Values FHTCONF-Device
$fp[0] .= "<th><a href=\"$__ME?detail=$CAT\">$CAT</a></th>";
# $fp[0] .= "<th>" . $CAT . "</th>";
$fp[1] .= "<td></td>";
$fp[2] .= "<td></td>";
$fp[3] .= "<td></td>";
$fp[4] .= "<td></td>";
$fp[5] .= "<td>" . $defs{$CAT}{READINGS}{A1_mode}{VAL} . "</td>";
$fp[6] .= "<td>" . $defs{$CAT}{READINGS}{A2_day_temp}{VAL} . "</td>";
$fp[7] .= "<td>" . $defs{$CAT}{READINGS}{A2_lowtemp_offset}{VAL} . "</td>";
$fp[8] .= "<td>" . $defs{$CAT}{READINGS}{A2_night_temp}{VAL} . "</td>";
$fp[9] .= "<td>" . $defs{$CAT}{READINGS}{A2_windowopen_temp}{VAL} . "</td>";
$fp[10] .= "<td></td>";
$fp[11] .= "<td>" . $defs{$CAT}{READINGS}{B0_MONTAG}{VAL} . "</td>";
$fp[12] .= "<td>" . $defs{$CAT}{READINGS}{B1_DIENSTAG}{VAL} . "</td>";
$fp[13] .= "<td>" . $defs{$CAT}{READINGS}{B2_MITTWOCH}{VAL} . "</td>";
$fp[14] .= "<td>" . $defs{$CAT}{READINGS}{B3_DONNERSTAG}{VAL} . "</td>";
$fp[15] .= "<td>" . $defs{$CAT}{READINGS}{B4_FREITAG}{VAL} . "</td>";
$fp[16] .= "<td>" . $defs{$CAT}{READINGS}{B5_SAMSTAG}{VAL} . "</td>";
$fp[17] .= "<td>" . $defs{$CAT}{READINGS}{B6_SONNTAG}{VAL} . "</td>";
$fp[18] .= "<td></td>";
# FHT Devices
@fhts = split(/\|/,$fht_list);
foreach $fht (@fhts){
$fp[0] .= "<th><a href=\"$__ME?detail=$fht\">$fht</a></th>";
# $fp[0] .= "<th>" . $fht . "</td>";
$fp[1] .= "<td></td>";
$fp[2] .= "<td>" . $attr{$fht}{IODev} . "</td>";
$fp[3] .= "<td>" . $defs{$fht}{READINGS}{warnings}{VAL} . "</td>";
$fp[4] .= "<td></td>";
$fp[5] .= "<td>" . $defs{$fht}{READINGS}{mode}{VAL} . "</td>";
$fp[6] .= "<td>" . $defs{$fht}{READINGS}{'day-temp'}{VAL} . "</td>";
$fp[7] .= "<td>" . $defs{$fht}{READINGS}{'lowtemp-offset'}{VAL} . "</td>";
$fp[8] .= "<td>" . $defs{$fht}{READINGS}{'night-temp'}{VAL} . "</td>";
$fp[9] .= "<td>" . $defs{$fht}{READINGS}{'windowopen-temp'}{VAL} . "</td>";
$fp[10] .= "<td></td>";
$fp[11] .= "<td>" . $defs{$fht}{READINGS}{'mon-from1'}{VAL} . "|" . $defs{$fht}{READINGS}{'mon-to1'}{VAL} . "|";
$fp[11] .= $defs{$fht}{READINGS}{'mon-from2'}{VAL} . "|" . $defs{$fht}{READINGS}{'mon-to2'}{VAL} . "</td>";
$fp[12] .= "<td>" . $defs{$fht}{READINGS}{'tue-from1'}{VAL} . "|" . $defs{$fht}{READINGS}{'tue-to1'}{VAL} . "|";
$fp[12] .= $defs{$fht}{READINGS}{'tue-from2'}{VAL} . "|" . $defs{$fht}{READINGS}{'tue-to2'}{VAL} . "</td>";
$fp[13] .= "<td>" . $defs{$fht}{READINGS}{'wed-from1'}{VAL} . "|" . $defs{$fht}{READINGS}{'wed-to1'}{VAL} . "|";
$fp[13] .= $defs{$fht}{READINGS}{'wed-from2'}{VAL} . "|" . $defs{$fht}{READINGS}{'wed-to2'}{VAL} . "</td>";
$fp[14] .= "<td>" . $defs{$fht}{READINGS}{'thu-from1'}{VAL} . "|" . $defs{$fht}{READINGS}{'thu-to1'}{VAL} . "|";
$fp[14] .= $defs{$fht}{READINGS}{'thu-from2'}{VAL} . "|" . $defs{$fht}{READINGS}{'thu-to2'}{VAL} . "</td>";
$fp[15] .= "<td>" . $defs{$fht}{READINGS}{'fri-from1'}{VAL} . "|" . $defs{$fht}{READINGS}{'fri-to1'}{VAL} . "|";
$fp[15] .= $defs{$fht}{READINGS}{'fri-from2'}{VAL} . "|" . $defs{$fht}{READINGS}{'fri-to2'}{VAL} . "</td>";
$fp[16] .= "<td>" . $defs{$fht}{READINGS}{'sat-from1'}{VAL} . "|" . $defs{$fht}{READINGS}{'sat-to1'}{VAL} . "|";
$fp[16] .= $defs{$fht}{READINGS}{'sat-from2'}{VAL} . "|" . $defs{$fht}{READINGS}{'sat-to2'}{VAL} . "</td>";
$fp[17] .= "<td>" . $defs{$fht}{READINGS}{'sun-from1'}{VAL} . "|" . $defs{$fht}{READINGS}{'sun-to1'}{VAL} . "|";
$fp[17] .= $defs{$fht}{READINGS}{'sun-from2'}{VAL} . "|" . $defs{$fht}{READINGS}{'sun-to2'}{VAL} . "</td>";
$fp[18] .= "<td>" . $attr{$fht}{comment} . "</td>";
}
foreach (@fp) {
$rh .= "<tr ALIGN=LEFT>" . $_ . "</tr>\n";
}
$rh .= "</table>\n";
$rh .= "</div>\n";
return $rh;
}
################################################################################
1;

149
contrib/contrib/99_ALARM.pm Executable file
View File

@ -0,0 +1,149 @@
#############################################
# Low Budget ALARM System
##############################################
# ATTENTION! This is more a toy than a professional alarm system!
# You must know what you do!
##############################################
#
# Concept:
# 1x Signal Light (FS20 allight) to show the status (activated/deactivated)
# 2x Sirene (in/out) (FS20 alsir1 alsir2 )
# 2x PIRI-2 (FS20 piriu pirio)
# 1x Sender (FS20 alsw) to activate/deactivate the system.
# Tip: use the KeyMatic CAC with pin code or
# optional a normal sender (FS20 alsw2)
#
# Add something like the following lines to the configuration file :
# notifyon alsw {MyAlsw()}
# notifyon alsw2 {MyAlswNoPin()}
# notifyon piriu {MyAlarm()}
# notifyon pirio {MyAlarm()}
# and put this file in the <modpath>/FHZ1000 directory.
#
# Martin Haas
##############################################
package main;
use strict;
use warnings;
sub
ALARM_Initialize($$)
{
my ($hash) = @_;
}
##############################################
# Switching Alarm System on or off
sub
MyAlsw()
{
my $ON="set allight on; setstate alsw on";
my $OFF="set allight off; set alsir1 off; set alsir2 off; setstate alsw off";
if ( -e "/var/tmp/alertsystem")
{
unlink "/var/tmp/alertsystem";
#Paranoia
for (my $i = 0; $i < 2; $i++ )
{
fhem "$OFF";
};
Log 2, "alarm system is OFF";
} else {
system "touch /var/tmp/alertsystem";
#Paranoia
for (my $i = 0; $i < 2; $i++ )
{
fhem "$ON"
}
Log 2, "alarm system is ON";
};
}
##############################################
# If you have no Keymatic then use this workaround:
# After 4x pushing a fs20-button within some seconds it will activate/deactivate the alarm system.
sub
MyAlswNoPin()
{
my $timedout=5;
## first time
if ( ! -e "/var/tmp/alontest1")
{
for (my $i = 1; $i < 4; $i++ )
{
system "touch -t 200601010101 /var/tmp/alontest$i";
}
}
## test 4 times
my $now= `date +%s`;
for (my $i = 1; $i < 4; $i++ )
{
my $tagx=`date -r /var/tmp/alontest$i +%s`;
my $testx=$now-$tagx;
if ( $testx > $timedout )
{
system "touch /var/tmp/alontest$i";
die "test$i: more than $timedout sec";
}
}
system "touch -t 200601010101 /var/tmp/alontest*";
Log 2, "ok, let's switch the alarm system...";
#if you only allow to activate (and not deactivate) with this script:
# if ( -e "/var/tmp/alertsystem") { die "deactivating alarm system not allowed"};
MyAlsw();
}
##############################################
# ALARM! Do what you want!
sub
MyAlarm()
{
#alarm-system activated??
if ( -e "/var/tmp/alertsystem")
{
my $timer=180; # time until the sirene will be quiet
my $ON1="set alsir1 on-for-timer $timer";
my $ON2="set alsir2 on-for-timer $timer";
#Paranoia
for (my $i = 0; $i < 2; $i++ )
{
fhem "$ON1";
fhem "$ON2";
}
Log 2, "ALARM! #################" ;
# have fun
my @lights=("stuwz1", "stuwz2", "nachto", "nachtu", "stoliba" ,"stlileo");
my @rollos=("rolu4", "rolu5", "roloadi", "rololeo", "roloco", "rolowz", "rolunik1", "rolunik2");
foreach my $light (@lights) {
fhem "set $light on"
}
foreach my $rollo (@rollos) {
fhem "set $rollo on"
}
}
}
1;

112
contrib/contrib/99_PID.pm Normal file
View File

@ -0,0 +1,112 @@
##############################################
# This is primary intended to use S300TH/S555TH in conjunction with FHT8v
# to control room temperature
# for this I defined the following:
# define conf_set_value dummy
# define conf_set_value notify config:pid_set_value { pid_set_value(%) }
# { pid_create("bz",0.0,255.0) }
# { pid_set_factors("bz",65.0,7.8,15.0) }
# define control_bz notify th_sensor_bz {my @@d=split(" ","%");;fhem("set CUL raw T16270126" . sprintf("%%02X", pid("bz",$d[1])))}
# trigger config:pid_set_value "bz",21.0
#
# Alexander Tietzel (Perl newby)
#
# TODO:
# want to have references to the second hash inside %data. Some like
# %ctrl = ${$data{$name}}...
# Or better write this as a class and instantiate each controller
# but I did not discover how to have persistent objects in FHEM
# so I helped myself with the hash to have multiple instances.
###############################################
package main;
use strict;
use warnings;
use Math::Trig;
sub pid($$);
sub pid_create($$$);
sub pid_set_value($$);
sub pid_set_factors($$$$);
sub PID_Initialize($);
# See perldoc DateTime::Event::Sunrise for details
my %data;
sub
PID_Initialize($)
{
my ($hash) = @_;
}
##########################
sub pid_create($$$) {
my $name = shift;
my $min = shift;
my $max = shift;
${$data{$name}}{'last_time'} = 0.0;
${$data{$name}}{'p_factor'} = 0.0;
${$data{$name}}{'i_factor'} = 0.0;
${$data{$name}}{'d_factor'} = 0.0;
${$data{$name}}{'error'} = 0.0;
${$data{$name}}{'actuation'} = 0.0;
${$data{$name}}{'integrator'} = 0.0;
${$data{$name}}{'set_value'} = 0.0;
${$data{$name}}{'sat_min'} = $min;
${$data{$name}}{'sat_max'} = $max;
return undef;
}
sub pid_set_factors($$$$) {
my $name = shift;
my $p_factor = shift;
my $i_factor = shift;
my $d_factor = shift;
${$data{$name}}{'p_factor'} = $p_factor;
${$data{$name}}{'i_factor'} = $i_factor;
${$data{$name}}{'d_factor'} = $d_factor;
return undef;
}
sub pid_set_value($$) {
my $name = shift;
my $set_value = shift;
${$data{$name}}{'set_value'} = $set_value;
return undef;
}
sub saturate($$) {
my $name = shift;
my $v = shift;
if ( $v > ${$data{$name}}{'sat_max'} ) {
return ${$data{$name}}{'sat_max'};
}
if ( $v < ${$data{$name}}{'sat_min'} ) {
return ${$data{$name}}{'sat_min'};
}
return $v;
}
sub pid($$) {
my $name = shift;
my $in = shift;
# Log 1, "PID (" . $name . "): kp: " . ${$data{$name}}{'p_factor'} . " ki: " . ${$data{$name}}{'i_factor'} . " kd: " .${$data{$name}}{'d_factor'};
my $error = ${$data{$name}}{'set_value'} - $in;
my $p = $error * ${$data{$name}}{'p_factor'};
my $i = ${$data{$name}}{'integrator'}+$error*${$data{$name}}{'i_factor'};
${$data{$name}}{'integrator'} = saturate($name, $i);
my $d = ($error - ${$data{$name}}{'error'}) * ${$data{$name}}{'d_factor'};
${$data{$name}}{'error_value'} = $error;
my $a = $p + ${$data{$name}}{'integrator'} + $d;
${$data{$name}}{'actuation'} = saturate($name, $a);
Log 4, sprintf("PID (%s): p: %.2f i: %.2f d: %.2f", $name, $p, ${$data{$name}}{'integrator'}, $d);
return ${$data{$name}}{'actuation'};
}
1;

50
contrib/contrib/99_PRIV.pm Executable file
View File

@ -0,0 +1,50 @@
##############################################
# Example perl functions. Put this file into the FHEM directory.
#
# # Activate 2 rollades at once with one button, open them to
# # a different degree.
# define ntfy_1 notifyon btn3 {MyFunc("@", "%")}
#
# # Swith the heater off if all FHT actuators are closed,
# # and on if at least one is open
# define at_1 at +*00:05 { fhem "set heater " . (sumactuator()?"on":"off") };
package main;
use strict;
use warnings;
sub
PRIV_Initialize($$)
{
my ($hash, $init) = @_;
}
sub
sumactuator()
{
my $sum = 0;
foreach my $d (keys %defs) {
next if($defs{$d}{TYPE} ne "FHT");
my ($act, undef) = split(" ", $defs{$d}{READINGS}{"actuator"}{VAL});
$act =~ s/%//;
$sum += $act;
}
return $sum;
}
sub
MyFunc($$)
{
my ($a1, $a2) = @_;
Log 2, "Device $a1 was set to $a2 (type: $defs{$a1}{TYPE})";
if($a2 eq "on") {
fhem "set roll1 on-for-timer 10";
fhem "set roll2 on-for-timer 16";
} else {
fhem "set roll1 off";
fhem "set roll2 off";
}
}
1;

89
contrib/contrib/99_SUNRISE.pm Executable file
View File

@ -0,0 +1,89 @@
##############################################
# - Use 99_SUNRISE_EL.pm instead of this module
# - Be aware: Installing the DateTime modules might be tedious, one way is:
# perl -MCPAN -e shell
# cpan> install DateTime::Event::Sunrise
# - Please call sunrise_coord before using this module, else you'll get times
# for frankfurt am main (germany). See the "at" entry in commandref.html
package main;
use strict;
use warnings;
use DateTime;
use DateTime::Event::Sunrise;
sub sr($$$$);
sub sunrise_rel(@);
sub sunset_rel(@);
sub sunrise_abs(@);
sub sunset_abs(@);
sub isday();
sub sunrise_coord($$$);
sub SUNRISE_Initialize($);
# See perldoc DateTime::Event::Sunrise for details
my $long = "8.686";
my $lat = "50.112";
my $tz = "Europe/Berlin";
sub
SUNRISE_Initialize($)
{
my ($hash) = @_;
}
##########################
# Compute:
# rise: 1: event is sunrise (else sunset)
# isrel: 1: _relative_ times until the next event (else absolute for today)
# seconds: second offset to event
# daycheck: if set, then return 1 if the sun is visible, 0 else
sub
sr($$$$)
{
my ($rise, $seconds, $isrel, $daycheck) = @_;
my $sunrise = DateTime::Event::Sunrise ->new(
longitude => $long,
latitude => $lat,
altitude => '-6', # Civil twilight
iteration => '3');
my $now = DateTime->now(time_zone => $tz);
my $stm = ($rise ? $sunrise->sunrise_datetime( $now ) :
$sunrise->sunset_datetime( $now ));
if($daycheck) {
return 0 if(DateTime->compare($now, $stm) < 0);
$stm = $sunrise->sunset_datetime( $now );
return 0 if(DateTime->compare($now, $stm) > 0);
return 1;
}
if(!$isrel) {
$stm = $stm->add(seconds => $seconds) if($seconds);
return $stm->hms();
}
$stm = $stm->add(seconds => $seconds) if($seconds);
if(DateTime->compare($now, $stm) >= 0) {
my $tom = DateTime->now(time_zone => $tz)->add(days => 1);
$stm = ($rise ? $sunrise->sunrise_datetime( $tom ) :
$sunrise->sunset_datetime( $tom ));
$stm = $stm->add(seconds => $seconds) if($seconds);
}
my $diff = $stm->epoch - $now->epoch;
return sprintf("%02d:%02d:%02d", $diff/3600, ($diff/60)%60, $diff%60);
}
sub sunrise_rel(@) { return sr(1, shift, 1, 0) }
sub sunset_rel(@) { return sr(0, shift, 1, 0) }
sub sunrise_abs(@) { return sr(1, shift, 0, 0) }
sub sunset_abs(@) { return sr(0, shift, 0, 0) }
sub isday() { return sr(1, 0, 0, 1) }
sub sunrise_coord($$$) { ($long, $lat, $tz) = @_; return undef; }
1;

113
contrib/contrib/99_Taupunkt.pm Normal file
View File

@ -0,0 +1,113 @@
#
# Taupunkt.pm
#
# 2011-12-21 Michael Bussmann <support@mb-net.net>
#
package main;
use strict;
use warnings;
use POSIX;
sub
Taupunkt_Initialize($$)
{
my ($hash) = @_;
}
#
# calc_sdd(T)
#
# Sättigungsdampfdruck [hPa] ( Temperatur t [C] )
# über ebenen Wasseroberflächen
#
# Nach Magnus-Formel
#
# E_w (t)= 6.112 hPa * e ^ (17.62*T / ( 243.12 °C + T))
# für -45 °C <= t <= 60 °C
#
# Nach D.Sonntag (Wikipedia)
# http://de.wikibooks.org/wiki/Tabellensammlung_Chemie/_Stoffdaten_Wasser
#
sub
calc_sdd($)
{
my ($t) = @_;
my $tk = $t+273.15;
# Magnus
#return ( 6.112 * exp( (17.62*$t)/(243.12+$t)) );
# Wikipedia/D.Sonntag
return ( exp( (-6094.4642/$tk) + 21.1249952 - ($tk*2.7245552e-2) + ($tk**2 * 1.6853396e-5 ) + ( 2.4575506*log($tk)) ) / 100 );
}
#
# calc_dd(r, T)
#
# Dampfdruck [hPa] (rel. Feuchte r [%], Temperatur T [C] )
#
# DD = r/100 * sdd(T)
#
sub
calc_dd($$)
{
my ($r, $t) = @_;
return ( $r*calc_sdd($t)/100.0 );
}
#
# calc_dewpoint(r, T)
#
# Taupunkt [C] (rel. Feuchte r [%], Temperatur T [C] )
#
# Taupunkt (ü.W.): a = 7.5, b = 237.3 (für T>=0)
# Taupunkt (ü.W.): a = 7.6, b = 240.7 (für T<0)
# Frostpunkt: a = 9.5, b = 265.5 (für T<0)
#
# TD(r,T) = b*v/(a-v) mit v(r,T) = log10(DD(r,T)/6.1078)
#
sub
calc_dewpoint($$)
{
my ($r, $t) = @_;
my ($a, $b, $v);
if ($t>=0) {
$a=7.5; $b=237.3;
} else {
$a=7.6; $b=240.7;
}
$v=log10(calc_dd($r, $t)/6.1078);
return ( ($b*$v)/($a-$v) );
}
#
# calc_af(r, T)
#
# Absolute Feuchte [g/m^3] (rel. Feuchte r [%], Temperatur T [C] )
#
# auf 1 bar (10^5 Pa)
#
# R* = 8314.3 J/(kmol*K)
# mw = 18.016 kg
#
# AF(r,TK) = 10^5 * mw/R* * DD(r,T)/TK
# AF(TD,TK) = 10^5 * mw/R* * SDD(TD)/TK
#
sub
calc_af($$)
{
my ($r, $t) = @_;
my $tk = $t+273.15;
return ( (1801600/8314.3) * (calc_dd($r, $t)/$tk) );
### return ( (1801600/8314.3) * (calc_sdd(calc_dewpoint($r, $t))/$tk) );
}
1;

95
contrib/contrib/99_dumpdef.pm Normal file
View File

@ -0,0 +1,95 @@
#!/usr/bin/perl
##############################################
#
# VarDump for FHEM-Devices
#
##############################################
#
# Copyright notice
#
# (c) 2009 - 2010
# Copyright: Axel Rieger (fhem BEI anax PUNKT info)
# All rights reserved
#
# This script 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.
#
# The GNU General Public License can be found at
# http://www.gnu.org/copyleft/gpl.html.
# A copy is found in the textfile GPL.txt and important notices to the license
# from the author is found in LICENSE.txt distributed with these scripts.
#
# This script 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.
#
##############################################
# Installation
# 99_dumpdef.pm ins FHEM-Verzeichis kopieren
# dann: "reload 99_dumpdef.pm"
##############################################
# Aufruf: dumpdef "DEVICE-NAME"
##############################################
# Aufruf: dumpdef <XXX>
# <MOD> = %modules
# <SEL> = %selectlist
# <VAL> = %value
# <CMD> = %cmds
# <DAT> = %data
##############################################
package main;
use strict;
use warnings;
use POSIX;
use Data::Dumper;
use vars qw(%data);
use vars qw(%cmds);
use vars qw(%attr);
use vars qw(%defs);
use vars qw(%modules);
use vars qw(%selectlist);
sub Commanddumpdef($);
#####################################
sub
dumpdef_Initialize($)
{
my %lhash = ( Fn=>"Commanddumpdef",
Hlp=>"Dump <devspec> to FHEMWEB & LOG" );
$cmds{dumpdef} = \%lhash;
}
#####################################
sub Commanddumpdef($)
{
my ($cl, $d) = @_;
# $d = $a[1];
return "Usage: dumpdef <DeviceName>" if(!$d);
my($package, $filename, $line, $subroutine) = caller(3);
my $r = "CALLER => $package: $filename LINE: $line SUB: $subroutine \n";
$r .= "SUB-NAME: " .(caller(0))[3] . "\n";
$r .= "--------------------------------------------------------------------------------\n";
$Data::Dumper::Maxdepth = 4;
if($d eq "CMD") {$r .= Dumper(%cmds) . "\n"; return $r; }
if($d eq "DAT") {$r .= Dumper(%data) . "\n"; return $r; }
if($d eq "MOD") {$r .= Dumper(%modules) . "\n"; return $r; }
if($d eq "SEL") {$r .= Dumper(%selectlist) . "\n"; return $r; }
if($d eq "DEF") {$r .= Dumper(%defs) . "\n"; return $r; }
if(!defined($defs{$d})) {
return "Unkown Device";}
$r .= "DUMP-DEVICE: $d \n";
$r .= Dumper($defs{$d}) . "\n";
$r .= "--------------------------------------------------------------------------------\n";
$r .= "DUMP-DEVICE-ATTR \n";
$r .= Dumper($attr{$d}) . "\n";
$r .= "--------------------------------------------------------------------------------\n";
$r .= "DUMP-DEVICE-Module \n";
$r .= Dumper($modules{$defs{$d}{TYPE}}) . "\n";
return $r;
}
1;

485
contrib/contrib/99_priv_cgi.pm Normal file
View File

@ -0,0 +1,485 @@
################################################################################
# FHEM PRIV-CGI
# Stand: 08/2009
# Update:
# 08/2009 ROOMS -> Übersicht aller Räume mit Devices und STATE
# 08/2009 READINGS -> Übersicht aller READIMGS nach Datum -> READING -> Device
# 08/2009 Excute FHEMCommands /privcgi?Task=EXEC&cmd=FHEMCOMMAND&dev=DEVICENAME&attr=ATTRIBUTE&val=Value
################################################################################
#
# Beschreibung
# Es werden lediglich vorhanden Information aus FHEM in eigenen Ansichten/Listen dargestellt.
#
# Ansicht/List
# ALL -> Überblick über alle Devices
# FHT -> Übersicht aller FHT's incl. Programme
# FS20 -> Übersicht alle FS20-Devices
# TH -> Alle Devices (die ich habe) die eine Temperatur oder Luftfeuchte messen (FHT,KS300,HMS,S300TH...)
# ROOMS -> Übersicht aller Räume mit Devices und STATE
# READINGS -> Übersicht aller READINGS; Gruppiert nach Datum -> READING -> Device
# DUMMY -> Überischt aller DUMMY-Devices (als Beispiel für eigene Functionen)
################################################################################
# Installation
#
# Modul ins FHEM-Modul Verzeichnis kopieren
# entweder FHEM neu starten
# oder "reload 99_priv_cgi.pm"
#
################################################################################
# Aufruf:
# Bsp.: FHEMWEB => http://localhost:8083/fhem
# PRIV-CGI => http://localhost:8083/fhem/privcgi
#
# Eigene Erweiterungen implementieren:
# Aufruf: http://localhost:8083/fhem/privcgi?Type=FHT&Task=List
# A. Ergänzung LIST-Funktion
# - Eigene Funktion schreiben z.B. sub priv_cgi_my_function($)
# - Eigenen Key festlegen z.B. myKey
# - Function sub priv_cgi_Initialize($) ergänzen $data{$cgi_key}{TASK_LIST}{TYPE}{myKey} = "priv_cgi_my_function";
# - reload 99_priv_cgi.pm
#
# B. Eigene Funktion
# - z.B. MyFunc
# - eigenen Key im HASH $data{$cgi_key}{TASK} erzeugen
# - $data{$cgi_key}{TASK}{MyFunc} = "Function_Aufruf"
##############################################
package main;
use strict;
use warnings;
use Data::Dumper;
use vars qw(%data);
sub priv_cgi_Initialize($)
{
my $cgi_key = "privcgi";
my $fhem_url = "/" . $cgi_key ;
$data{FWEXT}{$fhem_url}{FUNC} = "priv_cgi_callback";
$data{FWEXT}{$fhem_url}{LINK} = "privcgi";
$data{FWEXT}{$fhem_url}{NAME} = "MyFHEM";
$data{$cgi_key}{QUERY} = {};
# Default: in Case of /privcgi
# Task=List&Type=FHT
$data{$cgi_key}{default}{QUERY} = "Task=List&Type=ALL";
# Dispatcher Functions
# Task = List -> Call Function
$data{$cgi_key}{TASK}{List} = "priv_cgi_list";
# List -> Type -> Call Function
$data{$cgi_key}{TASK_LIST}{TYPE} = {};;
$data{$cgi_key}{TASK_LIST}{TYPE}{ALL} = "priv_cgi_print_all";
$data{$cgi_key}{TASK_LIST}{TYPE}{FHT} = "priv_cgi_print_fht";
$data{$cgi_key}{TASK_LIST}{TYPE}{FS20} = "priv_cgi_print_fs20";
$data{$cgi_key}{TASK_LIST}{TYPE}{TH} = "priv_cgi_print_th";
$data{$cgi_key}{TASK_LIST}{TYPE}{ROOMS} = "priv_cgi_print_rooms";
$data{$cgi_key}{TASK_LIST}{TYPE}{READINGS} = "priv_cgi_print_readings";
# $data{$cgi_key}{TASK_LIST}{TYPE}{DUMMY} = "priv_cgi_print_dummy";
# ExcuteFhemCommands
# /privcgi?EXEC=FHEMCOMMAD&DEVICE&VALUE-1&VALUE-2
# /privcgi?Task=EXEC&cmd=FHEMCOMMAND&dev=DEVICENAME&attr=VALUE-1
$data{$cgi_key}{TASK}{EXEC} = "priv_cgi_exec";
}
sub
priv_cgi_callback($$)
{
my ($htmlarg) = @_;
my ($ret_html, $func,$qtask);
my $cgikey = &priv_cgi_get_start($htmlarg);
Log 0, "CGI-KEY: $cgikey";
# Dispatch TASK... choose Function
$qtask = $data{$cgikey}{QUERY}{Task};
$func = $data{$cgikey}{TASK}{$qtask};
Log 0, "Func: $func";
no strict "refs";
# Call Function
$ret_html .= &$func($cgikey);
use strict "refs";
Log 1, "Got $htmlarg";
return ("text/html; charset=ISO-8859-1", $ret_html);
}
sub
priv_cgi_get_start($)
{
my $in = shift;
print "CGI_START: " . Dumper(@_) . "\n";
my (@tmp,$n,$v,$cgikey,$param);
# Aufruf mit oder ohne Argumente
# /privcgi oder /privcgi??Type=FHT&Task=List
if($in =~ /\?/)
{
# Aufruf mit Argumenten: /privcgi?Type=FHT&Task=List
@tmp = split(/\?/, $in);
$cgikey = shift(@tmp);
$cgikey =~ s/\///;
$param = shift(@tmp);
}
else
{
$cgikey = $in;
# Aufruf OHNE Argumenten: /privcgi
$cgikey =~ s/\///;
# Default Werte
$param = $data{$cgikey}{default}{QUERY};
}
# Param nach $data{$cgikey}{QUERY} schreiben
Log 0, "PRIV-CGI: START -> param: " . $param;
@tmp = split(/&/, $param);
foreach my $pair(@tmp)
{
($n,$v) = split(/=/, $pair);
Log 0, "PRIV-CGI: START -> param: $n - $v";
$data{$cgikey}{QUERY}{$n} = $v;
}
return $cgikey;
}
sub
priv_cgi_html_head($)
{
# HTML-Content for HEAD
my $cgikey = shift;
my $html = "<!DOCTYPE html PUBLIC \"-\/\/W3C\/\/DTD HTML 4.01\/\/EN\" \"http:\/\/www.w3.org\/TR\/html4\/strict.dtd\">\n";
$html .= "<html>\n";
$html .= "<head>\n";
$html .= "<style type=\"text/css\"><!--";
$html .= "\#hdr {margin: 0em 0em 1em 0em;padding: 0em 1em;background-color: \#CCCCCC;}";
$html .= "\#left {float: left; width: 15%; padding: 1em;}";
$html .= "\#right {float: left;width: 70%;}";
$html .= "body {font-size: 14px;padding: 0px;margin: 0px;font-family: 'Courier New', Courier, Monospace;";
$html .= "\/\/--><\/style>";
$html .= "<title>FHEM PRIV-CGI<\/title>\n";
$html .= "<\/head>\n";
$html .= "<body>\n";
return $html;
}
sub
priv_cgi_html_body_div_hdr($)
{
# HTML-Content BODY & DIV-ID HDR
my $cgikey = shift;
my $html = "<div id=\"hdr\">";
$html .= "<h3><a href=\"/fhem\">FHEM</a></h3>\n";
$html .= "<p style=\"font-size:8pt;\">";
$html .= $attr{global}{version} . "<br></p>\n";
$html .= "<hr><br>\n";
return $html;
}
sub
priv_cgi_html_div_left($)
{
# HTML-Content BODY & DIV-ID LEFT
my $cgikey = shift;
my $html = "<\/div>";
$html .= "<div id=\"left\">";
$html .= "<h3>Ansichten:<h3>";
$html .= "<form method=\"get\" action=\"\/fhem\/privcgi\" name=\"myfhem\">\n";
$html .= "<select name=\"Type\">\n";
foreach my $d (sort keys %{$data{$cgikey}{TASK_LIST}{TYPE}}) {
$html .= "<option value=\"$d\">$d</option>\n";
}
$html .= "</select>\n";
$html .= "<input name=\"Task\" value=\"List\"type=\"submit\"><br>\n";
$html .= "</form>\n";
$html .= "<\/div>";
return $html ;
}
sub
priv_cgi_list($)
{
my $cgikey = shift;
my $html;
Log 0,"PRIV_CGI_LIST: START";
# HTML-HEAD
$html = &priv_cgi_html_head($cgikey);
# HTML-BODY-DIV-HDR
$html .= &priv_cgi_html_body_div_hdr($cgikey);
# HTML-BODY-DIV-ID-LEFT
$html .= &priv_cgi_html_div_left($cgikey);
my $type = $data{$cgikey}{QUERY}{Type};
Log 0,"PRIV_CGI_LIST: TYPE = " . $type;
my $func = $data{$cgikey}{TASK_LIST}{TYPE}{$type};
Log 0,"PRIV_CGI_LIST: TYPE = $type -> Func -> $func";
no strict "refs";
# Call Function
$html .= &$func;
use strict "refs";
# HTML-BODY-FOOTER
$html .= priv_cgi_html_footer();
return $html;
}
sub
priv_cgi_html_footer()
{
# HTML-BODY Footer
my $html = "<\/body>\n";
$html .= "<\/html>\n";
return $html;
}
sub priv_cgi_print_fs20()
{
my $str = "<table summary=\"List of FS20 devices\">\n";
$str .= "<tr ALIGN=LEFT><th>Name<\/th><th>Model<\/th><th>State<\/th><th>Code<\/th><th>Button<\/th><th>Room<\/th><\/tr>\n";
$str .= "<colgroup>\n";
$str .= "<col width=\"130\"><col width=\"130\"><col width=\"130\"><col width=\"130\">\n";
$str .= "</colgroup>\n";
foreach my $d (sort keys %defs) {
next if($defs{$d}{TYPE} ne "FS20");
$str .= "<tr ALIGN=LEFT><td>" . $d . "<\/td><td>" . $attr{$d}{model} . "<\/td><td>". $defs{$d}{STATE} . "<\/td><td>". $defs{$d}{XMIT} . "<\/td><td>". $defs{$d}{BTN} . "<\/td><td>". $attr{$d}{room} . "<\/td><\/tr>\n";
}
$str .= "<\/table>\n";
return ($str);
}
sub priv_cgi_print_fht()
{
my ($str,@fp);
$str = "<table class=\"Fht\" summary=\"List of fht devices\">\n";
$str .= "<tr ALIGN=LEFT><th>Name<\/th><th>Ventil<\/th><th>Ziel<\/th><th>Aktuell<\/th>" ;
$str .= "<th>Nacht<\/th><th>Tag<\/th><th>Fenster<\/th><th>IODev<\/th><th>Time<\/th><th>CODE<\/th><\/tr>\n";
# Init Tabel FHT-Program
$fp[0] .= "<th></th>";
$fp[1] .= "<td>Montag</td>";
$fp[2] .= "<td></td>";
$fp[3] .= "<td>Dienstag</td>";
$fp[4] .= "<td></td>";
$fp[5] .= "<td>Mittwoch</td>";
$fp[6] .= "<td></td>";
$fp[7] .= "<td>Donnerstag</td>";
$fp[8] .= "<td></td>";
$fp[9] .= "<td>Freitag</td>";
$fp[10] .= "<td></td>";
$fp[11] .= "<td>Samstag</td>";
$fp[12] .= "<td></td>";
$fp[13] .= "<td>Sonntag</td>";
$fp[14] .= "<td></td>";
# actuator desired-temp measured-temp night-temp day-temp windowopen-temp
foreach my $d (sort keys %defs)
{
next if($defs{$d}{TYPE} ne "FHT");
$str .= "<tr ALIGN=LEFT>" ;
$str .= "<td>" . $d . "<\/td>" ;
$str .= "<td>" . $defs{$d}{READINGS}{"actuator"}{VAL} . "<\/td>" ;
$str .= "<td>" . $defs{$d}{READINGS}{"desired-temp"}{VAL} . "<\/td>" ;
$str .= "<td>" . $defs{$d}{READINGS}{"measured-temp"}{VAL} . "<\/td>" ;
$str .= "<td>" . $defs{$d}{READINGS}{"night-temp"}{VAL} . "<\/td>" ;
$str .= "<td>" . $defs{$d}{READINGS}{"day-temp"}{VAL} . "<\/td>" ;
$str .= "<td>" . $defs{$d}{READINGS}{"windowopen-temp"}{VAL} . "<\/td>" ;
$str .= "<td>" . $defs{$d}{IODev}{NAME} . "<\/td>" ;
$str .= "<td>" . $defs{$d}{READINGS}{"actuator"}{TIME} . "<\/td>" ;
$str .= "<td>" . $defs{$d}{CODE} . "<\/td>" ;
$str .= "<\/tr>\n";
# FHT-Programme
no strict "subs";
$fp[0] .= "<th>" . $d . "</th>";
$fp[1] .= "<td>" . $defs{$d}{READINGS}{'mon-from1'}{VAL} . "-" . $defs{$d}{READINGS}{'mon-to1'}{VAL} . "</td>";
$fp[2] .= "<td>" . $defs{$d}{READINGS}{'mon-from2'}{VAL} . "-" . $defs{$d}{READINGS}{'mon-to2'}{VAL} . "</td>";
$fp[3] .= "<td>" . $defs{$d}{READINGS}{'tue-from1'}{VAL} . "-" . $defs{$d}{READINGS}{'tue-to1'}{VAL} . "</td>";
$fp[4] .= "<td>" . $defs{$d}{READINGS}{'tue-from2'}{VAL} . "-" . $defs{$d}{READINGS}{'tue-to2'}{VAL} . "</td>";
$fp[5] .= "<td>" . $defs{$d}{READINGS}{'wed-from1'}{VAL} . "-" . $defs{$d}{READINGS}{'wed-to1'}{VAL} . "</td>";
$fp[6] .= "<td>" . $defs{$d}{READINGS}{'wed-from2'}{VAL} . "-" . $defs{$d}{READINGS}{'wed-to2'}{VAL} . "</td>";
$fp[7] .= "<td>" . $defs{$d}{READINGS}{'thu-from1'}{VAL} . "-" . $defs{$d}{READINGS}{'thu-to1'}{VAL} . "</td>";
$fp[8] .= "<td>" . $defs{$d}{READINGS}{'thu-from2'}{VAL} . "-" . $defs{$d}{READINGS}{'thu-to2'}{VAL} . "</td>";
$fp[9] .= "<td>" . $defs{$d}{READINGS}{'fri-from1'}{VAL} . "-" . $defs{$d}{READINGS}{'fri-to1'}{VAL} . "</td>";
$fp[10] .= "<td>" . $defs{$d}{READINGS}{'fri-from2'}{VAL} . "-" . $defs{$d}{READINGS}{'fri-to2'}{VAL} . "</td>";
$fp[11] .= "<td>" . $defs{$d}{READINGS}{'sat-from1'}{VAL} . "-" . $defs{$d}{READINGS}{'sat-to1'}{VAL} . "</td>";
$fp[12] .= "<td>" . $defs{$d}{READINGS}{'sat-from2'}{VAL} . "-" . $defs{$d}{READINGS}{'sat-to2'}{VAL} . "</td>";
$fp[13] .= "<td>" . $defs{$d}{READINGS}{'sun-from1'}{VAL} . "-" . $defs{$d}{READINGS}{'sun-to1'}{VAL} . "</td>";
$fp[14] .= "<td>" . $defs{$d}{READINGS}{'sun-from2'}{VAL} . "-" . $defs{$d}{READINGS}{'sun-to2'}{VAL} . "</td>";
use strict "subs";
}
$str .= "<\/table>\n";
$str .= "<br>\n";
$str .= "<table>\n";
$str .= "<colgroup>\n";
$str .= "<col width=\"130\"><col width=\"130\"><col width=\"130\"><col width=\"130\">\n";
$str .= "<col width=\"130\"><col width=\"130\"><col width=\"130\"><col width=\"130\">\n";
$str .= "</colgroup>\n";
foreach (@fp) {
$str .= "<tr ALIGN=LEFT>" . $_ . "</tr>\n";
}
$str .= "<\/table>\n";
return ($str);
}
sub priv_cgi_print_dummy()
{
my $str = "<table summary=\"List of Dummy devices\">\n";
$str .= "<colgroup>\n";
$str .= "<col width=\"130\"><col width=\"130\">\n";
$str .= "</colgroup>\n";
$str .= "<tr ALIGN=LEFT><th>Name<\/th><th>State<\/th><\/tr>\n";
foreach my $d (keys %defs) {
next if($defs{$d}{TYPE} ne "dummy");
$str .= "<tr ALIGN=LEFT><td>" . $d . "<\/td><td>". $defs{$d}{STATE} . "<\/td><\/tr>\n";}
$str .= "<\/table>\n";
return ($str);
}
sub priv_cgi_print_th()
{
# List All-Devices with Temp od Humidity
my ($type,$str,$s,$t,$h,$i);
$str = "<table summary=\"List of ALL devices\">\n";
$str .= "<tr ALIGN=LEFT><th>Name</th><th>Temperature</th><th>Humidity</th><th>Information</th><th>Type</th><th>Room</th></tr>";
foreach my $d (sort keys %defs) {
$type = $defs{$d}{TYPE};
next if(!($type =~ m/^(FHT|HMS|KS300|CUL_WS)/));
$t = "";
$h = "";
$i = "";
if ($type eq "FHT"){
$i = $defs{$d}{'READINGS'}{'warnings'}{'VAL'};
$t = $defs{$d}{'READINGS'}{'measured-temp'}{'VAL'};
$t =~ s/\(Celsius\)//;};
if ($type eq "HMS" || $type eq "CUL_WS"){
$i = $defs{$d}{'READINGS'}{'battery'}{'VAL'};
$t = $defs{$d}{'READINGS'}{'temperature'}{'VAL'};
$t =~ s/\(Celsius\)//;
$h = $defs{$d}{'READINGS'}{'humidity'}{'VAL'};
$h =~ s/\(%\)//;};
if ($type eq "KS300"){
$i = "Raining: " . $defs{$d}{'READINGS'}{'israining'}{'VAL'};
$i =~ s/\(yes\/no\)//;
$t = $defs{$d}{'READINGS'}{'temperature'}{'VAL'};
$t =~ s/\(Celsius\)//;
$h = $defs{$d}{'READINGS'}{'humidity'}{'VAL'};
$h =~ s/\(%\)//;};
$str .= "<tr ALIGN=LEFT><td>" . $d . "<\/td><td>". $t . "<\/td><td>". $h . "<\/td><td>". $i . "<\/td><td>". $type . "<\/td><td>". $attr{$d}{room} . "<\/td><\/tr>\n";
}
$str .= "<\/table>\n";
return ($str);
}
sub priv_cgi_print_all()
{
# List All-Devices
my ($type,$str,$s,$t,$h,$i);
$str = "<table summary=\"List of ALL devices\">\n";
$str .= "<tr ALIGN=LEFT><th>Name</th><th>State</th><th>Type</th><th>Model</th><th>Room</th><th>IODev</th></tr>";
foreach my $d (sort keys %defs)
{
$str .= "<tr ALIGN=LEFT><td>" . $d . "<\/td><td>". $defs{$d}{STATE} . "<\/td><td>". $defs{$d}{TYPE} . "<\/td><td>". $attr{$d}{model} . "<\/td><td>". $attr{$d}{room} . "<\/td><td>". $defs{$d}{IODev}{NAME} . "<\/td><\/tr>\n";
}
$str .= "<\/table>\n";
return ($str);
}
sub priv_cgi_print_rooms()
{
my ($str,$r,$d,$ri);
my %rooms = ();
# Quelle 01_FHEMWEB.pm ...
foreach $d (sort keys %defs ) {
foreach my $r (split(",", FW_getAttr($d, "room", "Unsorted"))) {
$rooms{$r}{$d} = $defs{$d}{STATE};}
}
# print Dumper(%rooms);
# Tabelle
# Raum | DEVICE | TYPE | MODELL | STATE
$str = "<table>";
$str .= "<tr ALIGN=LEFT><th>Raum</th><th>Device</th><th>Type</th><th>Model</th><th>State</th></tr>";
foreach $r (sort keys %rooms)
{
$ri = 0;
# $str .= "<tr><td>" . $r . "</td><td></td><td></td><td></td><td></td></tr>\n";
foreach $d (sort keys %{$rooms{$r}}){
if($ri eq 0) {$str .= "<tr bgcolor=\"#CCCCCC\"><td>" . $r . "</td>";}
else {$str .= "<tr><td></td>"}
# $str .= "<tr><td></td><td>" . $d . "</td>";
$str .= "<td>" . $d . "</td>";
$str .= "<td>" . $defs{$d}{TYPE} . "</td>";
$str .= "<td>" . $attr{$d}{model} . "</td>";
$str .= "<td>" . $defs{$d}{STATE} . "</td></tr>\n";
$ri++;
}
}
$str .= "</table>";
return ($str);
}
sub priv_cgi_print_readings()
{
my ($d,$r,$d1,$str,@tmp);
# Übersicht aller READINGS
# Tabelle:
# READING
# DATUM
# DEVICE VALUE TIME
# %reads{DATUM}{READINGS}{DEVICE}{READINGS}{VALUE} = VAL
# %reads{DATUM}{READINGS}{DEVICE}{READINGS}{TIME} = ZEIT
my (%reads,$readings,$datum,$device,$value,$zeit);
foreach $device (sort keys %defs )
{
foreach $r (sort keys %{$defs{$device}{READINGS}})
{
@tmp = split(' ', $defs{$device}{READINGS}{$r}{TIME});
$readings = $r;
$datum = $tmp[0];
$value = $defs{$device}{READINGS}{$r}{VAL};
$zeit = $tmp[1];
$reads{$datum}{$readings}{$device}{$readings}{VALUE} = $defs{$device}{READINGS}{$r}{VAL};
$reads{$datum}{$readings}{$device}{$readings}{TIME} = $zeit;
}
}
$str = "<table>\n";
# Counter
my ($ri,$di);
# Datum
foreach $r (sort keys %reads)
{
# READINGS
$ri = 0;
foreach $d (sort keys %{$reads{$r}})
{
$di = 0;
foreach $d1 (sort keys %{$reads{$r}{$d}})
{
if($ri eq 0){$str .= "<tr bgcolor=\"#CCCCCC\"><td>" . $r . "</td>";}
else{$str .= "<tr><td></td>";}
if($di eq 0) {$str .= "<td>" . $d . "</td>";}
else {$str .= "<td></td>"}
$str .= "<td>" . $d1 . "</td><td>" . $reads{$r}{$d}{$d1}{$d}{VALUE} . "</td><td>" .$reads{$r}{$d}{$d1}{$d}{TIME} . "</td></tr>\n";
$di++;
}
$ri++;
}
}
$str .= "</table>\n";
return ($str);
}
sub
priv_cgi_exec($$)
{
# /privcgi?Task=EXEC&cmd=FHEMCOMMAND&dev=DEVICENAME&attr=ATTRIBUTE&val=Value
# Task=EXEC&cmd=set&dev=WaWaZiDATA&attr=active&val=100
# Task=EXEC&cmd=attr&dev=WaWaZiDATA&attr=room&val=PRIVCGIEXEC
Log 0, "PRIVCGIEXEC: @_\n";
my $cgikey = shift;
my $ret_param = "text/plain; charset=ISO-8859-1";
my $ret_txt = undef;
my $cmd = lc($data{$cgikey}{QUERY}{cmd});
my $dev = $data{$cgikey}{QUERY}{dev};
my $attr = $data{$cgikey}{QUERY}{attr};
my $val = $data{$cgikey}{QUERY}{val};
Log 0, "PRIVCGIEXEC: FHEM-Command: $cmd $dev $attr $val\n";
if(!defined($cmds{$cmd}))
{
return ($ret_param, "PRIVCGIEXEC: unkown COMMAND $cmd");
}
if(!defined($defs{$dev}))
{
return ($ret_param, "PRIVCGIEXEC: unknown DEVICE $dev");
}
$ret_txt = AnalyzeCommand(undef, "$cmd $dev $attr $val");
return ($ret_param, $ret_txt);
}
1;

222
contrib/contrib/99_twitter.pm Executable file
View File

@ -0,0 +1,222 @@
##############################################
#
# Twitter for FHEM
#
##############################################
#
# Copyright notice
#
# (c) 2010
# Copyright: Axel Rieger (fhem BEI anax PUNKT info)
# All rights reserved
#
# This script 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.
#
# The GNU General Public License can be found at
# http://www.gnu.org/copyleft/gpl.html.
# A copy is found in the textfile GPL.txt and important notices to the license
# from the author is found in LICENSE.txt distributed with these scripts.
#
# This script 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.
#
##############################################
# Sends Twitter-MSG
#
# Usage:
# twitter <MESSAGE>
# Beispiel
# twitter "MEINE TWITTER NACHRICHT"
# per AT-Job alle 15min
# define TW001 at +00:15:00 {my $msg = TimeNow() . " " . $defs{<DEVICE-NAME>}{'STATE'} ;; fhem "twitter $msg"}
#
# twitter STATUS
# Shows status of twitter-command:
#--------------------------------------------------------------------------------
#TWITTER
#--------------------------------------------------------------------------------
# Status: Enabeld
# Message-Count: 17
# Message-Count-Max: 1000
# Error-Count: 0
# Error-Count-Max: 5
# Last Message: <TIMESTAMP>
# Last Message: <MESSAGE>
#--------------------------------------------------------------------------------
#
# twitter ENABLE/DISABLE
# Enables/disbales twitter-command
#
# Twitter Limits
# http://help.twitter.com/forums/10711/entries/15364
# Updates: 1,000 per day. The daily update limit is further broken down into
# smaller limits for semi-hourly intervals. Retweets are counted as updates.
#
# My Limits ;-)
# LPW-Timeout 5sec
# Max-Errors = 10
##############################################
package main;
use strict;
use warnings;
use POSIX;
use Data::Dumper;
use LWP::UserAgent;
use vars qw(%data);
use vars qw(%cmds);
sub Commandtwitter($);
#####################################
sub
twitter_Initialize($)
{
# Config-Data
# Account-Data
$data{twitter}{login}{user} = "********";
$data{twitter}{login}{pwd} = "********";
# disabled ?? -> enable
if(defined($data{twitter}{conf}{disabeld})){
delete $data{twitter}{conf}{disabeld};
}
# $data{twitter}{conf}{disabeld} = 1;
# Max 1000 MSGs per Day
$data{twitter}{conf}{msg_count} = 0;
$data{twitter}{conf}{day} = (localtime(time()))[3];
# Error-Counter
$data{twitter}{error} = 0;
$data{twitter}{error_max} = 5;
$data{twitter}{last_msg} = "";
$data{twitter}{last_msg_time} = "";
#FHEM-Command
$cmds{twitter}{Fn} = "Commandtwitter";
$cmds{twitter}{Hlp} = "Sends Twitter Messages (max. 140 Chars): twitter MSG";
}
#####################################
sub Commandtwitter($)
{
my ($cl, $msg) = @_;
if(!$msg) {
Log 0, "TWITTER[ERROR] Keine Nachricht";
return undef;
}
#Show Status
my $status;
$status .= "--------------------------------------------------------------------------------\n";
$status .= "TWITTER \n";
$status .= "--------------------------------------------------------------------------------\n";
if($msg eq "STATUS"){
if(defined($data{twitter}{conf}{disabeld})){$status .= "\t Status: Disbaled\n";}
else{$status .= "\t Status: Enabeld\n";}
$status .= "\t Message-Count: " . $data{twitter}{conf}{msg_count} . "\n";
$status .= "\t Message-Count-Max: 1000\n";
$status .= "\t Error-Count: " . $data{twitter}{error} . "\n";
$status .= "\t Error-Count-Max: " . $data{twitter}{error_max} . "\n";
$status .= "\t Last Message: " . $data{twitter}{last_msg_time} . "\n";
$status .= "\t Last Message: " . $data{twitter}{last_msg} . "\n";
$status .= "--------------------------------------------------------------------------------\n";
return $status;
}
#Enable
if($msg eq "ENABLE"){
if(defined($data{twitter}{conf}{disabeld})){
$status = "Twitter enabled";
return $status;
}
return "Twitter already Enabeld";
}
# Disable
if($msg eq "DISABLE"){
$data{twitter}{conf}{disabeld} = 1;
return "Twitter disabeld";
}
#ERROR-Counter
my ($err_cnt,$err_max);
if(defined($data{twitter}{error})){
$err_cnt = $data{twitter}{error};
$err_max = $data{twitter}{error_max};
if($err_cnt > $err_max){
# ERROR disable twitter
Log 0, "TWITTER[INFO] ErrCounter exceeded $err_max DISABLED";
$data{twitter}{last_msg_time} = TimeNow();
$data{twitter}{last_msg} = "TWITTER[INFO] ErrCounter exceeded $err_max DISABLED";
$data{twitter}{conf}{disabeld} = 1;
}
}
# Disbaled ??
if(defined($data{twitter}{conf}{disabeld})){
Log 0, "TWITTER[STATUS] DISABLED";
return undef;
}
#Changed Day
my $d = (localtime(time()))[3];
my $d_old = $data{twitter}{conf}{day};
if($d_old ne $d){
$data{twitter}{conf}{day} = $d;
Log 0,"TWITTER[INFO] DAY-CHANGE: DAY: $d_old MSG-COUNT: " . $data{twitter}{conf}{msg_count};
$data{twitter}{conf}{msg_count} = 0;
#Reset ERROR-Counter
$data{twitter}{error} = 0;
}
#Count MSG
my $msg_cnt = $data{twitter}{conf}{msg_count};
if($msg_cnt > 1000) {
Log 0, "TWITTER[INFO] MessageCount exceede 1000 Messages per Day";
$data{twitter}{last_msg_time} = TimeNow() ;
$data{twitter}{last_msg} = "TWITTER[INFO] Message-Count exceeded 1000 Messages per Day";
return undef;
}
my $t_user = $data{twitter}{login}{user};
my $t_pdw = $data{twitter}{login}{pwd};
my $t_log;
#Add MSG-Count
$msg = "[" . $msg_cnt ."] " . $msg;
# Max ;SG-Length 140
my $ml = length ($msg);
if($ml > 140){
Log 0, "TWITTER[INFO] Die Nachricht ist mit $ml Zeichen zu lang (max. 140)";
$msg = substr($msg, 0, 140);
}
my $browser = LWP::UserAgent->new;
# Proxy-Server
# $browser->proxy(['http'], "http://PROXYSERVER:PORT");
$browser->timeout(5);
my $url = 'http://twitter.com/statuses/update.json';
$browser->credentials('twitter.com:80', 'Twitter API', $t_user , $t_pdw);
my $response = $browser->get("http://twitter.com/account/verify_credentials.json");
if($response->code eq 200){
$t_log = "LOGIN=SUCCESS";
}
else {
$t_log = "TWITTER[ERROR] LOGIN: " . $response->code .":".$response->message . " DISABLED";
$data{twitter}{error}++;
$data{twitter}{last_msg_time} = TimeNow() ;
$data{twitter}{last_msg} = $t_log;
return undef;
}
$response = $browser->post($url, {status => $msg});
if($response->code eq 200){
$t_log .= " UPDATE=SUCCESS";
}
else {
$t_log = "TWITTER[ERROR] UPDATE: " . $response->code .":".$response->message . " DISABLED";
$data{twitter}{error}++;
$data{twitter}{last_msg_time} = TimeNow() ;
$data{twitter}{last_msg} = $t_log;
return undef;
}
Log 0, "TWITTER[INFO] " . $t_log . " MSG-$msg_cnt-: $msg";
$data{twitter}{last_msg_time} = TimeNow() ;
$data{twitter}{last_msg} = $msg;
$data{twitter}{conf}{msg_count}++;
# Reset ERROR-COUNTER
$data{twitter}{error} = 0;
$msg_cnt++;
return undef;
}
1;

1
contrib/contrib/DEBIAN/conffiles Normal file
View File

@ -0,0 +1 @@
/etc/fhem.cfg

12
contrib/contrib/DEBIAN/control Executable file
View File

@ -0,0 +1,12 @@
Package: fhem
Version: =VERS=
Maintainer: Rudolf Koenig <r.koenig@koeniglich.de>
Description: GPL'd perl server for house automation.
It is used to automate some common tasks in the household like switching lamps
/ shutters / heating / etc. and to log events like temperature/humidity/power
consumption.
Section: utils
Priority: extra
Architecture: all
Homepage: http://www.fhem.de
Depends: perl-base (>= 5.6.2), libdevice-serialport-perl (>= 1.0)

24
contrib/contrib/DEBIAN/postinst Normal file
View File

@ -0,0 +1,24 @@
#!/bin/sh
set -e
if ! getent passwd fhem >/dev/null; then
useradd --system --home /var/log/fhem --gid dialout --shell /bin/false fhem
fi
chown -R fhem /var/log/fhem /etc/fhem.cfg /usr/share/fhem /usr/bin/fhem.pl
#set up of autostart
if test -x /sbin/initctl; then
# upstart
mkdir -p /etc/init
cp /usr/share/fhem/contrib/init-scripts/fhem.upstart /etc/init/fhem.conf
initctl start fhem
else
# Sysvinit
mkdir -p /etc/init.d
cp /usr/share/fhem/contrib/init-scripts/fhem.3 /etc/init.d/fhem
chmod ugo+x /etc/init.d/fhem
update-rc.d fhem defaults
invoke-rc.d fhem start
fi

20
contrib/contrib/DEBIAN/postrm Executable file
View File

@ -0,0 +1,20 @@
#!/bin/sh
set -e # required by lintian
set +e # Don't know how to check presence of fhem in passwd with -e
if grep -q fhem /etc/passwd; then
userdel fhem
fi
if test -f /etc/init/fhem.conf; then
rm /etc/init/fhem.conf
fi
if test -f /etc/init.d/fhem; then
update-rc.d fhem remove
rm /etc/init.d/fhem
fi
if test ! -x /sbin/initctl; then
update-rc.d -f fhem remove
fi

11
contrib/contrib/DEBIAN/prerm Executable file
View File

@ -0,0 +1,11 @@
#!/bin/sh
set -e
if pgrep fhem.pl >/dev/null; then
if test -x /sbin/initctl; then
initctl stop fhem
else
invoke-rc.d fhem stop
fi
fi

14
contrib/contrib/FB7270/fhemcmd.sh Normal file
View File

@ -0,0 +1,14 @@
#!/bin/sh
## FritzBox 7390
## Beispiel fuer das Senden von FHEM Kommandos ueber den Telefoncode
## #95*x* wobei x hier 1 bzw 2 entspricht.
case $1 in
1) echo "set Steckdose on" | /sbin/socat - TCP:127.0.0.1:7072
;;
2) echo "set Steckdose off" | /sbin/socat - TCP:127.0.0.1:7072
;;
esac

44
contrib/contrib/FB7270/makeimage Executable file
View File

@ -0,0 +1,44 @@
#!/bin/sh
fw=$1
if test ! -f ../../$fw.tar.gz; then
echo "usage: makeimage <fhem-VERSION>"
echo "../../<fhem-VERSION>.tar.gz must exist"
exit 1
fi
rm -rf var
echo Extracting the fritzbox template
unzip -qo ../../priv/fritzbox7270_template.zip
cp fhemcmd.sh fhem/FHEM
cp startfhem fhem
echo Extracting $fw
rm -rf $fw
tar zxf ../../$fw.tar.gz
cd $fw
cp fhem.pl ../fhem
cp FHEM/*\
webfrontend/pgm2/*\
docs/*.html\
docs/fhem.png\
docs/*.jpg\
../fhem/FHEM
cd examples
for i in *; do
cp -r $i ../../fhem/FHEM/example.$i
done
cd ../..
rm -rf $fw
echo Packing again
cd fhem
cp FHEM/example.sample_pgm2 fhem.cfg
perl -pi -e 's,/tmp,./log,g' fhem.cfg
cd ..
zip -qr $fw-fb7270.zip fhem
rm -rf fhem

26
contrib/contrib/FB7270/startfhem Executable file
View File

@ -0,0 +1,26 @@
#!/bin/sh
# On the Fritzbox 7270 V1/V2 with missing df replace home with the hardcoded
# path.
root=`df | sed -n -e '/ftp\//s/.*ftp\///p'`
home=/var/InternerSpeicher/$root/fhem
cd $home
trap "" SIGHUP
modprobe kernel/cdc_acm
modprobe ftdi_sio
sleep 2
ln -sf $home/FHEM/fhemcmd.sh /var/fhemcmd
PATH=$home:$PATH
export PATH
export LD_LIBRARY_PATH=$home/lib
export PERL5LIB=$home/lib/perl:$home/lib/perl/arch
#export PERL5LIB=$home/lib/perl5/5.10
#stty -echo -echok -echoke -echoe -echonl < /dev/ttyACM0
perl fhem.pl fhem.cfg

14
contrib/contrib/FB7390/fhemcmd.sh Normal file
View File

@ -0,0 +1,14 @@
#!/bin/sh
## FritzBox 7390
## Beispiel fuer das Senden von FHEM Kommandos ueber den Telefoncode
## #95*x* wobei x hier 1 bzw 2 entspricht.
case $1 in
1) echo "set Steckdose on" | /sbin/socat - TCP:127.0.0.1:7072
;;
2) echo "set Steckdose off" | /sbin/socat - TCP:127.0.0.1:7072
;;
esac

63
contrib/contrib/FB7390/install Executable file
View File

@ -0,0 +1,63 @@
#! /bin/sh
root=/var/InternerSpeicher
home=$root/fhem
echo "########################### FHEM INSTALL BEGIN #######################"
killall perl > /dev/null 2>&1
sleep 1
echo "########################### Extracting fhem.tar.gz ###################"
cd $root
if test -d fhem; then
mv fhem fhem.OLD
fi
gzip -cd /var/fhem.tar.gz | tar xf -
cd $root
# Save files from the AVM Style installation
if test -f fhem.OLD/opt/etc/fhem.cfg; then
echo "########################### Converting chroot style config ###########"
export LD_LIBRARY_PATH=$home/lib
export PERL5LIB=$home/lib/perl5/site_perl/5.12.2/mips-linux:$home/lib/perl5/site_perl/5.12.2:$home/lib/perl5/5.12.2/mips-linux:$home/lib/perl5/5.12.2
cp fhem.OLD/opt/etc/fhem.cfg fhem
fhem/perl -pi -e 's,/opt,$root,g;
s,fhem/share,fhem,;
s,^#define autocreate,define autocreate,;
s,^#attr autocreate,attr autocreate,;
s,ttyACM(.)(@\d+)?,ttyACM$1\@38400,;' fhem/fhem.cfg
mv fhem.OLD/opt/fhem/log/* fhem/log
fi
# Save files from our old version
if test -f fhem.OLD/fhem.cfg; then
echo "########################### Copying non-chroot style config ##########"
mv fhem.OLD/FHEM/*.sh fhem/FHEM
mv fhem.OLD/FHEM/99.*Util.pm fhem/FHEM
mv fhem.OLD/FHEM/*.sh fhem/FHEM
mv fhem.OLD/log/* fhem/log
mv fhem.OLD/fhem.cfg fhem
fi
chown -R boxusr80:root $home
if test -d fhem.OLD; then
echo "########################### Deleting the old directory ###############"
rm -rf fhem.OLD
fi
cat /var/flash/debug.cfg > /var/nvi.tmp
grep -q fhem /var/nvi.tmp
r=$?
if test $r != 0; then
echo "########################### Modifying the startup script #############"
echo $home/startfhem >> /var/nvi.tmp
cat /var/nvi.tmp > /var/flash/debug.cfg
fi
rm -f /var/nvi.tmp
# We have to restart with exit code 1, else the frontend tells us:
# update failed: no error
echo "########################### FHEM INSTALL END #########################"
exit 1

55
contrib/contrib/FB7390/makeimage Executable file
View File

@ -0,0 +1,55 @@
#!/bin/sh
fw=$1
if test ! -f ../../$fw.tar.gz; then
echo "usage: makeimage <fhem-VERSION>"
echo "../../<fhem-VERSION>.tar.gz must exist"
exit 1
fi
rm -rf var
echo Extracting the fritzbox template
tar xf ../../priv/fritzbox7390_template.tar
cd var
tar zxf fhem.tar.gz
rm -rf fhem/FHEM
mkdir fhem/FHEM
cd ..
cp install var
cp startfhem var/fhem
cp fhemcmd.sh var/fhem/FHEM
echo Extracting $fw
rm -rf $fw
tar zxf ../../$fw.tar.gz
cd $fw
cp fhem.pl ../var/fhem
cp FHEM/*\
webfrontend/pgm2/*\
docs/*.html\
docs/fhem.png\
docs/*.jpg\
../var/fhem/FHEM
cd examples
for i in *; do
cp -r $i ../../var/fhem/FHEM/example.$i
done
cd ../..
rm -rf $fw
echo Packing again
cd var/fhem
cp FHEM/example.sample_pgm2 fhem.cfg
perl -pi -e 's,/tmp,./log,g' fhem.cfg
cd ..
tar zcf fhem.tar.gz fhem
rm -rf fhem
cd ..
tar cf $fw-fb7390.image var
rm -rf var

37
contrib/contrib/FB7390/startfhem Executable file
View File

@ -0,0 +1,37 @@
#!/bin/sh
home=/var/InternerSpeicher/fhem
cd $home
trap "" SIGHUP
modprobe cdc_acm
modprobe ftdi_sio
sleep 2
ln -sf $home/FHEM/fhemcmd.sh /var/fhemcmd
PATH=$home:$PATH
export PATH
export LD_LIBRARY_PATH=$home/lib
export PERL5LIB=$home/lib/perl5/site_perl/5.12.2/mips-linux:$home/lib/perl5/site_perl/5.12.2:$home/lib/perl5/5.12.2/mips-linux:$home/lib/perl5/5.12.2
# let FHEM run as user boxusr80 by adding user fhem with uid of boxusr80
# Using this feature the following will not work: ping,WOL,lcd4linux
# start fhem-user
id fhem > /dev/null 2>&1
if [ "$?" -ne "0" ]; then
echo "user fhem does not exist. Adding it."
echo "fhem:any:1080:0:fhem:/home-not-used:/bin/sh" >>/var/tmp/passwd
fi
# end fhem-user
# set file ownership
chown -R boxusr80 ${home}/log
chown -R boxusr80 ${home}/FHEM
chown root ${home}/dfu-programmer
chmod 4755 ${home}/dfu-programmer
perl fhem.pl fhem.cfg

405
contrib/contrib/HM-USB-CFG/00_HMLAN.pm Normal file
View File

@ -0,0 +1,405 @@
##############################################
# $Id$
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
sub HMLAN_Parse($$);
sub HMLAN_Read($);
sub HMLAN_Write($$$);
sub HMLAN_ReadAnswer($$$);
sub HMLAN_uptime($);
sub HMLAN_SimpleWrite(@);
my %sets = (
"hmPairForSec" => "HomeMatic",
"hmPairSerial" => "HomeMatic",
);
sub
HMLAN_Initialize($)
{
my ($hash) = @_;
require "$attr{global}{modpath}/FHEM/DevIo.pm";
# Provider
$hash->{ReadFn} = "HMLAN_Read";
$hash->{WriteFn} = "HMLAN_Write";
$hash->{ReadyFn} = "HMLAN_Ready";
$hash->{SetFn} = "HMLAN_Set";
$hash->{Clients} = ":CUL_HM:";
my %mc = (
"1:CUL_HM" => "^A......................",
);
$hash->{MatchList} = \%mc;
# Normal devices
$hash->{DefFn} = "HMLAN_Define";
$hash->{UndefFn} = "HMLAN_Undef";
$hash->{AttrList}= "do_not_notify:1,0 dummy:1,0 " .
"loglevel:0,1,2,3,4,5,6 addvaltrigger " .
"hmId hmProtocolEvents hmKey";
}
#####################################
sub
HMLAN_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
if(@a != 3) {
my $msg = "wrong syntax: define <name> ip[:port] | /path/to/HM-USB-CFG device as a parameter"; #added for HM-USB-CFG by peterp
Log 2, $msg;
return $msg;
}
DevIo_CloseDev($hash);
my $name = $a[0];
my $dev = $a[2];
$dev .= ":1000" if($dev !~ m/:/ && $dev ne "none" && $dev !~ m/\@/ && $dev !~ m/hiddev/ ); #changed for HM-USB-CFG by peterp
$attr{$name}{hmId} = sprintf("%06X", time() % 0xffffff); # Will be overwritten
if($dev eq "none") {
Log 1, "$name device is none, commands will be echoed only";
$attr{$name}{dummy} = 1;
return undef;
}
$hash->{DeviceName} = $dev;
my $ret = DevIo_OpenDev($hash, 0, "HMLAN_DoInit");
return $ret;
}
#####################################
sub
HMLAN_Undef($$)
{
my ($hash, $arg) = @_;
my $name = $hash->{NAME};
foreach my $d (sort keys %defs) {
if(defined($defs{$d}) &&
defined($defs{$d}{IODev}) &&
$defs{$d}{IODev} == $hash)
{
my $lev = ($reread_active ? 4 : 2);
Log GetLogLevel($name,$lev), "deleting port for $d";
delete $defs{$d}{IODev};
}
}
DevIo_CloseDev($hash);
return undef;
}
#####################################
sub
HMLAN_RemoveHMPair($)
{
my $hash = shift;
delete($hash->{hmPair});
}
#####################################
sub
HMLAN_Set($@)
{
my ($hash, @a) = @_;
return "\"set HMLAN\" needs at least one parameter" if(@a < 2);
return "Unknown argument $a[1], choose one of " . join(" ", sort keys %sets)
if(!defined($sets{$a[1]}));
my $name = shift @a;
my $type = shift @a;
my $arg = join("", @a);
my $ll = GetLogLevel($name,3);
if($type eq "hmPairForSec") { ####################################
return "Usage: set $name hmPairForSec <seconds_active>"
if(!$arg || $arg !~ m/^\d+$/);
$hash->{hmPair} = 1;
InternalTimer(gettimeofday()+$arg, "HMLAN_RemoveHMPair", $hash, 1);
} elsif($type eq "hmPairSerial") { ################################
return "Usage: set $name hmPairSerial <10-character-serialnumber>"
if(!$arg || $arg !~ m/^.{10}$/);
my $id = AttrVal($hash->{NAME}, "hmId", "123456");
$hash->{HM_CMDNR} = $hash->{HM_CMDNR} ? ($hash->{HM_CMDNR}+1)%256 : 1;
HMLAN_Write($hash, undef, sprintf("As15%02X8401%s000000010A%s",
$hash->{HM_CMDNR}, $id, unpack('H*', $arg)));
$hash->{hmPairSerial} = $arg;
}
return undef;
}
#####################################
# This is a direct read for commands like get
sub
HMLAN_ReadAnswer($$$)
{
my ($hash, $arg, $regexp) = @_;
my $type = $hash->{TYPE};
return ("No FD", undef)
if(!$hash && !defined($hash->{FD}));
my ($mdata, $rin) = ("", '');
my $buf;
my $to = 3; # 3 seconds timeout
$to = $hash->{RA_Timeout} if($hash->{RA_Timeout}); # ...or less
for(;;) {
return ("Device lost when reading answer for get $arg", undef)
if(!$hash->{FD});
vec($rin, $hash->{FD}, 1) = 1;
my $nfound = select($rin, undef, undef, $to);
if($nfound < 0) {
next if ($! == EAGAIN() || $! == EINTR() || $! == 0);
my $err = $!;
DevIo_Disconnected($hash);
return("HMLAN_ReadAnswer $arg: $err", undef);
}
return ("Timeout reading answer for get $arg", undef)
if($nfound == 0);
$buf = DevIo_SimpleRead($hash);
return ("No data", undef) if(!defined($buf));
if($buf) {
Log 5, "HMLAN/RAW (ReadAnswer): $buf";
$mdata .= $buf;
}
if($mdata =~ m/\r\n/) {
if($regexp && $mdata !~ m/$regexp/) {
HMLAN_Parse($hash, $mdata);
} else {
return (undef, $mdata)
}
}
}
}
my %lhash;
#####################################
sub
HMLAN_Write($$$)
{
my ($hash,$fn,$msg) = @_;
my $dst = substr($msg, 16, 6);
if(!$lhash{$dst} && $dst ne "000000") { # Don't think I grok the logic
HMLAN_SimpleWrite($hash, "+$dst,00,00,");
HMLAN_SimpleWrite($hash, "+$dst,00,00,");
HMLAN_SimpleWrite($hash, "+$dst,00,00,");
HMLAN_SimpleWrite($hash, "-$dst");
HMLAN_SimpleWrite($hash, "+$dst,00,00,");
HMLAN_SimpleWrite($hash, "+$dst,00,00,");
HMLAN_SimpleWrite($hash, "+$dst,00,00,");
HMLAN_SimpleWrite($hash, "+$dst,00,00,");
$lhash{$dst} = 1;
}
my $tm = int(gettimeofday()*1000) % 0xffffffff;
$msg = sprintf("S%08X,00,00000000,01,%08X,%s",
$tm, $tm, substr($msg, 4));
HMLAN_SimpleWrite($hash, $msg);
# Avoid problems with structure set
# TODO: rewrite it to use a queue+internaltimer like the CUL
select(undef, undef, undef, 0.03);
}
#####################################
# called from the global loop, when the select for hash->{FD} reports data
sub
HMLAN_Read($)
{
my ($hash) = @_;
my $buf = DevIo_SimpleRead($hash);
return "" if(!defined($buf));
my $name = $hash->{NAME};
my $hmdata = $hash->{PARTIAL};
Log 5, "HMLAN/RAW: $hmdata/$buf";
$hmdata .= $buf;
while($hmdata =~ m/\n/) {
my $rmsg;
($rmsg,$hmdata) = split("\n", $hmdata, 2);
$rmsg =~ s/\r//;
HMLAN_Parse($hash, $rmsg) if($rmsg);
}
$hash->{PARTIAL} = $hmdata;
}
sub
HMLAN_uptime($)
{
my $msec = shift;
$msec = hex($msec);
my $sec = int($msec/1000);
return sprintf("%03d %02d:%02d:%02d.%03d",
int($msec/86400000), int($sec/3600),
int(($sec%3600)/60), $sec%60, $msec % 1000);
}
sub
HMLAN_Parse($$)
{
my ($hash, $rmsg) = @_;
my $name = $hash->{NAME};
my $ll5 = GetLogLevel($name,5);
my ($src, $status, $msec, $d2, $rssi, $msg);
my $dmsg = $rmsg;
Log $ll5, "HMLAN_Parse: $name $rmsg";
if($rmsg =~ m/^E(......),(....),(........),(..),(....),(.*)/) {
($src, $status, $msec, $d2, $rssi, $msg) =
($1, $2, $3, $4, $5, $6);
if ($hash->{HIDDev}) #added for HM-USB-CFG by peterp
{
$dmsg = sprintf("A%s", uc($msg));
}
else
{
$dmsg = sprintf("A%02X%s", length($msg)/2, uc($msg));
}
$hash->{uptime} = HMLAN_uptime($msec);
} elsif($rmsg =~ m/^R(........),(....),(........),(..),(....),(.*)/) {
($src, $status, $msec, $d2, $rssi, $msg) =
($1, $2, $3, $4, $5, $6);
if ($hash->{HIDDev}) #added for HM-USB-CFG by peterp
{
$dmsg = sprintf("A%s", uc($msg));
}
else
{
$dmsg = sprintf("A%02X%s", length($msg)/2, uc($msg));
}
$dmsg .= "NACK" if($status !~ m/00(01|02|21)/);
$hash->{uptime} = HMLAN_uptime($msec);
} elsif($rmsg =~
m/^HHM-LAN-IF,(....),(..........),(......),(......),(........),(....)/) {
my ($vers, $serno, $d1, $owner, $msec, $d2) =
(hex($1), $2, $3, $4, $5, $6);
$hash->{serialNr} = $serno;
$hash->{firmware} = sprintf("%d.%d", ($vers>>12)&0xf, $vers & 0xffff);
$hash->{owner} = $owner;
$hash->{uptime} = HMLAN_uptime($msec);
my $myId = AttrVal($name, "hmId", $owner);
if(lc($owner) ne lc($myId) && !AttrVal($name, "dummy", 0)) {
Log 1, "HMLAN setting owner to $myId from $owner";
HMLAN_SimpleWrite($hash, "A$myId");
}
return;
} elsif($rmsg =~ m/^I00.*/) {
# Ack from the HMLAN
return;
} else {
Log $ll5, "$name Unknown msg >$rmsg<";
return;
}
$hash->{"${name}_MSGCNT"}++;
$hash->{"${name}_TIME"} = TimeNow();
$hash->{RAWMSG} = $rmsg;
my %addvals = (RAWMSG => $rmsg);
if(defined($rssi)) {
$rssi = hex($rssi)-65536;
$hash->{RSSI} = $rssi;
$addvals{RSSI} = $rssi;
}
Dispatch($hash, $dmsg, \%addvals);
}
#####################################
sub
HMLAN_Ready($)
{
my ($hash) = @_;
return DevIo_OpenDev($hash, 1, "HMLAN_DoInit");
}
########################
sub
HMLAN_SimpleWrite(@)
{
my ($hash, $msg, $nonl) = @_;
my $name = $hash->{NAME};
return if(!$hash || AttrVal($hash->{NAME}, "dummy", undef));
select(undef, undef, undef, 0.01);
Log GetLogLevel($name,5), "SW: $msg";
if (!($hash->{HIDDev}))
{
$msg .= "\r\n" unless($nonl) ; #changed for HM-USB-CFG by peterp
}
syswrite($hash->{TCPDev}, $msg) if($hash->{TCPDev});
DevIo_SimpleWrite($hash, $msg) if ($hash->{HIDDev}); #added for HM-USB-CFG by peterp
}
########################
sub
HMLAN_DoInit($)
{
my ($hash) = @_;
my $name = $hash->{NAME};
my $id = AttrVal($name, "hmId", undef);
my $key = AttrVal($name, "hmKey", ""); # 36(!) hex digits
#my $s2000 = sprintf("%02X", time()-946681200); # sec since 2000
# Calculate the local time in seconds from 2000.
my $t = time();
my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($t);
$t -= 946684800; # seconds between 01.01.2000, 00:00 and THE EPOCH (1970)
$t -= 1*3600; # Timezone offset from UTC * 3600 (MEZ=1). FIXME/HARDCODED
$t += 3600 if $isdst;
my $s2000 = sprintf("%02X", $t);
HMLAN_SimpleWrite($hash, "A$id") if($id);
HMLAN_SimpleWrite($hash, "C");
HMLAN_SimpleWrite($hash, "Y01,01,$key");
HMLAN_SimpleWrite($hash, "Y02,00,");
HMLAN_SimpleWrite($hash, "Y03,00,");
HMLAN_SimpleWrite($hash, "Y03,00,");
HMLAN_SimpleWrite($hash, "T$s2000,04,00,00000000");
InternalTimer(gettimeofday()+25, "HMLAN_KeepAlive", $hash, 0);
return undef;
}
#####################################
sub
HMLAN_KeepAlive($)
{
my $hash = shift;
return if(!$hash->{FD});
HMLAN_SimpleWrite($hash, "K");
InternalTimer(gettimeofday()+25, "HMLAN_KeepAlive", $hash, 1) if (!($hash->{HIDDev})); #changed for HM-USB-CFG by peterp
}
1;

443
contrib/contrib/HM-USB-CFG/DevIo.pm Normal file
View File

@ -0,0 +1,443 @@
##############################################
# $Id$
package main;
use Device::USB;
my $timeout = 1000 ;
sub DevIo_SimpleRead($);
sub DevIo_TimeoutRead($$);
sub DevIo_SimpleWrite($$);
sub DevIo_OpenDev($$$);
sub DevIo_CloseDev($);
sub DevIo_Disconnected($);
########################
sub
DevIo_DoSimpleRead($)
{
my ($hash) = @_;
my ($buf, $res);
if($hash->{USBDev}) {
$buf = $hash->{USBDev}->input();
} elsif($hash->{DIODev}) {
$res = sysread($hash->{DIODev}, $buf, 256);
$buf = undef if(!defined($res));
} elsif($hash->{TCPDev}) {
$res = sysread($hash->{TCPDev}, $buf, 256);
$buf = undef if(!defined($res));
}
######################################### HID by peterp
elsif($hash->{HIDDev}) {
my $r; #raw message
my $b=0; #raw message payload
my $c=0; # ignore counter
my $d=0; #HM message length
my $s = 0; #start counter
my $start = 0; #raw header flag
my $typ ="";
$res = sysread($hash->{HIDDev}, $buf, 512);
$buf = undef if(!defined($res));
## HID specific
for (my $i=0; $i<64;$i++)
{
if ($start != 0)
{
$r .= unpack('H*', substr($buf,4+$i*8,1)); #copy to raw HMmessage
if ($typ eq "E")
{
if ($b > 12) #raw message payload
{
$d--;
if ($d == 0)
{
$r .= "\n"; #form a raw HMmessage for parse like HMLAN
$start = 0;
# Log 4, "HMUSB HMmessage:$r";
}
}
$b++;
}
else
{
$d--;
if ($d == 0)
{
Log 2, "HMUSB HMmessage:$r";
$r .= "\n"; #form a raw HMmessage for parse like HMLAN
$start = 0;
}
}
}
else
{
# $r = unpack('H*', substr($buf,4+$i*8,1));
# Log 4, "$r\t";
if ( ord(substr($buf,4+$i*8,1)) == 69)
{
$start = 1; #raw header found
$r = "E"; #start a raw HMmessage for parse like HMLAN
$d = ord(substr($buf,4+($i+13)*8,1)); #calc HM message length
$s = $i;
$typ ="E";
# Log 4, "HMUSB ReadSimple Magic found HMlen:$d";
}
elsif ( ord(substr($buf,4+$i*8,1)) == 73)
{
Log 2, "HMUSB ReadSimple Magic >I< found i:$i b:$b ";
$start = 1; #raw header found
$typ = "I";
$d = 4;
}
elsif ( ord(substr($buf,4+$i*8,1)) == 82)
{
Log 2, "HMUSB ReadSimple Magic >R< found i:$i b:$b ";
}
elsif ( ord(substr($buf,4+$i*8,1)) == 72)
{
Log 2, "HMUSB ReadSimple Magic >H< USB-IF found i:$i b:$b";
$start = 1; #raw header found
$typ = "H";
$d = 40;
}
else
{
$c++; #ignore counter
}
}
}
# Log 4, "HMUSB ReadSimple all >$r< (raw Start $s ignored $c)";
if ($typ eq "E")
{
my ($src, $status, $msec, $d2, $rssi, $msg);
$r =~ m/^E(......)(....)(........)(..)(....)(.*)/;
($src, $status, $msec, $d2, $rssi, $msg) =
($1, $2, $3, $4, $5, $6);
my $cmsg = "E".$src.",".$status.",".$msec.",".$d2.",".$rssi.",".$msg."\n";
Log 4, "HMUSB ReadSimple converted $cmsg";
return $cmsg;
}
elsif ($typ eq "H")
{
Log 4, "HMUSB ReadSimple Wakup found";
my ($vers, $serno, $d1, $owner, $msec, $d2);
$r =~ m/^HHM-USB-IF(....)(..........)(......)(......)(........)(....)/;
($vers, $serno, $d1, $owner, $msec, $d2) =
(hex($1), $2, $3, $4, $5, $6);
my $wmsg = "HHM-USB-IF".",".$vers.",".$serno.",".$d1.",".$owner.",".$msec.",".$d2."\n";
Log 2, "HMUSB ReadSimple Wakeup converted $wmsg";
return $wmsg;
}
elsif ($typ eq "I")
{
$r =~ m/^I00.*/;
return $r;
}
######################################### HIDDEV by peterp
}
return $buf;
}
########################
sub
DevIo_SimpleRead($)
{
my ($hash) = @_;
my $buf = DevIo_DoSimpleRead($hash);
###########
# Lets' try again: Some drivers return len(0) on the first read...
if(defined($buf) && length($buf) == 0) {
$buf = DevIo_DoSimpleRead($hash);
}
if(!defined($buf) || length($buf) == 0) {
DevIo_Disconnected($hash);
return undef;
}
return $buf;
}
########################
# Read until you get the timeout. Use it with care
sub
DevIo_TimeoutRead($$)
{
my ($hash, $timeout) = @_;
my $answer = "";
for(;;) {
my $rin = "";
vec($rin, $hash->{FD}, 1) = 1;
my $nfound = select($rin, undef, undef, $timeout);
last if($nfound <= 0);
my $r = DevIo_DoSimpleRead($hash);
last if(!defined($r));
$answer .= $r;
}
return $answer;
}
########################
# Input is HEX, with header and CRC
sub
DevIo_SimpleWrite($$)
{
my ($hash, $msg) = @_;
return if(!$hash);
my $name = $hash->{NAME};
my $ll5 = GetLogLevel($name,3);
Log $ll5, "DevIo SW: $msg";
####################################################
if($hash->{HIDDev}) #added for HM-USB-CFG by peterp
{
$msg =~ s/,//g;
my $msg1 = substr($msg,0,1);
my $msg2 = pack('H*', substr($msg,1));
$msg = $msg1 . $msg2 . "\r\n";
syswrite($hash->{HIDDev}, $msg);
my $tmsg = unpack('H*', $msg);
Log 2, "DevIo_SimpleWrite: $tmsg";
}
else
####################################################
{
$msg = pack('H*', $msg) if($ishex);
$hash->{USBDev}->write($msg) if($hash->{USBDev});
syswrite($hash->{TCPDev}, $msg) if($hash->{TCPDev});
syswrite($hash->{DIODev}, $msg) if($hash->{DIODev});
}
select(undef, undef, undef, 0.001);
}
########################
sub
DevIo_OpenDev($$$)
{
my ($hash, $reopen, $initfn) = @_;
my $dev = $hash->{DeviceName};
my $name = $hash->{NAME};
my $po;
my $baudrate;
($dev, $baudrate) = split("@", $dev);
$hash->{PARTIAL} = "";
Log 4, "DEVIO OpenDev $name device $dev"
if(!$reopen);
if($dev =~ m/^(.+):([0-9]+)$/) { # host:port
# This part is called every time the timeout (5sec) is expired _OR_
# somebody is communicating over another TCP connection. As the connect
# for non-existent devices has a delay of 3 sec, we are sitting all the
# time in this connect. NEXT_OPEN tries to avoid this problem.
if($hash->{NEXT_OPEN} && time() < $hash->{NEXT_OPEN}) {
return;
}
my $conn = IO::Socket::INET->new(PeerAddr => $dev);
if($conn) {
delete($hash->{NEXT_OPEN})
} else {
Log(3, "Can't connect to IPDEV $dev: $!") if(!$reopen);
$readyfnlist{"$name.$dev"} = $hash;
$hash->{STATE} = "disconnected";
$hash->{NEXT_OPEN} = time()+60;
return "";
}
$hash->{TCPDev} = $conn;
$hash->{FD} = $conn->fileno();
delete($readyfnlist{"$name.$dev"});
$selectlist{"$name.$dev"} = $hash;
} elsif($baudrate && lc($baudrate) eq "directio") { # Without Device::SerialPort
if(!open($po, "+<$dev")) {
return undef if($reopen);
Log(3, "Can't open $dev: $!");
$readyfnlist{"$name.$dev"} = $hash;
$hash->{STATE} = "disconnected";
return "";
}
$hash->{DIODev} = $po;
if( $^O =~ /Win/ ) {
$readyfnlist{"$name.$dev"} = $hash;
} else {
$hash->{FD} = fileno($po);
delete($readyfnlist{"$name.$dev"});
$selectlist{"$name.$dev"} = $hash;
}
#################################################### HIDDEV by peterp
} elsif($dev =~ m/^\/dev\/usb\/hiddev[0-9]$/)
{
if(!open($po, "+<$dev"))
{
return undef if($reopen);
Log(3, "Can't open HIDD $dev: $!");
$readyfnlist{"$name.$dev"} = $hash;
$hash->{STATE} = "disconnected";
return "";
}
Log(2, "DevIo opened HID $dev"); #peterp
$hash->{HIDDev} = $po;
if( $^O =~ /Win/ ) {
$readyfnlist{"$name.$dev"} = $hash;
} else {
$hash->{FD} = fileno($po);
delete($readyfnlist{"$name.$dev"});
$selectlist{"$name.$dev"} = $hash;
}
#################################################### HIDDEV by peterp
} else { # USB/Serial device
if ($^O=~/Win/) {
require Win32::SerialPort;
$po = new Win32::SerialPort ($dev);
} else {
require Device::SerialPort;
$po = new Device::SerialPort ($dev);
}
if(!$po) {
return undef if($reopen);
Log(3, "Can't open USB/Seriell $dev: $!");
$readyfnlist{"$name.$dev"} = $hash;
$hash->{STATE} = "disconnected";
return "";
}
$hash->{USBDev} = $po;
if( $^O =~ /Win/ ) {
$readyfnlist{"$name.$dev"} = $hash;
} else {
$hash->{FD} = $po->FILENO;
delete($readyfnlist{"$name.$dev"});
$selectlist{"$name.$dev"} = $hash;
}
if($baudrate) {
$po->reset_error();
Log 3, "Setting $name baudrate to $baudrate";
$po->baudrate($baudrate);
$po->databits(8);
$po->parity('none');
$po->stopbits(1);
$po->handshake('none');
# This part is for some Linux kernel versions whih has strange default
# settings. Device::SerialPort is nice: if the flag is not defined for your
# OS then it will be ignored.
$po->stty_icanon(0);
#$po->stty_parmrk(0); # The debian standard install does not have it
$po->stty_icrnl(0);
$po->stty_echoe(0);
$po->stty_echok(0);
$po->stty_echoctl(0);
# Needed for some strange distros
$po->stty_echo(0);
$po->stty_icanon(0);
$po->stty_isig(0);
$po->stty_opost(0);
$po->stty_icrnl(0);
}
$po->write_settings;
}
if($reopen) {
Log 1, "$dev reappeared ($name)";
} else {
Log 3, "$name device $dev opened";
}
$hash->{STATE}="opened";
my $ret;
if($initfn) {
my $ret = &$initfn($hash);
if($ret) {
DevIo_CloseDev($hash);
Log 1, "Cannot init $dev, ignoring it";
}
}
DoTrigger($name, "CONNECTED") if($reopen);
return $ret;
}
########################
sub
DevIo_CloseDev($)
{
my ($hash) = @_;
my $name = $hash->{NAME};
my $dev = $hash->{DeviceName};
return if(!$dev);
if($hash->{TCPDev}) {
$hash->{TCPDev}->close();
delete($hash->{TCPDev});
} elsif($hash->{USBDev}) {
$hash->{USBDev}->close() ;
delete($hash->{USBDev});
} elsif($hash->{DIODev}) {
close($hash->{DIODev});
delete($hash->{DIODev});
} elsif($hash->{HIDDev}) { #added for HM-USB-CFG by peterp
close($hash->{HIDDev});
delete($hash->{HIDDev});
}
($dev, undef) = split("@", $dev); # Remove the baudrate
delete($selectlist{"$name.$dev"});
delete($readyfnlist{"$name.$dev"});
delete($hash->{FD});
}
sub
DevIo_Disconnected($)
{
my $hash = shift;
my $dev = $hash->{DeviceName};
my $name = $hash->{NAME};
my $baudrate;
($dev, $baudrate) = split("@", $dev);
return if(!defined($hash->{FD})); # Already deleted or RFR
Log 1, "$dev disconnected, waiting to reappear";
DevIo_CloseDev($hash);
$readyfnlist{"$name.$dev"} = $hash; # Start polling
$hash->{STATE} = "disconnected";
# Without the following sleep the open of the device causes a SIGSEGV,
# and following opens block infinitely. Only a reboot helps.
sleep(5);
DoTrigger($name, "DISCONNECTED");
}
1;

90
contrib/contrib/HM-USB-CFG/README.txt Normal file
View File

@ -0,0 +1,90 @@
Hallo Rudi,
anbei meine aktuelle Version von HMLAN ud DevIo für den HM-USB-CFG.
Ich hab es bislang aber nicht geschaft zu senden. Als Monitor ist die
Version aber brauchbar. Bitte schau drüber ob die Qualität for das
contrib Verzeichniss reicht. Wenn's passt bitte einchecken. Vielleicht
hat ja jemand eine Idee was fehlt...
Ich hab alle Änderungen deutlich mit
for HM-USB-CFG by peterp bzw. HIDDEV by peterp
gekennzeichnet und mit
if($hash->{HIDDev})
abgetrennt. Die Originalfuntionalität sollte also durch meine
Änderungen nicht beeinträchtigt sein.
In der config datei definiert man
define HMUSB HMLAN /dev/usb/hiddev0
attr HMUSB addvaltrigger RSSI
attr HMUSB hmId 123456
attr HMUSB hmProtocolEvents 1
attr HMUSB room Innen
in der Logdatei sieht das dann so aus:
2012.04.01 20:02:22.828 2: DevIo opened HID /dev/usb/hiddev0
2012.04.01 20:02:22.839 2: DevIo_SimpleWrite: 4178987d0d0a
2012.04.01 20:02:22.850 2: DevIo_SimpleWrite: 430d0a
2012.04.01 20:02:22.862 2: DevIo_SimpleWrite: 5901010d0a
2012.04.01 20:02:22.873 2: DevIo_SimpleWrite: 5902000d0a
2012.04.01 20:02:22.885 2: DevIo_SimpleWrite: 5903000d0a
2012.04.01 20:02:22.896 2: DevIo_SimpleWrite: 5903000d0a
2012.04.01 20:02:22.908 2: DevIo_SimpleWrite: 54170b54ae0400000000000d0a
2012.04.01 20:02:23.607 0: Server started (version =VERS= from =DATE=
($Id$), pid 10178)
2012.04.01 20:02:47.946 2: DevIo_SimpleWrite: 4b0d0a
2012.04.01 20:03:10.639 2: SYS HMUSB RCV L:0C N:8A CMD:A041
(TYPE=65,BCAST,BIDI,RPTEN) SRC:14F617 DST:123456 018100
2012.04.01 20:03:10.755 2: DevIo_SimpleWrite: 2b14f61700000d0a
2012.04.01 20:03:10.767 2: DevIo_SimpleWrite: 2b14f61700000d0a
2012.04.01 20:03:10.779 2: DevIo_SimpleWrite: 2b14f61700000d0a
2012.04.01 20:03:10.790 2: DevIo_SimpleWrite: 2d14f6170d0a
2012.04.01 20:03:10.802 2: DevIo_SimpleWrite: 2b14f61700000d0a
2012.04.01 20:03:10.813 2: DevIo_SimpleWrite: 2b14f61700000d0a
2012.04.01 20:03:10.825 2: DevIo_SimpleWrite: 2b14f61700000d0a
2012.04.01 20:03:10.837 2: DevIo_SimpleWrite: 2b14f61700000d0a
2012.04.01 20:03:10.848 2: DevIo_SimpleWrite:
536f1333ac0000000000016f1333ac01800212345614f617010100000d0a
2012.04.01 20:03:10.889 2: SYS HMUSB SND L:0D N:01 CMD:8002
(TYPE=2,RPTEN) SRC:123456 DST:14F617 01010000 (ACK_STATUS CHANNEL:01
STATUS:00)
2012.04.01 20:03:10.908 2: HM-TFK LSE_TFKTEST closed
2012.04.01 20:03:10.911 2: HM-TFK LSE_TFKTEST contact: closed
2012.04.01 20:03:10.930 2: SYS HMUSB RCV L:0C N:8A CMD:A041
(TYPE=65,BIDI,RPTEN) SRC:14F617 DST:123456 018100
2012.04.01 20:03:11.046 2: DevIo_SimpleWrite:
536f1334710000000000016f13347102800212345614f617010100000d0a
2012.04.01 20:03:11.086 2: SYS HMUSB SND L:0D N:02 CMD:8002
(TYPE=2,RPTEN) SRC:123456 DST:14F617 01010000 (ACK_STATUS CHANNEL:01
STATUS:00)
2012.04.01 20:03:11.407 2: SYS HMUSB RCV L:0C N:8A CMD:A041
(TYPE=65,BIDI,RPTEN) SRC:14F617 DST:123456 018100
2012.04.01 20:03:11.523 2: DevIo_SimpleWrite:
536f13364e0000000000016f13364e03800212345614f617010100000d0a
2012.04.01 20:03:11.563 2: SYS HMUSB SND L:0D N:03 CMD:8002
(TYPE=2,RPTEN) SRC:123456 DST:14F617 01010000 (ACK_STATUS CHANNEL:01
STATUS:00)
2012.04.01 20:03:12.431 2: SYS HMUSB RCV L:0C N:8A CMD:A041
(TYPE=65,BIDI,RPTEN) SRC:14F617 DST:123456 018100
2012.04.01 20:03:12.547 2: DevIo_SimpleWrite:
536f133a4e0000000000016f133a4e04800212345614f617010100000d0a
2012.04.01 20:03:12.587 2: SYS HMUSB SND L:0D N:04 CMD:8002
(TYPE=2,RPTEN) SRC:123456 DST:14F617 01010000 (ACK_STATUS CHANNEL:01
STATUS:00)
2012.04.01 20:03:14.447 2: SYS HMUSB RCV L:0C N:8A CMD:A041
(TYPE=65,BIDI,RPTEN) SRC:14F617 DST:123456 018100
2012.04.01 20:03:14.563 2: DevIo_SimpleWrite:
536f13422e0000000000016f13422e05800212345614f617010100000d0a
2012.04.01 20:03:14.603 2: SYS HMUSB SND L:0D N:05 CMD:8002
(TYPE=2,RPTEN) SRC:123456 DST:14F617 01010000 (ACK_STATUS CHANNEL:01
STATUS:00)
2012.04.01 20:03:18.511 2: SYS HMUSB RCV L:0C N:8A CMD:A041
(TYPE=65,BIDI,RPTEN) SRC:14F617 DST:123456 018100
Grüße aus Wien
Peter

280
contrib/contrib/HMRPC/00_HMRPC.pm Executable file
View File

@ -0,0 +1,280 @@
###########################################################
#
# HomeMatic XMLRPC API Device Provider
# Written by Oliver Wagner <owagner@vapor.com>
#
# V0.5
#
###########################################################
#
# This module implements the documented XML-RPC based API
# of the Homematic system software (currently offered as
# part of the CCU1 and of the LAN config adapter software)
#
# This module operates a http server to receive incoming
# xmlrpc event notifications from the HM software.
#
# Individual devices are then handled by 01_HMDEV.pm
#
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
use RPC::XML::Server;
use RPC::XML::Client;
use Dumpvalue;
my $dumper=new Dumpvalue;
$dumper->veryCompact(1);
sub HMRPC_Initialize($)
{
my ($hash) = @_;
$hash->{DefFn} = "HMRPC_Define";
$hash->{ShutdownFn} = "HMRPC_Shutdown";
$hash->{ReadFn} = "HMRPC_Read";
$hash->{SetFn} = "HMRPC_Set";
$hash->{GetFn} = "HMRPC_Get";
$hash->{Clients} = ":HMDEV:";
}
#####################################
sub
HMRPC_Shutdown($)
{
my ($hash) = @_;
# Uninitialize again
if($hash->{callbackurl})
{
Log(2,"HMRPC unitializing callback ".$hash->{callbackurl});
$hash->{client}->send_request("init",$hash->{callbackurl});
}
return undef;
}
#####################################
sub
HMRPC_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
if(@a != 4) {
my $msg = "wrong syntax: define <name> HMRPC remote_host remote_port";
Log 2, $msg;
return $msg;
}
$hash->{serveraddr}=$a[2];
$hash->{serverport}=$a[3];
$hash->{client}=RPC::XML::Client->new("http://$a[2]:$a[3]/");
my $callbackport=5400+$hash->{serverport};
$hash->{server}=RPC::XML::Server->new(port=>$callbackport);
if(!ref($hash->{server}))
{
# Creating the server failed, perhaps because the port was
# already in use. Just return the message
Log 1,"Can't create HMRPC callback server on port $callbackport. Port in use?";
return $hash->{server};
}
$hash->{server}->{fhemdef}=$hash;
# Add the XMLRPC methods we do expose
$hash->{server}->add_method(
{name=>"event",signature=> ["string string string string int","string string string string double","string string string string boolean","string string string string i4"],code=>\&HMRPC_EventCB}
);
$hash->{server}->add_method(
{name=>"newDevices",signature=>["array string array"],code=>\&HMRPC_NewDevicesCB }
);
#
# Dummy implementation, always return an empty array
#
$hash->{server}->add_method(
{name=>"listDevices",signature=>["array string"],code=>sub{return RPC::XML::array->new()} }
);
$hash->{STATE} = "Initialized";
$hash->{SERVERSOCKET}=$hash->{server}->{__daemon};
$hash->{FD}=$hash->{SERVERSOCKET}->fileno();
$hash->{PORT}=$hash->{server}->{__daemon}->sockport();
# This will also register the callback
HMRPC_CheckCallback($hash);
$selectlist{"$hash->{serveraddr}.$hash->{serverport}"} = $hash;
#
# All is well
#
return 0;
}
sub
HMRPC_CheckCallback($)
{
my ($hash) = @_;
# We recheck the callback every 15 minutes. If we didn't receive anything
# inbetween, we re-init just to make sure (CCU reboots etc.)
InternalTimer(gettimeofday()+(15*60), "HMRPC_CheckCallback", $hash, 0);
if(!$hash->{lastcallbackts})
{
HMRPC_RegisterCallback($hash);
return;
}
my $age=int(gettimeofday()-$hash->{lastcallbackts});
if($age>(15*60))
{
Log 5,"HMRPC Last callback received more than $age seconds ago, re-init-ing";
HMRPC_RegisterCallback($hash);
}
}
sub
HMRPC_RegisterCallback($)
{
my ($hash) = @_;
#
# We need to find out our local address. In order to do so,
# we establish a dummy connection to the remote xmlrpc server
# and then look at the local socket address assigned to us.
#
my $dummysock=IO::Socket::INET->new(PeerAddr=>$hash->{serveraddr},PeerPort=>$hash->{serverport});
if(!$dummysock)
{
Log(2,"HMRPC unable to connect to ".$hash->{serveraddr}.":".$hash->{serverport}." ($!), will retry later");
return;
}
$hash->{callbackurl}="http://".$dummysock->sockhost().":".$hash->{PORT}."/fh";
$dummysock->close();
Log(2, "HMRPC callback listening on $hash->{callbackurl}");
# We need to fork here, as the xmlrpc server will synchronously call us
if(!fork())
{
$hash->{client}->send_request("init",$hash->{callbackurl},"CB1");
Log(2, "HMRPC callback with URL ".$hash->{callbackurl}." initialized");
exit(0);
}
}
#####################################
# Process device info
sub
HMRPC_NewDevicesCB($$$)
{
my ($server, $cb, $a) = @_;
my $hash=$server->{fhemdef};
Log(2,"HMRPC received ".scalar(@$a)." device specifications");
# We receive an array of hashes with the device information. We
# store those hashes again in a hash, keyed by address, for later
# use by the individual devices
for my $dev (@$a)
{
my $addr=$dev->{ADDRESS};
$hash->{devicespecs}{$addr}=$dev;
}
return RPC::XML::array->new();
}
#####################################
sub
HMRPC_EventCB($$$$$)
{
my ($server,$cb,$devid,$attr,$val)=@_;
Log(5, "Processing event setting $devid->$attr=$val" );
Dispatch($server->{fhemdef},"HMDEV $devid $attr $val",undef);
$server->{fhemdef}->{lastcallbackts}=gettimeofday();
}
sub
HMRPC_Read($)
{
my ($hash) = @_;
#
# Handle an incoming callback
#
my $conn=$hash->{server}->{__daemon}->accept();
$conn->timeout(20);
$hash->{server}->process_request($conn);
$conn->close;
undef $conn;
}
################################
#
#
sub
HMRPC_Set($@)
{
my ($hash, @a) = @_;
#return "invalid set specification @a" if(@a != 4 && @a != 5);
my $cmd=$a[1];
if($cmd eq "req")
{
# Send a raw xmlrpc request and return the result in
# text form. This is mainly useful for diagnostics.
shift @a;
shift @a;
my $ret=$hash->{client}->simple_request(@a);
# We convert using Dumpvalue. As this only prints, we need
# to temporarily redirect STDOUT
my $res="";
open(my $temp,"+>",\$res);
my $oldout=select($temp);
$dumper->dumpValue($ret);
close(select($oldout));
return $res;
}
my $ret;
if(@a==5)
{
my $paramset={$a[3]=>$a[4]};
$ret=$hash->{client}->simple_request("putParamset",$a[1],$a[2],$paramset);
}
else
{
$ret=$hash->{client}->simple_request("setValue",$a[1],$a[2],$a[3]);
}
if($ret)
{
return $ret->{faultCode}.": ".$ret->{faultString};
}
else
{
return undef;
}
}
################################
#
#
sub
HMRPC_Get($@)
{
my ($hash,@a) = @_;
return "argument missing, usage is <id> <attribute> @a" if(@a!=3);
my $ret=$hash->{client}->simple_request("getValue",$a[1],$a[2]);
if(ref($ret))
{
return $ret->{faultCode}.": ".$ret->{faultString};
}
return $ret;
}
1;

155
contrib/contrib/HMRPC/01_HMDEV.pm Normal file
View File

@ -0,0 +1,155 @@
################################################
# HMRPC Device Handler
# Written by Oliver Wagner <owagner@vapor.com>
#
# V0.5
#
################################################
#
# This module handles individual devices via the
# HMRPC provider.
#
package main;
use strict;
use warnings;
sub
HMDEV_Initialize($)
{
my ($hash) = @_;
$hash->{Match} = "^HMDEV .* .* .*";
$hash->{DefFn} = "HMDEV_Define";
$hash->{ParseFn} = "HMDEV_Parse";
$hash->{SetFn} = "HMDEV_Set";
$hash->{GetFn} = "HMDEV_Get";
$hash->{AttrList} = "IODev do_not_notify:0,1";
}
#############################
sub
HMDEV_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $name = $hash->{NAME};
return "wrong syntax: define <name> HMDEV deviceaddress" if int(@a)!=3;
my $addr=$a[2];
$hash->{hmaddr}=$addr;
$modules{HMDEV}{defptr}{$addr} = $hash;
AssignIoPort($hash);
if($hash->{IODev}->{NAME})
{
Log 5,"Assigned $name to $hash->{IODev}->{NAME}";
}
return undef;
}
#############################
sub
HMDEV_Parse($$)
{
my ($hash, $msg) = @_;
my @mp=split(" ",$msg);
my $addr=$mp[1];
my $attrid=$mp[2];
$hash=$modules{HMDEV}{defptr}{$addr};
if(!$hash)
{
# If not explicitely defined, reroute this event to the main device
# with a suffixed attribute name
$addr=~s/:([0-9]{1,2})//;
my $subdev=$1;
if($subdev>0)
{
$attrid.="_$subdev";
}
$hash=$modules{HMDEV}{defptr}{$addr};
}
if(!$hash)
{
Log(2,"Received callback for unknown device $msg");
return "UNDEFINED HMDEV_$addr HMDEV $addr";
}
# Let's see whether we can update our devinfo now
if(!defined $hash->{devinfo})
{
$hash->{hmdevinfo}=$hash->{IODev}{devicespecs}{$addr};
$hash->{hmdevtype}=$hash->{hmdevinfo}{TYPE};
}
#
# Ok update the relevant reading
#
my @changed;
my $currentval=$hash->{READINGS}{$attrid}{VAL};
$hash->{READINGS}{$attrid}{TIME}=TimeNow();
# Note that we always trigger a change on PRESS_LONG/PRESS_SHORT events
# (they are sent whenever a button is pressed, and there is no change back)
# We also never trigger a change on the RSSI readings, for efficiency purposes
if(!defined $currentval || ($currentval ne $mp[3]) || ($attrid =~ /^PRESS_/))
{
if(defined $currentval && !($currentval =~ m/^RSSI_/))
{
push @changed, "$attrid: $mp[3]";
}
$hash->{READINGS}{$attrid}{VAL}=$mp[3];
# Also update the STATE
my $state="";
foreach my $key (sort(keys(%{$hash->{READINGS}})))
{
if(length($state))
{
$state.=" ";
}
$state.=$key.": ".$hash->{READINGS}{$key}{VAL};
}
$hash->{STATE}=$state;
}
$hash->{CHANGED}=\@changed;
return $hash->{NAME};
}
################################
sub
HMDEV_Set($@)
{
my ($hash, @a) = @_;
return "invalid set call @a" if(@a != 3 && @a != 4);
# We delegate this call to the HMRPC IODev, after having added the device address
if(@a==4)
{
return HMRPC_Set($hash->{IODev},$hash->{IODev}->{NAME},$hash->{hmaddr},$a[1],$a[2],$a[3]);
}
else
{
return HMRPC_Set($hash->{IODev},$hash->{IODev}->{NAME},$hash->{hmaddr},$a[1],$a[2]);
}
}
################################
sub
HMDEV_Get($@)
{
my ($hash, @a) = @_;
return "argument missing, usage is <attribute> @a" if(@a!=2);
# Like set, we simply delegate to the HMPRC IODev here
return HMRPC_Get($hash->{IODev},$hash->{IODev}->{NAME},$hash->{hmaddr},$a[1]);
}
1;

150
contrib/contrib/HMRPC/HMRPC.txt Normal file
View File

@ -0,0 +1,150 @@
HMRPC - xmlrpc-basierte Homematic-Integration fuer fhem
=======================================================
Von Oliver Wagner <owagner@vapor.com>
V0.5
Uebersicht
----------
HMRPC ist ein Modul zur Integration des Homematic-Systems der Firma EQ-3
mit fhem. Es verfolgt im Gegensatz zu den bereits vorhandenen CUL_HM/HMLAN-
Modulen einen anderen Ansatz: Statt direkt mit der Funk-Hardware zu
kommunizieren, verwendet es die offizielle bereitgestellte xmlrpc-basierte
API der EQ-3-Software (siehe [1]). Daraus ergeben sich Vorteile und
Nachteile: So sind implizit alle derzeitigen und auch zukuenftigen Geraete
vollumfaenglich unterstuetzt, auch die RS485 Wired-Module.
Der wesentliche Nachteil, oder zumindestens eine Vorraussetzung, ist, dass
man eine Instanz der xmlrpc-Server benoetigt. Dazu gibt es aktuell drei
Moeglichkeiten:
1) auf der CCU1 selbst laufen "rfd" fuer die Funkkommunikation und
"hs485d" fuer die Wired-Kommunikaiton.
Eine Uebersicht der Softwarearchitektur der CCU1 findet sich unter [2]
2) als Teil der Verwaltungssoftware fuer den HM-LAN-Aadapter (siehe [3]) gibt
es einen xmlrpc-Dienst fuer Funkkommunikation als Windows-Service. Dieser
entspricht dem "rfd" auf der CCU1.
3) Nutzung des "rfd" aus einem CCU1-Firmware-Image mittels "qemu-arm"
Es ist aber nicht auszuschliessen, das EQ-3 in Zukunft z.B. einen rfd fuer
Linux/x86 veroeffentlicht.
Geschichte und Status
---------------------
Diese Module sind aus der Middleware "HMCompanion" [4] entstanden, die ich mir
fuer die HM-Integration in meinen Haussteuerungswildwuchs geschrieben habe.
HMRPC hat aktuell eher experimentellen Charakter. Ohne genaue Kenntnisse
von fhem, perl und HM-Internas haben die Module nur eingeschraenkten Nutzwert,
die Veroeffentlichung dient erstmal nur dazu, fruehes Feedback zur
Implementierung zu bekommen.
Das ist im iebrigen mein erstes nicht komplett triviales Stueck perl-code --
ueber Hinweise diesbezueglich wuerde ich mich ebenso freuen wie ueber allgemeines
Feedback zu HMRPC.
Benutzung
---------
Es gibt zwei Module:
00_HMRPC.pm ist der Provider fuer die Kommunikation mit eineml
xmlrpc-Service
01_HMDEV.pm ist jeweils die Abstraktion eines einzelnen Devices
Beispielkonfiguration fuer fhem:
# Wired-Schnittstelle auf einer CCU1 mit IP 192.168.5.2)
define hmw HMRPC 192.168.5.2 2000
# Ein Kanal eines Wired-Aktors
define light_buero_olli HMDEV GEQ0009019:3
Nutzung dann z.B. mit
set light_buero_olli STATE false
Ein putParamset (Konfigurationsupdate) wird dann durch zusätzliche Angabe
der Paramset-ID generiert:
set light_buero_olli MASTER LOGGING 0
Die Attribute eines Geraetes entsprechen den in dem Dokument unter [1]
"HomeMatic-Script Dokumentation: Teil 4 - Datenpunkte" beschriebenen.
Die Inhalte der Paramsets sind aktuell nicht dokumentiert, man muss diese
anhand des xmlrpc-Requests getParamsetDescription oder durch Browsen der
XML-Beschreibungen im /firmware-Verzeichnis der CCU-Software
ermitteln.
Über die set-Methode des HMRPC-Devices lassen sich auch andere weitere
Operationen durchführen:
set <hmlrpc-device> req <xmlrpc-request> <parameter>
generiert einen direkten XMLRPC-Request und gibt das Ergebnis in Textform
zurück. Das dient im wesentlichen Diagnose/Entwicklungszwecken. Beispiel:
set hmw req getDeviceDescription IEQ0208603
Der get-Aufruf ist ebenfalls implementiert und fuehrt einen synchronen
"getValue()"-Aufruf durch:
get light_buero_olli STATE
Design
------
Ich habe ueberlegt, ob HMRPC als Provider für CUL_HM dienen koennte, habe aber
keine praktikable Loesung dafür gefunden -- HMDEV ist aktuell im Vergleich zu
CUL_HM sehr dumm und dient mehr oder weniger nur als Cache für Adresse und
Readings.
HMRPC meldet sich beim jeweiligen Service per "init" an und erhält dann per
xmlrpc-Callback Mitteilungen über Zustandsaenderungen. Wird der Service neu
gestartet (CCU Reboot o.ae.), ist diese Anmeldung hinfaellig. Es gibt aktuell
keine gute Methode, dies festzustelle -- als Workaround meldet sich HMRPC
15 Minuten nach dem letzten empfangenen Callback neu an. Je nach Art der
verwendeten Aktoren in einer Installation kann diese Zeit sehr kurz sein
und daher unnoetige re-inits verursachen. Diese scheinen aber grundsaetzlich kein
Problem auf der Service-Seite darzustellen.
Aenderungen
-----------
V0.3 - get-Methoden implementiert, als Aufruf von XML-RPC getValue()
- bei Boolean-Werten wurde bei false bei jedem event-Empfang
faelschlicherweise eine Notification ausgeloest
V0.4 - HMRPC: Fehlermeldung statt Abbruch, wenn eine Testverbindung zum
entsprechenden Daemon nicht moeglich ist
HMRPC: Beim Abmelden wird nun korrekterweise kein Callback-Parameter
uebergeben
HMRPC: Das Default-Timeout fuer eingehende Requests ist nun auf 20s
gesetzt, da die 3s bei sehr grossen eingehenden Requests offenbar
zu kurz war und so z.B. der initiale newDevices-Aufruf nach dem init
abgebrochen wurde, was zu einem Absturz des rfd fuehrt
HMRPC: Ist ein Channel unbekannt, wird nun der Event an das entsprechende
Device delegiert, fuer Channel != 0 dann mit dem Suffix _ChannelID
(z.B. STATE_1)
HMRPC: PRESS_ loest nun wirklich jedesmal ein changed aus.
import_webui: Pattern korrigiert, so dass nun auch die virtuellen
Taster erkannt werden
V0.5 - HMDEV: Es wird nun STATE sinnvoll gesetzt, als Zusammenfasung aller
READINGS
HMRPC: Der newDevices-Aufruf wird nun ausgewertet und die uebermittelten
Device/Channel-Informationen werden an die HMDEV-Objekte gehanden, als
"hmdevinfo"; gleichzeitig wird "hmdevtype" auf den HM-Devicetyp
Anhang
------
[1] http://www.homematic.com/index.php?id=156
[2] http://www.homematic-wiki.info/mw/index.php/HomeMatic_Software
[3] http://www.homematic.com/index.php?id=644
[4] http://www.fhz-forum.de/viewtopic.php?f=26&t=4639

100
contrib/contrib/HMRPC/import_from_webui.bsh Normal file
View File

@ -0,0 +1,100 @@
#!/bin/bash
#
# This script gets the full device list from a running
# CCU1 and creates a prototype config file fragment
# for use with fhem and HMRPC.
#
# Note that this script assumes that the wired HMRPC
# device is called "hmw" and the RF HMRPC device
# is called "hmrf"
#
if [ -z "$1" ]; then
echo "Usage: import_from_webui.bsh <ccu hostname>"
exit 1
fi
# We need a ISO-8859-1 locale now
export LANG=de_DE.ISO-8859-1
wget http://$1:8181/tclrega.exe --post-data='
string id;
string chid;
foreach(id, dom.GetObject(ID_DEVICES).EnumUsedIDs())
{
var d=dom.GetObject(id);
foreach(chid,d.Channels().EnumUsedIDs())
{
var ch=dom.GetObject(chid);
var i=dom.GetObject(ch.Interface());
string rspec;
string rid;
foreach(rid,ch.ChnRoom())
{
var r=dom.GetObject(rid);
rspec = rspec # r.Name() # "%";
}
WriteLine(ch.Address() # "\t" # i.Name() # "\t" # ch.Name() # "\t" # rspec);
}
var i=dom.GetObject(d.Interface());
WriteLine(d.Address()+"\t"+i.Name()+"\t"+d.Name());
}' -q -O- | dos2unix | gawk --re-interval -- '
BEGIN {
FS="\t"
}
#
# Convert a WebUI name into something which fhem accepts in a config file
#
function sanitizeName(n)
{
# Blanks
gsub(" ","_",n)
# Umlauts
gsub("\xe4","ae",n);
gsub("\xf6","oe",n);
gsub("\xfc","ue",n);
gsub("\xdf","ss",n);
gsub("\xc4","Ae",n);
gsub("\xd6","Oe",n);
gsub("\xdc","Ue",n);
# : (for unnamed devices)
gsub(":|/|-","_",n);
gsub("\\(|\\)","",n);
return tolower(n)
}
function roomName(n)
{
gsub(" ","",n)
gsub("%$","",n)
gsub("%",",",n)
return n;
}
/^BidCoS-|^[A-Z0-9]{10}(:[0-9]+)?/ {
name=sanitizeName($3)
while(usednames[name])
{
# Ok name is in use. Are we perhaps the master device?
if(!index($1,":"))
{
name=name "_dev"
continue;
}
# Are suffixed by a name? Inc
if(match(name,"(.*)([0-9]+)",pa))
{
name=pa[1] (pa[2]+1)
continue;
}
# Just append a "1" (might get inced in next iteration)
name = name "1"
}
usednames[name]=1
print "define " name " HMDEV " $1
print "attr " name " IODev " (index($2,"BidCos-RF")?"hmrf":"hmw")
if($4)
{
print "attr " name " room " roomName($4)
}
print ""
}
'

465
contrib/contrib/JeeStuff/00_JeeLink.pm Normal file
View File

@ -0,0 +1,465 @@
################################################################################
# FHEM-Modul see www.fhem.de
# 00_JeeLink.pm
# Modul to use a JeeLink with RF12DEMO as FHEM-IO-Device
#
# Usage: define <Name> JeeLink </dev/...> NodeID
################################################################################
# This program 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 3 of the License, or
# (at your option) any later version.
#
# This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
################################################################################
# Autor: Axel Rieger
# Version: 1.0
# Datum: 07.2011
# Kontakt: fhem [bei] anax [punkt] info
################################################################################
package main;
use strict;
use warnings;
use Data::Dumper;
use vars qw(%defs);
use vars qw(%attr);
use vars qw(%data);
use vars qw(%modules);
sub JeeLink_Initialize($);
sub JEE_Define($$);
sub JEE_CloseDev($);
sub JEE_OpenDev($$);
sub JEE_Ready($);
sub JEE_Read($);
sub JEE_Set($);
################################################################################
sub JeeLink_Initialize($)
{
my ($hash) = @_;
# Provider
$hash->{ReadFn} = "JEE_Read";
$hash->{ReadyFn} = "JEE_Ready";
$hash->{SetFn} = "JEE_Set";
$hash->{WriteFn} = "JEE_Write";
$hash->{Clients} = ":JSN:JME:JPU";
$hash->{WriteFn} = "JEE_Write";
my %mc = (
"1:JSN" => "^JSN",
"2:JME" => "^JME",
"3:JPU" => "^JPU");
$hash->{MatchList} = \%mc;
# Normal devices
$hash->{DefFn} = "JEE_Define";
$hash->{AttrList} = "do_not_notify:1,0 dummy:1,0 loglevel:0,1 ";
return undef;
}
################################################################################
sub JEE_Define($$) {
# define JEE0001 JeeLink /dev/tty.usbserial-A600cKlS NodeID
# defs = $a[0] <DEVICE-NAME> $a[1] DEVICE-TYPE $a[2]<Parameter-1->;
my ($hash, $def) = @_;
my @a = split(/\s+/, $def);
my $name = $a[0];
my $dev = $a[2];
my $NodeID = $a[3];
if($dev eq "none") {
Log 1, "$name device is none, commands will be echoed only";
$hash->{TYPE} = 'JeeLink';
$hash->{STATE} = TimeNow() . " Dummy-Device";
$attr{$name}{dummy} = 1;
return undef;
}
JEE_CloseDev($hash);
if($NodeID == 0 || $NodeID > 26 ) {return "JeeLink: NodeID between 1 and 26";}
Log 0, "JEE-Define: Name = $name dev=$dev";
$hash->{DeviceName} = $dev;
$hash->{TYPE} = 'JeeLink';
my $ret = JEE_OpenDev($hash, 0);
my $msg = $NodeID . "i";
$ret = &JEE_IOWrite($hash, $msg);
return undef;
}
################################################################################
sub JEE_Set($){
my ($hash, @a) = @_;
# Log 0, ("JEE-SET: " . Dumper(@_));
my $fields .= "NodeID NetGRP Frequenz LED CollectMode SendMSG BroadcastMSG RAW";
return "Unknown argument $a[1], choose one of ". $fields if($a[1] eq "?");
# a[0] = DeviceName
# a[1] = Command
# Command
# nodeID: <n>i set node ID (standard node ids are 1..26 or 'A'..'Z')
# netGRP: <n>g set network group (RFM12 only allows 212)
# freq -> <n>b set MHz band (4 = 433, 8 = 868, 9 = 915)
# cMode -> <n>c - set collect mode (advanced 1, normally 0)
# bCast -> t - broadcast max-size test packet, with ack
# sendA -> ...,<nn> a - send data packet to node <nn>, with ack
# sendS -> ...,<nn> s - send data packet to node <nn>, no ack
# led -> <n> l - turn activity LED on PB1 on or off
# Remote control commands:
# <hchi>,<hclo>,<addr>,<cmd> f - FS20 command (868 MHz)
# <addr>,<dev>,<on> k - KAKU command (433 MHz)
# Flash storage (JeeLink v2 only):
# d - dump all log markers
# <sh>,<sl>,<t3>,<t2>,<t1>,<t0> r - replay from specified marker
# 123,<bhi>,<blo> e - erase 4K block
# 12,34 w - wipe entire flash memory
my($name, $msg);
$name = $a[0];
# LogLevel
my $ll = 0;
if(defined($attr{$name}{loglevel})) {$ll = $attr{$name}{loglevel};}
Log $ll,"$name/JEE-SET: " . $a[1] . " : " . $a[2];
# @a ge 2
# if(int(@a) ne 3) {return "JeeLink wrong Argument Count";}
$msg = "";
if($a[1] eq "NodeID") {
if($a[2] == 0 || $a[2] > 26 ) {return "JeeLink: NodeID between 1 and 26";}
$msg = $a[2] . "i";}
if($a[1] eq "NetGRP") {
if($a[2] == 0 || $a[2] > 255 ) {return "JeeLink: NetGroup between 1 and 255";}
$msg = $a[2] . "g";}
if($a[1] eq "Frequenz") {
if($a[2] !~ m/433|868|933/) {return "JeeLink: Frquenz setting use 433, 868 or 933";}
my $mhz;
if($a[2] eq "433") {$msg = "4b";}
if($a[2] eq "868") {$msg = "8b";}
if($a[2] eq "915") {$msg = "9b";}
# 4 = 433, 8 = 868, 9 = 915
}
# LED
if($a[1] eq "LED" && lc($a[2]) eq "on") {
$hash->{LED} = "ON";
$msg = "1l";}
if($a[1] eq "LED" && lc($a[2]) eq "off") {
$hash->{LED} = "OFF";
$msg = "0l";}
# CollectMode On or Off
if($a[1] eq "CollectMode" && lc($a[2]) eq "on") {
$hash->{CollectMode} = "ON";
$msg = "1c";}
if($a[2] eq "CollectMode" && lc($a[2]) eq "off") {
$hash->{CollectMode} = "OFF";
$msg = "0c";}
# RF12_MSG to Remote Node with NO ack
# set <NAME> SendMSG NodeID Data
if($a[1] eq "SendMSG") {$msg = $a[2] . "," . $a[3] . "s"};
# RF12- BroadcastMSG
if($a[1] eq "BroadcastMSG") {$msg = "t";}
# RAW
if($a[1] eq "RAW") {$msg = $a[2];}
# Send MSG
Log 0,"JEE-SET->WRITE: $msg";
my $ret = &JEE_IOWrite($hash, $msg);
return undef;
}
################################################################################
sub JEE_CloseDev($)
{
my ($hash) = @_;
my $name = $hash->{NAME};
my $dev = $hash->{DeviceName};
return if(!$dev);
$hash->{USBDev}->close() ;
delete($hash->{USBDev});
delete($selectlist{"$name.$dev"});
delete($readyfnlist{"$name.$dev"});
delete($hash->{FD});
}
################################################################################
sub JEE_OpenDev($$)
{
my ($hash, $reopen) = @_;
my $dev = $hash->{DeviceName};
my $name = $hash->{NAME};
my $po;
$hash->{PARTIAL} = "";
Log 3, "JeeLink opening $name device $dev"
if(!$reopen);
my $baudrate;
($dev, $baudrate) = split("@", $dev);
$baudrate = 57600;
if ($^O=~/Win/) {
require Win32::SerialPort;
$po = new Win32::SerialPort ($dev);
} else {
require Device::SerialPort;
$po = new Device::SerialPort ($dev);
}
if(!$po) {
return undef if($reopen);
Log(3, "Can't open $dev: $!");
$readyfnlist{"$name.$dev"} = $hash;
$hash->{STATE} = "disconnected";
return "";
}
$hash->{USBDev} = $po;
if( $^O =~ /Win/ ) {
$readyfnlist{"$name.$dev"} = $hash;
} else {
$hash->{FD} = $po->FILENO;
delete($readyfnlist{"$name.$dev"});
$selectlist{"$name.$dev"} = $hash;
}
if($baudrate) {
$po->reset_error();
Log 3, "$name: Setting baudrate to $baudrate";
$po->baudrate($baudrate);
$po->databits(8);
$po->parity('none');
$po->stopbits(1);
$po->handshake('none');
}
if($reopen) {
Log 1, "JeeLink $dev reappeared ($name)";
} else {
Log 3, "JeeLink device opened";
}
# Set Defaults
# CollectMode on
my $ret = &JEE_IOWrite($hash, "1c");
# QuietMode on
$ret = &JEE_IOWrite($hash, "1q");
# LED On
$ret = &JEE_IOWrite($hash, "1l");
# Set Frequenz to 868MHz
$ret = &JEE_IOWrite($hash, "8b");
$hash->{STATE}="connected"; # Allow InitDev to set the state
DoTrigger($name, "CONNECTED") if($reopen);
return "Initialized";
}
################################################################################
sub JEE_Ready($)
{
my ($hash) = @_;
return JEE_OpenDev($hash, 1)
if($hash->{STATE} eq "disconnected");
# This is relevant for windows/USB only
my $po = $hash->{USBDev};
my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags) = $po->status;
# Get Config
my $ret = &JEE_Write($hash, "i", undef);
return ($InBytes>0);
}
################################################################################
sub JEE_Read($)
{
my ($hash) = @_;
my $name = $hash->{NAME};
# LogLevel
# Default 4
my $ll = 4;
if(defined($attr{$name}{loglevel})) {
$ll = $attr{$name}{loglevel};
}
my $buf = $hash->{USBDev}->input();
#
# Lets' try again: Some drivers return len(0) on the first read...
if(defined($buf) && length($buf) == 0) {
$buf = $hash->{USBDev}->input();
}
my $jeedata = $hash->{PARTIAL};
$jeedata .= $buf;
##############################################################################
# Arduino/JeeLink
# Prints data to the serial port as human-readable ASCII text followed by
# a carriage return character (ASCII 13, or '\r') and
# a newline character (ASCII 10, or '\n').
# HEX 0D AD \xf0
if($jeedata =~ m/\n$/){
chomp($jeedata);
chop($jeedata);
my $status = substr($jeedata, 0, 2);
Log $ll,("$name/JeeLink RAW:$status -> $jeedata");
if($status =~/^OK/){
Log $ll,("$name/JeeLink Dispatch RAW:$jeedata");
&JEE_DispatchData($jeedata,$name,$ll);
}
elsif($jeedata =~ m/(^.*i)([0-9]{1,2})(\*.g)([0-9]{1,3})(.@.)([0-9]{1,3})(.MHz.*)/) {
JEE_RF12MSG($jeedata,$name,$ll);
}
elsif($jeedata =~/^DF/){JEE_RF12MSG($jeedata,$name,$ll);}
$jeedata = "";
}
if($jeedata =~ m/^\x0A/) {
Log $ll,("$name/JeeLink RAW DEL HEX-0A:$jeedata -> $jeedata");
$jeedata =~ s/\x0A//;
}
$hash->{PARTIAL} = $jeedata;
}
################################################################################
sub JEE_DispatchData($){
my ($rawdata,$name,$ll) = @_;
my @data = split(/\s+/,$rawdata);
my $status = shift(@data);
my $NodeID = shift(@data);
# see http://talk.jeelabs.net/topic/642#post-3622
# The id +32 is what you see when the node requests an ACK.
if($NodeID > 31) {$NodeID = $NodeID - 32;}
Log $ll, "$name JEE-DISP: Status:$status NodeID:$NodeID Data:$rawdata";
# normalize 0 => 00 without NodeID
for(my $i=0;$i<=$#data;$i++){
if(length($data[$i]) == 1) { $data[$i] = "0" . $data[$i]}
}
# SensorData to Dispatch
my ($DispData,$SType,$SPre,@SData,$data_bytes,$slice_end);
for(my $i=0;$i<=$#data;$i++){
# Get Number of DataBytes
$SType = $data[$i];
if(defined($data{JEECONF}{$SType}{DataBytes})){
$data_bytes = $data{JEECONF}{$SType}{DataBytes};
###
$SPre = $data{JEECONF}{$SType}{Prefix};
$i++;
$slice_end = $i + $data_bytes - 1;
@SData = @data[$i..$slice_end];
$DispData = $SPre . " " . $NodeID . " " . $SType . " " . join(" ",@SData);
}
else {
Log $ll, "$name JEE-DISP: -ERROR- SensorType $SType not defined";
return undef;
}
# Dispacth-Data to FHEM-Dispatcher -----------------------------------------
#foreach my $m (sort keys %{$modules{JeeLink}{MatchList}}) {
# my $match = $modules{JeeLink}{MatchList}{$m};
$defs{$name}{"${name}_MSGCNT"}++;
$defs{$name}{"${name}_TIME"} = TimeNow();
$defs{$name}{RAWMSG} = $DispData;
my %addvals = (RAWMSG => $DispData);
my $hash = $defs{$name};
Log $ll,"$name JEE-DISP: SType=$SType -> DispData=$DispData";
my $ret_disp = &Dispatch($hash, $DispData, \%addvals);
#}
# Dispacth-Data to FHEM-Dispatcher -----------------------------------------
# Minimum 2Bytes left
# if((int(@data) - $i) < 2 ) {
# Log $ll,"$name JEE-DISP: 2Byte $i -> " . int(@data);
# $i = int(@data);
# }
#else {$i = $slice_end;}
$i = $slice_end;
}
}
################################################################################
sub JEE_RF12MSG($$$){
my ($rawdata,$name,$ll) = @_;
# ^ i23* g212 @ 868 MHz
# i -> NodeID
# g -> NetGroup
# @ -> 868MHz or 492MHz
Log $ll,("$name/JeeLink RF12MSG: $rawdata");
my($NodeID,$NetGroup,$Freq);
if ( $rawdata =~ m/(^.*i)([0-9]{1,2})(\*.g)([0-9]{1,3})(.@.)([0-9]{1,3})(.MHz.*)/) {
($NodeID,$NetGroup,$Freq) = ($2,$4,$6);
Log $ll,("$name/JeeLink RF12MSG-CONFIG: NodeId:$NodeID NetGroup:$NetGroup Freq:$Freq");
$defs{$name}{RF12_NodeID} = $NodeID;
$defs{$name}{RF12_NetGroup} = $NetGroup;
$defs{$name}{RF12_Frequenz} = $Freq;
}
if($rawdata =~ m/\s+DF/){
Log $ll,("$name/JeeLink RF12MSG-FLASH: $rawdata");
}
return undef;
}
################################################################################
sub JEE_IOWrite() {
my ($hash, $msg,) = @_;
return if(!$hash);
# LogLevel
my $name = $hash->{NAME};
my $ll = 4;
if(defined($attr{$name}{loglevel})) {
$ll = $attr{$name}{loglevel};
}
if(defined($attr{$name}{dummy})){
Log $ll ,"JEE-IOWRITE[DUMMY-MODE]: " . $hash->{NAME} . " $msg";
}
else {
Log $ll ,"JEE-IOWRITE: " . $name . " $msg";
$hash->{USBDev}->write($msg . "\n");
select(undef, undef, undef, 0.001);
}
}
################################################################################
sub JEE_Write() {
my ($hash, $msg1, $msg2) = @_;
# $hash -> Received form Device
# $msg1 -> Message Type ???
# $msg2 -> Data
return if(!$hash);
# LogLevel
my $name = $hash->{NAME};
my $ll = 4;
if(defined($attr{$name}{loglevel})) {
$ll = $attr{$name}{loglevel};
}
Log $ll ,"JEE-WRITE: " . $hash->{NAME} . " MSG-1-: $msg1 MSG-2-: $msg2";
# Default --------------------------------------------------------------------
my $msg = $msg2;
# FS20 -----------------------------------------------------------------------
# JEE-WRITE: JL01 MSG: 04 BTN: 010101 1234 33 00
# FS20.pm
# IOWrite($hash, "04", "010101" . $hash->{XMIT} . $hash->{BTN} . $c);
# MSG-1-: 04 MSG-2-: 01010177770311
# <hchi>,<hclo>,<addr>,<cmd> f - FS20 command (868 MHz)
# substr($jeedata, 0, 2);
my ($hchi,$hclo,$addr,$cmd);
if($msg2 =~ m/^010101/) {
$msg2 =~s/010101//;
Log 0, "JEE-IOWRITE-FS20: $msg2";
$hchi = hex(substr($msg2,0,2));
$hclo = substr($msg2,2,2);
$addr = hex(substr($msg2,4,2));
$cmd = hex(substr($msg2,6,2));
$msg = "$hchi,$hclo,$addr,$cmd f";
Log $ll, "JEE-IOWRITE-FS20: hchi:$hchi hclo:$hclo addr:$addr cmd:$cmd";
$hash->{FS20_LastSend} = TimeNow() . ":" . $msg ;
}
# FS20 -----------------------------------------------------------------------
if(defined($attr{$name}{dummy})){
Log $ll, "JEE_Write[DUMMY-MODE]: >$msg<";
}
else {
# Send Message >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
$hash->{USBDev}->write($msg . "\n");
Log $ll, "JEE_Write >$msg<";
select(undef, undef, undef, 0.001);
# Send Message >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
}
}
################################################################################
1;

261
contrib/contrib/JeeStuff/18_JME.pm Normal file
View File

@ -0,0 +1,261 @@
################################################################################
# FHEM-Modul see www.fhem.de
# 18_JME.pm
# JeeMeterNode
#
# Usage: define <Name> JME <Node-Nr>
################################################################################
# This program 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 3 of the License, or
# (at your option) any later version.
#
# This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
################################################################################
# Autor: Axel Rieger
# Version: 1.0
# Datum: 07.2011
# Kontakt: fhem [bei] anax [punkt] info
################################################################################
# READINGs
# MeterBase = MeterBase abgelesener Zaehlerstand...default 0
# MeterNow = aktueller Zaehlerstand...wird hochgezŠhlt
# Wenn MeterBase gesetzt ist, wird von dan an hochgezaehlt
# Wenn MeterBase gesetzt wird, werden
# AVG_Hour, AVG_Day, AVG_Month
################################################################################
package main;
use strict;
use warnings;
use POSIX;
use Data::Dumper;
use vars qw(%defs);
use vars qw(%attr);
use vars qw(%data);
use vars qw(%modules);
################################################################################
sub JME_Initialize($)
{
my ($hash) = @_;
# Match/Prefix
my $match = "JME";
$hash->{Match} = "^JME";
$hash->{DefFn} = "JME_Define";
$hash->{UndefFn} = "JME_Undef";
$hash->{SetFn} = "JME_Set";
$hash->{ParseFn} = "JME_Parse";
$hash->{AttrList} = "do_not_notify:0,1 loglevel:0,5 disable:0,1 TicksPerUnit avg_data_day avg_data_month";
#-----------------------------------------------------------------------------
# Arduino/JeeNodes-Variables:
# http://arduino.cc/en/Reference/HomePage
# Integer = 2 Bytes -> form -32,768 to 32,767
# Long (unsigned) = 4 Bytes -> from 0 to 4,294,967,295
# Long (signed) = 4 Bytes -> from -2,147,483,648 to 2,147,483,647
#
# JeeConf
# $data{JEECONF}{<SensorType>}{ReadingName}
# $data{JEECONF}{<SensorType>}{DataBytes}
# $data{JEECONF}{<SensorType>}{Prefix}
# $data{JEECONF}{<SensorType>}{CorrFactor}
# $data{JEECONF}{<SensorType>}{Function}
# <SensorType>: 0-9 -> Reserved/not Used
# <SensorType>: 10-99 -> Default
# <SensorType>: 100-199 -> Userdifined
# <SensorType>: 200-255 -> Internal/Test
# Counter --------------------------------------------------------------------
$data{JEECONF}{14}{ReadingName} = "counter";
$data{JEECONF}{14}{DataBytes} = 2;
$data{JEECONF}{14}{Prefix} = $match;
}
################################################################################
sub JME_Define($){
# define J001 JME <Node-Nr>
# hash = New Device
# defs = $a[0] <DEVICE-NAME> $a[1] DEVICE-TYPE $a[2]<Parameter-1-> $a[3]<Parameter-2->
my ($hash, $def) = @_;
my @a = split(/\s+/, $def);
return "JME: Unknown argument count " . int(@a) . " , usage define <NAME>
NodeID [<Path_to_User_Conf_File>]" if(int(@a) != 3);
my $NodeID = $a[2];
if(defined($modules{JME}{defptr}{$NodeID})) {
return "Node $NodeID allready define";
}
$hash->{CODE} = $NodeID;
$hash->{STATE} = "NEW: " . TimeNow();
$hash->{OrderID} = ord($NodeID);
$modules{JME}{defptr}{ord($NodeID)} = $hash;
# Init
#$hash->{READINGS}{MeterBase}{TIME} = TimeNow();
#$hash->{READINGS}{MeterBase}{VAL} = 0;
#$hash->{READINGS}{MeterNow}{TIME} = TimeNow();
#$hash->{READINGS}{MeterNow}{VAL} = 0;
#$hash->{READINGS}{consumption}{TIME} = TimeNow();
#$hash->{READINGS}{consumption}{VAL} = 0;
#$hash->{READINGS}{current}{TIME} = TimeNow();
#$hash->{READINGS}{current}{VAL} = 0;
#$hash->{cnt_old} = 0;
return undef;
}
################################################################################
sub JME_Undef($$){
my ($hash, $name) = @_;
Log 4, "JME Undef: " . Dumper(@_);
my $NodeID = $hash->{NodeID};
if(defined($modules{JME}{defptr}{$NodeID})) {
delete $modules{JME}{defptr}{$NodeID}
}
return undef;
}
################################################################################
sub JME_Set($)
{
my ($hash, @a) = @_;
my $fields = "MeterBase MeterNow counter avg_day avg_month";
return "Unknown argument $a[1], choose one of $fields" if($a[1] eq "?");
if($fields =~ m/$a[1]/){
$hash->{READINGS}{$a[1]}{VAL} = sprintf("%0.3f",$a[2]);
$hash->{READINGS}{$a[1]}{TIME} = TimeNow();
}
return "";
}
################################################################################
sub JME_Parse($$) {
my ($iodev, $rawmsg) = @_;
# $rawmsg = JeeNodeID + SensorType + SensorData
# rawmsg = JME 03 252 03 65
Log 4, "JME PARSE RAW-MSG: " . $rawmsg . " IODEV:" . $iodev->{NAME};
#
my @data = split(/\s+/,$rawmsg);
my $NodeID = $data[1];
# my $NodeID = sprintf("%02x" ,($data[1]));
# $NodeID = hex($NodeID);
# my $NodeID = chr(ord($data[1]));
my $SType = $data[2];
my $data_bytes = $data{JEECONF}{$SType}{DataBytes};
my $data_end = int(@data) - 1;
# $array[$#array];
Log 4, "JME PARSE N:$NodeID S:$SType B:$data_bytes CNT:" . @data . " END:" . $data_end;
my @SData = @data[3..$data_end];
my ($hash,$name);
if(defined($modules{JME}{defptr}{ord($NodeID)})) {
$hash = $modules{JME}{defptr}{ord($NodeID)};
$name = $hash->{NAME};
}
else {
return "UNDEFINED JME_$NodeID JME $NodeID";};
my %readings;
# LogLevel
my $ll = 5;
if(defined($attr{$name}{loglevel})) {
$ll = $attr{$name}{loglevel};
}
# Sensor-Data Bytes to Values
# lowBit HighBit reverse ....
@SData = reverse(@SData);
my $raw_value = join("",@SData);
my $value = "";
map {$value .= sprintf "%02x",$_} @SData;
$value = hex($value);
Log $ll, "$name/JME-PARSE: $NodeID - $SType - " . join(" " , @SData) . " -> " . $value;
my $TicksPerUnit = 0.1;
if(defined($attr{$name}{TicksPerUnit})){
$TicksPerUnit = $attr{$name}{TicksPerUnit};
}
my $counter = 0;
if(defined($defs{$name}{READINGS}{counter})){
$counter = $defs{$name}{READINGS}{counter}{VAL};
}
# Counter Reset at 100 to 0
if($counter > 100) {
$readings{counter} = 0;
}
else {$readings{counter} = $value;}
my ($current,$cnt_delta);
$cnt_delta = $value - $counter;
$current = sprintf("%0.3f", ($cnt_delta * $TicksPerUnit));
$readings{current} = $current;
# Update only on Changes
my ($MeterNow,$consumption,$MeterBase);
$MeterNow = $defs{$name}{READINGS}{MeterNow}{VAL};
if($current > 0 ){
$MeterBase = $defs{$name}{READINGS}{MeterBase}{VAL};
$readings{MeterNow} = sprintf("%0.3f", ($MeterNow + $current));
$consumption = ($MeterNow + $current) - $MeterBase;
$readings{consumption} = sprintf("%0.3f", $consumption);
}
#-----------------------------------------------------------------------------
# Caculate AVG Day and Month
#-----------------------------------------------------------------------------
my $tsecs= time();
my $d_now = (localtime($tsecs))[3];
my $m_now = (localtime($tsecs))[4] + 1;
# avg_data_day = Day | Day_MeterNow
# avg_data_month = Month | Month_MeterNow
my ($d, $d_mn,$m,$m_mn);
if(defined($attr{$name}{avg_data_day})){
($d, $d_mn) = split(/\|/,$attr{$name}{avg_data_day});
($m,$m_mn) = split(/\|/,$attr{$name}{avg_data_month});
}
else {
# INIT
$defs{$name}{READINGS}{avg_day}{VAL} = 0.000;
$defs{$name}{READINGS}{avg_day}{TIME} = TimeNow();
$defs{$name}{READINGS}{avg_month}{VAL} = 0.000;
$defs{$name}{READINGS}{avg_month}{TIME} = TimeNow();
$attr{$name}{avg_data_day} = "$d_now|$MeterNow";
$attr{$name}{avg_data_month} = "$m_now|$MeterNow";
($d, $d_mn) = split(/\|/,$attr{$name}{avg_data_day});
($m,$m_mn) = split(/\|/,$attr{$name}{avg_data_month});
}
Log $ll, "$name/JME-PARSE: D:NOW:$d_now/OLD:$d M:NOW:$m_now/OLD:$m";
# AVG DAY
if($d_now ne $d) {
$consumption = ($MeterNow - $d_mn) + $defs{$name}{READINGS}{avg_day}{VAL} ;
$consumption = $consumption / 2;
$readings{avg_day} = sprintf("%0.3f", $consumption);
$attr{$name}{avg_data_day} = "$d_now|$MeterNow";
}
# AVG Month
if($m_now ne $m) {
$consumption = ($MeterNow - $d_mn) + $defs{$name}{READINGS}{avg_month}{VAL} ;
$consumption = $consumption / 2;
$readings{avg_month} = sprintf("%0.3f", $consumption);
$attr{$name}{avg_data_month} = "$m_now|$MeterNow";
}
#-----------------------------------------------------------------------------
# Readings
my $i = 0;
foreach my $r (sort keys %readings) {
Log 4, "JME $name $r:" . $readings{$r};
$defs{$name}{READINGS}{$r}{VAL} = $readings{$r};
$defs{$name}{READINGS}{$r}{TIME} = TimeNow();
# Changed for Notify and Logs
$defs{$name}{CHANGED}[$i] = $r . ": " . $readings{$r};
$i++;
}
$defs{$name}{STATE} = "M:" . $defs{$name}{READINGS}{MeterNow}{VAL} . " C:$value";
return $name;
}
################################################################################
1;

238
contrib/contrib/JeeStuff/18_JSN.pm Normal file
View File

@ -0,0 +1,238 @@
################################################################################
# FHEM-Modul see www.fhem.de
# 18_JSN.pm
# JeeSensorNode
#
# Usage: define <Name> JSN <Node-Nr>
################################################################################
# This program 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 3 of the License, or
# (at your option) any later version.
#
# This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
################################################################################
# Autor: Axel Rieger
# Version: 1.0
# Datum: 07.2011
# Kontakt: fhem [bei] anax [punkt] info
################################################################################
package main;
use strict;
use warnings;
use POSIX;
use Data::Dumper;
use vars qw(%defs);
use vars qw(%attr);
use vars qw(%data);
use vars qw(%modules);
################################################################################
sub JSN_Initialize($)
{
my ($hash) = @_;
# Match/Prefix
my $match = "JSN";
$hash->{Match} = "^JSN";
$hash->{DefFn} = "JSN_Define";
$hash->{UndefFn} = "JSN_Undef";
$hash->{ParseFn} = "JSN_Parse";
$hash->{AttrList} = "do_not_notify:0,1 loglevel:0,5 disable:0,1";
#-----------------------------------------------------------------------------
# Arduino/JeeNodes-Variables:
# http://arduino.cc/en/Reference/HomePage
# Integer = 2 Bytes -> form -32,768 to 32,767
# Long (unsigned) = 4 Bytes -> from 0 to 4,294,967,295
# Long (signed) = 4 Bytes -> from -2,147,483,648 to 2,147,483,647
#
# JeeConf
# $data{JEECONF}{<SensorType>}{ReadingName}
# $data{JEECONF}{<SensorType>}{DataBytes}
# $data{JEECONF}{<SensorType>}{Prefix}
# $data{JEECONF}{<SensorType>}{CorrFactor}
# $data{JEECONF}{<SensorType>}{Function}
# <SensorType>: 0-9 -> Reserved/not Used
# <SensorType>: 10-99 -> Default
# <SensorType>: 100-199 -> Userdifined
# <SensorType>: 200-255 -> Internal/Test
# Default-2-Bytes-------------------------------------------------------------
$data{JEECONF}{12}{ReadingName} = "SensorData";
$data{JEECONF}{12}{DataBytes} = 2;
$data{JEECONF}{12}{Prefix} = $match;
# Temperature ----------------------------------------------------------------
$data{JEECONF}{11}{ReadingName} = "temperature";
$data{JEECONF}{11}{DataBytes} = 2;
$data{JEECONF}{11}{Prefix} = $match;
$data{JEECONF}{11}{CorrFactor} = 0.1;
# Brightness- ----------------------------------------------------------------
$data{JEECONF}{12}{ReadingName} = "brightness";
$data{JEECONF}{12}{DataBytes} = 4;
$data{JEECONF}{12}{Prefix} = $match;
# Triple-Axis-X-Y-Z----------------------------------------------------------
$data{JEECONF}{13}{ReadingName} = "rtiple_axis";
$data{JEECONF}{13}{Function} = "JSN_parse_12";
$data{JEECONF}{13}{DataBytes} = 12;
$data{JEECONF}{13}{Prefix} = $match;
#-----------------------------------------------------------------------------
# 14 Used by 18_JME
# Counter --------------------------------------------------------------------
# $data{JEECONF}{14}{ReadingName} = "counter";
# $data{JEECONF}{14}{DataBytes} = 4;
# $data{JEECONF}{14}{Prefix} = $match;
# Pressure -------------------------------------------------------------------
$data{JEECONF}{15}{ReadingName} = "pressure";
$data{JEECONF}{15}{DataBytes} = 4;
$data{JEECONF}{15}{CorrFactor} = 0.01;
$data{JEECONF}{15}{Prefix} = $match;
# Humidity -------------------------------------------------------------------
$data{JEECONF}{16}{ReadingName} = "humidity";
$data{JEECONF}{16}{DataBytes} = 1;
$data{JEECONF}{16}{Prefix} = $match;
# Light LDR ------------------------------------------------------------------
$data{JEECONF}{17}{ReadingName} = "light_ldr";
$data{JEECONF}{17}{DataBytes} = 1;
$data{JEECONF}{17}{Prefix} = $match;
# Motion ---------------------------------------------------------------------
$data{JEECONF}{18}{ReadingName} = "motion";
$data{JEECONF}{18}{DataBytes} = 1;
$data{JEECONF}{18}{Prefix} = $match;
# JeeNode InternalTemperatur -------------------------------------------------
$data{JEECONF}{251}{ReadingName} = "AtmelTemp";
$data{JEECONF}{251}{DataBytes} = 2;
$data{JEECONF}{251}{Prefix} = $match;
# JeeNode InternalRefVolatge -------------------------------------------------
$data{JEECONF}{252}{ReadingName} = "PowerSupply";
$data{JEECONF}{252}{DataBytes} = 2;
$data{JEECONF}{252}{CorrFactor} = 0.0001;
$data{JEECONF}{252}{Prefix} = $match;
# JeeNode RF12 LowBat --------------------------------------------------------
$data{JEECONF}{253}{ReadingName} = "RF12LowBat";
$data{JEECONF}{253}{DataBytes} = 1;
$data{JEECONF}{253}{Prefix} = $match;
# JeeNode Milliseconds -------------------------------------------------------
$data{JEECONF}{254}{ReadingName} = "Millis";
$data{JEECONF}{254}{DataBytes} = 4;
$data{JEECONF}{254}{Prefix} = $match;
}
################################################################################
sub JSN_Define($){
# define J001 JSN <Node-Nr> [<Path_to_User_Conf_File>]
# hash = New Device
# defs = $a[0] <DEVICE-NAME> $a[1] DEVICE-TYPE $a[2]<Parameter-1-> $a[3]<Parameter-2->
my ($hash, $def) = @_;
my @a = split(/\s+/, $def);
return "JSN: Unknown argument count " . int(@a) . " , usage define <NAME>
NodeID [<Path_to_User_Conf_File>]" if(int(@a) != 3);
my $NodeID = $a[2];
if(defined($modules{JSN}{defptr}{$NodeID})) {
return "Node $NodeID allready define";
}
$hash->{CODE} = $NodeID;
$hash->{STATE} = "NEW: " . TimeNow();
$hash->{OrderID} = $NodeID;
$modules{JSN}{defptr}{$NodeID} = $hash;
return undef;
}
################################################################################
sub JSN_Undef($$){
my ($hash, $name) = @_;
Log 4, "JeeNode Undef: " . Dumper(@_);
my $NodeID = $hash->{NodeID};
if(defined($modules{JSN}{defptr}{$NodeID})) {
delete $modules{JSN}{defptr}{$NodeID}
}
return undef;
}
################################################################################
sub JSN_Parse($$) {
my ($iodev, $rawmsg) = @_;
# $rawmsg = JeeNodeID + SensorType + SensorData
# rawmsg = JSN 03 252 03 65
Log 5, "JSN PARSE RAW-MSG: " . $rawmsg . " IODEV:" . $iodev->{NAME};
#
my @data = split(/\s+/,$rawmsg);
my $NodeID = $data[1];
# my $NodeID = sprintf("%02x" ,($data[1]));
# $NodeID = hex($NodeID);
# my $NodeID = chr(ord($data[1]));
my $SType = $data[2];
my $data_bytes = $data{JEECONF}{$SType}{DataBytes};
my $data_end = int(@data) - 1;
# $array[$#array];
Log 5, "JSN PARSE N:$NodeID S:$SType B:$data_bytes CNT:" . @data . " END:" . $data_end;
my @SData = @data[3..$data_end];
my ($hash,$name);
if(defined($modules{JSN}{defptr}{$NodeID})) {
$hash = $modules{JSN}{defptr}{$NodeID};
$name = $hash->{NAME};
}
else {
return "UNDEFINED JSN_$NodeID JSN $NodeID";};
my %readings;
# Function-Data --------------------------------------------------------------
# If defined $data{JEECONF}{<SensorType>}{Function} then the function handels
# data parsing...return a hash key:reading_name Value:reading_value
# Param to Function: $iodev,$name,$NodeID, $SType,@SData
# Function-Data --------------------------------------------------------------
if(defined($data{JEECONF}{$SType}{Function})) {
my $func = $data{JEECONF}{$SType}{Function};
if(!defined(&$func)) {
Log 0, "JSN PARSE Function not defined: $SType -> $func";
return undef;
}
no strict "refs";
%readings = &$func($iodev,$name,$NodeID, $SType,@SData);
use strict "refs";
}
else {
# Sensor-Data Bytes to Values
# lowBit HighBit reverse ....
@SData = reverse(@SData);
my $raw_value = join("",@SData);
my $value = "";
map {$value .= sprintf "%02x",$_} @SData;
$value = hex($value);
Log 5, "JSN PARSE DATA $NodeID - $SType - " . join(" " , @SData) . " -> " . $value;
my $reading_name = $data{JEECONF}{$SType}{ReadingName};
$readings{$reading_name} = $value;
if(defined($data{JEECONF}{$SType}{CorrFactor})) {
my $corr = $data{JEECONF}{$SType}{CorrFactor};
$readings{$reading_name} = $value * $corr;
}
}
#Reading
my $i = 0;
foreach my $r (sort keys %readings) {
Log 5, "JSN $name $r:" . $readings{$r};
$defs{$name}{READINGS}{$r}{VAL} = $readings{$r};
$defs{$name}{READINGS}{$r}{TIME} = TimeNow();
$defs{$name}{STATE} = TimeNow() . " " . $r;
# Changed for Notify and Logs
$defs{$name}{CHANGED}[$i] = $r . ": " . $readings{$r};
$i++;
}
return $name;
}
################################################################################
sub JSN_parse_12() {
my ($iodev,$name,$NodeID, $SType,@SData) = @_;
Log 5, "JSN PARSE-12 DATA $NodeID - $SType - " . join(" " , @SData);
my %reading;
$reading{X} = "XXX";
$reading{Y} = "YYY";
$reading{Z} = "ZZZ";
return \%reading;
}
################################################################################
1;

179
contrib/contrib/JeeStuff/FHEM_JSN_BMP85.pde Normal file
View File

@ -0,0 +1,179 @@
// -----------------------------------------------------------------------------
// JeeNode for Use with BMP085 and LuxPlug
// reads out a BMP085 sensor connected via I2C
// see http://news.jeelabs.org/2010/06/20/battery-savings-for-the-pressure-plug/
// see http://news.jeelabs.org/2010/06/30/going-for-gold-with-the-bmp085/
//
// Baesd on RoomNode form JeeLabs roomNode.pde
//
// 2010-10-19 <jcw@equi4.com> http://opensource.org/licenses/mit-license.php
// $Id: FHEM_JSN_BMP85.pde,v 1.1 2011-07-19 09:31:20 rudolfkoenig Exp $
//
// see http://jeelabs.org/2010/10/20/new-roomnode-code/
// and http://jeelabs.org/2010/10/21/reporting-motion/
// -----------------------------------------------------------------------------
// Includes
#include <Ports.h>
#include <PortsSHT11.h>
#include <RF12.h>
#include <avr/sleep.h>
#include <util/atomic.h>
#include "PortsBMP085.h"
// -----------------------------------------------------------------------------
// JeeNode RF12-Config
static byte myNodeID = 5; // node ID used for this unit
static byte myNetGroup = 212; // netGroup used for this unit
// Port BMP085
#define BMP_PORT 1
// Payload aka Data to Send
struct {
// RF12LowBat
byte rf12lowbat_type;
byte rf12lowbat_data;
// Temperature
byte temp_type;
int16_t temp_data;
// Pressure
byte pres_type;
int32_t pres_data;
} payload;
// -----------------------------------------------------------------------------
// BMP085
PortI2C one (BMP_PORT);
BMP085 psensor (one, 3); // ultra high resolution
MilliTimer timer;
// -----------------------------------------------------------------------------
// Config & Vars
#define SERIAL 1 // set to 1 to also report readings on the serial port
#define DEBUG 0 // set to 1 to display each loop()
#define MEASURE_PERIOD 3000 // how often to measure, in tenths of seconds
#define RETRY_PERIOD 10 // how soon to retry if ACK didn't come in
#define RETRY_LIMIT 5 // maximum number of times to retry
#define ACK_TIME 10 // number of milliseconds to wait for an ack
#define REPORT_EVERY 1 // report every N measurement cycles
#define SMOOTH 3 // smoothing factor used for running averages
// set the sync mode to 2 if the fuses are still the Arduino default
// mode 3 (full powerdown) can only be used with 258 CK startup fuses
#define RADIO_SYNC_MODE 2
// -----------------------------------------------------------------------------
// The scheduler makes it easy to perform various tasks at various times:
enum { MEASURE, REPORT, TASK_END };
static word schedbuf[TASK_END];
Scheduler scheduler (schedbuf, TASK_END);
static byte reportCount; // count up until next report, i.e. packet send
// has to be defined because we're using the watchdog for low-power waiting
ISR(WDT_vect) { Sleepy::watchdogEvent(); }
// utility code to perform simple smoothing as a running average
static int smoothedAverage(int prev, int next, byte firstTime =0) {
if (firstTime)
return next;
return ((SMOOTH - 1) * prev + next + SMOOTH / 2) / SMOOTH;
}
// wait a few milliseconds for proper ACK to me, return true if indeed received
static byte waitForAck() {
MilliTimer ackTimer;
while (!ackTimer.poll(ACK_TIME)) {
if (rf12_recvDone() && rf12_crc == 0 &&
rf12_hdr == (RF12_HDR_DST | RF12_HDR_ACK | myNodeID))
return 1;
set_sleep_mode(SLEEP_MODE_IDLE);
sleep_mode();
}
return 0;
}
// readout all the sensors and other values
static void doMeasure() {
// RF12lowBat
payload.rf12lowbat_type = 253;
payload.rf12lowbat_data = rf12_lowbat();
// sensor readout takes some time, so go into power down while waiting
// payload.temp_data = psensor.measure(BMP085::TEMP);
// payload.pres_data = psensor.measure(BMP085::PRES);
psensor.startMeas(BMP085::TEMP);
Sleepy::loseSomeTime(16); // must wait at least 16 ms
int32_t traw = psensor.getResult(BMP085::TEMP);
psensor.startMeas(BMP085::PRES);
Sleepy::loseSomeTime(32);
int32_t praw = psensor.getResult(BMP085::PRES);
payload.temp_type = 11;
payload.pres_type = 15;
psensor.calculate(payload.temp_data, payload.pres_data);
}
// periodic report, i.e. send out a packet and optionally report on serial port
static void doReport() {
rf12_sleep(-1);
while (!rf12_canSend())
rf12_recvDone();
rf12_sendStart(0, &payload, sizeof payload, RADIO_SYNC_MODE);
rf12_sleep(0);
#if SERIAL
Serial.print("ROOM PAYLOAD: ");
Serial.print("RF12LowBat: ");
Serial.print((int) payload.rf12lowbat_data);
Serial.print(" T: ");
Serial.print(payload.temp_data);
Serial.print(" P: ");
Serial.print(payload.pres_data);
Serial.println();
delay(2); // make sure tx buf is empty before going back to sleep
#endif
}
// -----------------------------------------------------------------------------
void setup () {
rf12_initialize(myNodeID, RF12_868MHZ, myNetGroup);
#if SERIAL || DEBUG
Serial.begin(57600);
Serial.print("\n[FHEM-JeeNode.3]");
// myNodeID = rf12_config();
#else
#endif
rf12_sleep(0); // power down
// Start BMP085
psensor.getCalibData();
reportCount = REPORT_EVERY; // report right away for easy debugging
scheduler.timer(MEASURE, 0); // start the measurement loop going
}
// -----------------------------------------------------------------------------
void loop () {
#if DEBUG
Serial.print('.');
delay(2);
#endif
switch (scheduler.pollWaiting()) {
case MEASURE:
// reschedule these measurements periodically
scheduler.timer(MEASURE, MEASURE_PERIOD);
doMeasure();
// every so often, a report needs to be sent out
if (++reportCount >= REPORT_EVERY) {
reportCount = 0;
scheduler.timer(REPORT, 0);
}
break;
case REPORT:
doReport();
break;
}
}

167
contrib/contrib/JeeStuff/FHEM_JSN_LUX.pde Normal file
View File

@ -0,0 +1,167 @@
// -----------------------------------------------------------------------------
// JeeNode for Use with BMP085 and LuxPlug
// reads out a BMP085 sensor connected via I2C
// see http://news.jeelabs.org/2010/06/20/battery-savings-for-the-pressure-plug/
// see http://news.jeelabs.org/2010/06/30/going-for-gold-with-the-bmp085/
//
// Baesd on RoomNode form JeeLabs roomNode.pde
//
// 2010-10-19 <jcw@equi4.com> http://opensource.org/licenses/mit-license.php
// $Id: FHEM_JSN_LUX.pde,v 1.1 2011-07-19 09:31:20 rudolfkoenig Exp $
//
// see http://jeelabs.org/2010/10/20/new-roomnode-code/
// and http://jeelabs.org/2010/10/21/reporting-motion/
// -----------------------------------------------------------------------------
// Includes
#include <Ports.h>
#include <PortsSHT11.h>
#include <RF12.h>
#include <avr/sleep.h>
#include <util/atomic.h>
// -----------------------------------------------------------------------------
// JeeNode RF12-Config
static byte myNodeID = 6; // node ID used for this unit
static byte myNetGroup = 212; // netGroup used for this unit
unsigned long lux;
// Port Lux-Plug
#define LUX_PORT 4
// Payload aka Data to Send
struct {
// RF12LowBat
byte rf12lowbat_type;
byte rf12lowbat_data;
// Lux
byte lux_type;
unsigned long lux_data;
} payload;
// -----------------------------------------------------------------------------
// Lux Plug
PortI2C two (LUX_PORT);
LuxPlug lsensor (two, 0x39);
byte highGain;
MilliTimer timer;
// -----------------------------------------------------------------------------
// Config & Vars
#define SERIAL 1 // set to 1 to also report readings on the serial port
#define DEBUG 0 // set to 1 to display each loop()
#define MEASURE_PERIOD 3000 // how often to measure, in tenths of seconds
#define RETRY_PERIOD 10 // how soon to retry if ACK didn't come in
#define RETRY_LIMIT 5 // maximum number of times to retry
#define ACK_TIME 10 // number of milliseconds to wait for an ack
#define REPORT_EVERY 1 // report every N measurement cycles
#define SMOOTH 3 // smoothing factor used for running averages
// set the sync mode to 2 if the fuses are still the Arduino default
// mode 3 (full powerdown) can only be used with 258 CK startup fuses
#define RADIO_SYNC_MODE 2
// -----------------------------------------------------------------------------
// The scheduler makes it easy to perform various tasks at various times:
enum { MEASURE, REPORT, TASK_END };
static word schedbuf[TASK_END];
Scheduler scheduler (schedbuf, TASK_END);
static byte reportCount; // count up until next report, i.e. packet send
// has to be defined because we're using the watchdog for low-power waiting
ISR(WDT_vect) { Sleepy::watchdogEvent(); }
// wait a few milliseconds for proper ACK to me, return true if indeed received
static byte waitForAck() {
MilliTimer ackTimer;
while (!ackTimer.poll(ACK_TIME)) {
if (rf12_recvDone() && rf12_crc == 0 &&
rf12_hdr == (RF12_HDR_DST | RF12_HDR_ACK | myNodeID))
return 1;
set_sleep_mode(SLEEP_MODE_IDLE);
sleep_mode();
}
return 0;
}
// readout all the sensors and other values
static void doMeasure() {
// RF12lowBat
payload.rf12lowbat_type = 253;
payload.rf12lowbat_data = rf12_lowbat();
// lux_demo.pde
// need to wait after changing the gain
// see http://talk.jeelabs.net/topic/608
// highGain = ! highGain;
// lsensor.setGain(highGain);
// Sleepy::loseSomeTime(1000);
// Lux Plug
const word* p = lsensor.getData();
lux = lsensor.calcLux();
payload.lux_type = 12;
payload.lux_data = lux;
// payload.lux_data = lsensor.calcLux();
}
// periodic report, i.e. send out a packet and optionally report on serial port
static void doReport() {
rf12_sleep(-1);
while (!rf12_canSend())
rf12_recvDone();
rf12_sendStart(0, &payload, sizeof payload, RADIO_SYNC_MODE);
rf12_sleep(0);
#if SERIAL
Serial.print("ROOM PAYLOAD: ");
Serial.print("RF12LowBat: ");
Serial.print((int) payload.rf12lowbat_data);
Serial.print(" L: ");
Serial.print(payload.lux_data);
Serial.println();
delay(2); // make sure tx buf is empty before going back to sleep
#endif
}
// -----------------------------------------------------------------------------
void setup () {
rf12_initialize(myNodeID, RF12_868MHZ, myNetGroup);
#if SERIAL
Serial.begin(57600);
Serial.print("\n[FHEM-JeeNode.3]");
// myNodeID = rf12_config();
#endif
rf12_sleep(0); // power down
// Start Lux-Plug
lsensor.begin();
Sleepy::loseSomeTime(1000);
highGain = 1;
// highGain = ! highGain;
lsensor.setGain(highGain);
Sleepy::loseSomeTime(1000);
reportCount = REPORT_EVERY; // report right away for easy debugging
scheduler.timer(MEASURE, 0); // start the measurement loop going
}
// -----------------------------------------------------------------------------
void loop () {
#if DEBUG
Serial.print('.');
delay(2);
#endif
switch (scheduler.pollWaiting()) {
case MEASURE:
// reschedule these measurements periodically
scheduler.timer(MEASURE, MEASURE_PERIOD);
doMeasure();
// every so often, a report needs to be sent out
if (++reportCount >= REPORT_EVERY) {
reportCount = 0;
scheduler.timer(REPORT, 0);
}
break;
case REPORT:
doReport();
break;
}
}

334
contrib/contrib/JeeStuff/FHEM_JSN_RoomNode.pde Normal file
View File

@ -0,0 +1,334 @@
// New version of the Room Node, derived from rooms.pde
// 2010-10-19 <jcw@equi4.com> http://opensource.org/licenses/mit-license.php
// $Id: FHEM_JSN_RoomNode.pde,v 1.1 2011-07-19 09:31:20 rudolfkoenig Exp $
// see http://jeelabs.org/2010/10/20/new-roomnode-code/
// and http://jeelabs.org/2010/10/21/reporting-motion/
// The complexity in the code below comes from the fact that newly detected PIR
// motion needs to be reported as soon as possible, but only once, while all the
// other sensor values are being collected and averaged in a more regular cycle.
#include <Ports.h>
#include <PortsSHT11.h>
#include <RF12.h>
#include <avr/sleep.h>
#include <util/atomic.h>
#define SERIAL 0 // set to 1 to also report readings on the serial port
#define DEBUG 0 // set to 1 to display each loop() run and PIR trigger
#define SHT11_PORT 4 // defined if SHT11 is connected to a port
#define LDR_PORT 1 // defined if LDR is connected to a port's AIO pin
#define PIR_PORT 1 // defined if PIR is connected to a port's DIO pin
#define MEASURE_PERIOD 600 // how often to measure, in tenths of seconds
#define RETRY_PERIOD 1 // how soon to retry if ACK didn't come in
#define RETRY_LIMIT 1 // maximum number of times to retry
#define ACK_TIME 5 // number of milliseconds to wait for an ack
#define REPORT_EVERY 5 // report every N measurement cycles
#define SMOOTH 3 // smoothing factor used for running averages
// set the sync mode to 2 if the fuses are still the Arduino default
// mode 3 (full powerdown) can only be used with 258 CK startup fuses
#define RADIO_SYNC_MODE 2
// The scheduler makes it easy to perform various tasks at various times:
enum { MEASURE, REPORT, TASK_END };
static word schedbuf[TASK_END];
Scheduler scheduler (schedbuf, TASK_END);
// Other variables used in various places in the code:
static byte reportCount; // count up until next report, i.e. packet send
static byte myNodeID = 8; // node ID used for this unit
static byte myNetGroup = 212;
// This defines the structure of the packets which get sent out by wireless:
/*
struct {
byte light; // light sensor: 0..255
byte moved :1; // motion detector: 0..1
byte humi :7; // humidity: 0..100
int temp :10; // temperature: -500..+500 (tenths)
byte lobat :1; // supply voltage dropped under 3.1V: 0..1
} payload;
*/
struct {
byte light_type;
byte light_data;
byte moved_type;
byte moved_data;
byte humi_type;
byte humi_data;
byte temp_type;
int temp_data;
byte rf12lowbat_type;
byte rf12lowbat_data;
} payload;
// Conditional code, depending on which sensors are connected and how:
#if SHT11_PORT
SHT11 sht11 (SHT11_PORT);
#endif
#if LDR_PORT
Port ldr (LDR_PORT);
#endif
#if PIR_PORT
#define PIR_HOLD_TIME 30 // hold PIR value this many seconds after change
#define PIR_PULLUP 1 // set to one to pull-up the PIR input pin
class PIR : public Port {
volatile byte value, changed;
volatile uint32_t lastOn;
public:
PIR (byte portnum)
: Port (portnum), value (0), changed (0), lastOn (0) {}
// this code is called from the pin-change interrupt handler
void poll() {
byte pin = digiRead();
#if SERIAL
Serial.print("PIR.POLL: ");
Serial.print(pin,DEC);
Serial.print(" LastOn: ");
Serial.println(lastOn);
#endif
// if the pin just went on, then set the changed flag to report it
if (pin) {
if (!state())
changed = 1;
lastOn = millis();
}
value = pin;
}
// state is true if curr value is still on or if it was on recently
byte state() const {
#if SERIAL
Serial.print("ATOMIC_RESTORESTATE");
Serial.print(" LastOn: ");
Serial.println(lastOn);
#endif
byte f = value;
if (lastOn > 0)
ATOMIC_BLOCK(ATOMIC_RESTORESTATE) {
if (millis() - lastOn < 1000 * PIR_HOLD_TIME)
f = 1;
}
return f;
}
// return true if there is new motion to report
byte triggered() {
#if SERIAL
Serial.print("TRIGGERD");
Serial.print(" LastOn: ");
Serial.println(lastOn);
#endif
byte f = changed;
changed = 0;
return f;
}
};
PIR pir (PIR_PORT);
// the PIR signal comes in via a pin-change interrupt
ISR(PCINT2_vect) { pir.poll(); }
#endif
// has to be defined because we're using the watchdog for low-power waiting
ISR(WDT_vect) { Sleepy::watchdogEvent(); }
// utility code to perform simple smoothing as a running average
static int smoothedAverage(int prev, int next, byte firstTime =0) {
if (firstTime)
return next;
return ((SMOOTH - 1) * prev + next + SMOOTH / 2) / SMOOTH;
}
// spend a little time in power down mode while the SHT11 does a measurement
static void shtDelay () {
Sleepy::loseSomeTime(32); // must wait at least 20 ms
}
// wait a few milliseconds for proper ACK to me, return true if indeed received
static byte waitForAck() {
MilliTimer ackTimer;
while (!ackTimer.poll(ACK_TIME)) {
if (rf12_recvDone() && rf12_crc == 0 &&
rf12_hdr == (RF12_HDR_DST | RF12_HDR_ACK | myNodeID))
return 1;
set_sleep_mode(SLEEP_MODE_IDLE);
sleep_mode();
}
return 1;
}
// readout all the sensors and other values
static void doMeasure() {
#if SERIAL
Serial.println("doMeasure");
#endif
byte firstTime = payload.humi_data == 0; // special case to init running avg
// RF12lowBat
payload.rf12lowbat_type = 253;
payload.rf12lowbat_data = rf12_lowbat();
#if SHT11_PORT
#ifndef __AVR_ATtiny84__
sht11.measure(SHT11::HUMI, shtDelay);
sht11.measure(SHT11::TEMP, shtDelay);
float h, t;
sht11.calculate(h, t);
int humi = h + 0.5, temp = 10 * t + 0.5;
#else
//XXX TINY!
int humi = 50, temp = 25;
#endif
payload.humi_type = 16;
payload.humi_data = smoothedAverage(payload.humi_data, humi, firstTime);
payload.temp_type = 11;
payload.temp_data = smoothedAverage(payload.temp_data, temp, firstTime);
#endif
#if LDR_PORT
ldr.digiWrite2(1); // enable AIO pull-up
byte light = ~ ldr.anaRead() >> 2;
ldr.digiWrite2(0); // disable pull-up to reduce current draw
payload.light_type = 17;
payload.light_data = smoothedAverage(payload.light_data, light, firstTime);
#endif
#if PIR_PORT
payload.moved_type = 18;
payload.moved_data = pir.state();
#endif
}
// periodic report, i.e. send out a packet and optionally report on serial port
static void doReport() {
Serial.println("REPORT");
rf12_sleep(-1);
while (!rf12_canSend())
rf12_recvDone();
rf12_sendStart(0, &payload, sizeof payload, RADIO_SYNC_MODE);
rf12_sleep(0);
#if SERIAL
Serial.print("ROOM L:");
Serial.print((int) payload.light_data);
Serial.print(" M:");
Serial.print((int) payload.moved_data);
Serial.print(" H:");
Serial.print((int) payload.humi_data);
Serial.print(" T:");
Serial.print((int) payload.temp_data);
Serial.print(" LB:");
Serial.print((int) payload.rf12lowbat_data);
Serial.println();
delay(2); // make sure tx buf is empty before going back to sleep
#endif
}
// send packet and wait for ack when there is a motion trigger
static void doTrigger() {
#if DEBUG
Serial.print("doTrigger PIR ");
Serial.print((int) payload.moved_data);
delay(2);
#endif
for (byte i = 0; i < RETRY_LIMIT; ++i) {
rf12_sleep(-1);
while (!rf12_canSend())
rf12_recvDone();
rf12_sendStart(RF12_HDR_ACK, &payload, sizeof payload, RADIO_SYNC_MODE);
byte acked = waitForAck();
rf12_sleep(0);
if (acked) {
#if DEBUG
Serial.print(" ack ");
Serial.println((int) i);
delay(2);
#endif
// reset scheduling to start a fresh measurement cycle
scheduler.timer(MEASURE, MEASURE_PERIOD);
return;
}
Sleepy::loseSomeTime(RETRY_PERIOD * 100);
}
scheduler.timer(MEASURE, MEASURE_PERIOD);
#if DEBUG
Serial.println(" no ack!");
delay(2);
#endif
}
void setup () {
#if SERIAL || DEBUG
Serial.begin(57600);
Serial.print("\n[roomNode.3]");
// myNodeID = rf12_config();
rf12_initialize(myNodeID, RF12_868MHZ, myNetGroup);
#else
rf12_initialize(myNodeID, RF12_868MHZ, myNetGroup);
#endif
rf12_sleep(0); // power down
#if PIR_PORT
pir.digiWrite(PIR_PULLUP);
#ifdef PCMSK2
bitSet(PCMSK2, PIR_PORT + 3);
bitSet(PCICR, PCIE2);
#else
//XXX TINY!
#endif
#endif
reportCount = REPORT_EVERY; // report right away for easy debugging
scheduler.timer(MEASURE, 0); // start the measurement loop going
}
void loop () {
#if DEBUG
Serial.println('Loop..................................................');
delay(2);
#endif
#if PIR_PORT
if (pir.triggered()) {
payload.moved_data = pir.state();
doTrigger();
}
#endif
switch (scheduler.pollWaiting()) {
case MEASURE:
// reschedule these measurements periodically
scheduler.timer(MEASURE, MEASURE_PERIOD);
doMeasure();
// every so often, a report needs to be sent out
if (++reportCount >= REPORT_EVERY) {
reportCount = 0;
scheduler.timer(REPORT, 0);
}
break;
case REPORT:
doReport();
break;
}
}

67
contrib/contrib/README Executable file
View File

@ -0,0 +1,67 @@
- 11_FHT8V.pm
Module to control FHT8V valve servos via CUL/CUN
precondition: support must be added to 00_CUL.pm. This support is primary
tested with a modified send-method of the culfw.
- 70_SCIVT.pm
Support for an SCD series solar controler device. Details see
http://english.ivt-hirschau.de/content.php?parent_id=CAT_64&doc_id=DOC_118
- 86_FS10.pm
Support for FS10. Read README.FS10, you have to install pcwsd first.
- 91_DbLog.pm
Example to log data in a (DBI supported) database (MySQL, Oracle, etc)
see dblog for a full-featured database log
- 95_PachLog.pm
Pachube module from Axel
- 97_GROUP.pm
Helper for FHEMWEB to display different groups of device READINGS at once
- 99_dumpdef.pm
Debugging helpers from Axel
- 99_ALARM.pm
Example for a Low Budget ALARM System by Martin
- 99_SUNRISE.pm
The "original" (i.e. old) Sunrise/Sunset support. Needs the hard-to-install
DateTime::Event::Sunrise perl module. Use the 99_SUNRISE_EL.pm module instead.
- 99_PID
Direct 8v controlling with the help of Temp sensors by Alexander
- checkmsg.pl
Check header/function/crc of an FS20 hex message
- crc.pl
Computing CRC16 in perl
- dblog/*
Support for a full-featured database log by Boris. See the README.
- em1010.pl / em1010.gnuplot
Standalone EM1010PC reader program and a gnuplot file to plot em1010 data
- four2hex
Convert housecode from ELV notation (4) to fhem.pl notation (hex)
Not needed any more, as current fhem versions understand both.
- fs20_holidays.sh
STefan's "presence simulator" for holidays
- garden.pl
Garden irrigation regulator with weather dependency (KS300 temp + rain)
- fhem-speech
Martins instructions on how to make FHEM talk using the MBROLA speech
synthesizer
- init-scripts
RC scripts to be put into /etc/init.d and then symlinked to /etc/rc3.d or
similar.
- ks300avg.pl
Computing daily/monthly avarage values from a KS300 log
- rolwzo_not_off.sh
Martin's "don't lock me out" program: look at the comment
- rotateShiftWork
Shellskript for changing am/pm temperatures when working on a shift
- rrd
Peter's RRD support. See the HOWTO
- serial.pm
Serial line analyzer
- km271.pl
Plain Buderus Logamatic 2107 communication module (KM271) logger
See the 00_KM271.pm fhem module for its successor.
- RSSImonitor.pl
Produces an overview on the RSSI readings from a log. Good for checking
the signal quality at various locations for CUL and CUN. See begin of
script for usage instructions.
- tcptee.pl
Used to connect e.g. a fhem and a CCU to a single HM-Lan config (the
correstponding fhem device should have the attribute dummy).

37
contrib/contrib/README.FS10 Normal file
View File

@ -0,0 +1,37 @@
86_FS10.pm is for reading ELV (www.elv.de) weather Sensors, using a Hardware
(Part No. 68-390-61) and communicates with pcwsd from Sven Geggus.
Currently temperature, windspeed, rain and brightness sensors are supported.
For use with FHEM you have to compile pcwsd like usual, it can be found here
http://geggus.net/sven/pcwsd/
Start pcwsd deamon with
pcwsd -d /dev/ttyUSB4 -ld /var/log/fs10- -tlf %Y-%m-%d_%T
A few minutes later you should see files with temperature values.
For use with FHEM define
define fs10 FS10 127.0.0.1 4711 which means pcwsd run on localhost, port 4711
If you only interested in viewing temperature values with a FHEM frontend like
pgm3, 86_FS10.pm can be ommited.
To display a user defined FS10 temperature graphic in pgm3 define
########################
#
$sortnumber=7;
$userdef[$sortnumber]['name']='IndoorTemp';
$userdef[$sortnumber]['valuefield']=2;
$userdef[$sortnumber]['gnuplottype']='temperature';
$userdef[$sortnumber]['logpath']='/var/log/fs10/idtemp_7.gnu';
$userdef[$sortnumber]['room']='indoor';
$userdef[$sortnumber]['semlong']='Temp indor';
$userdef[$sortnumber]['semshort']='°';
$userdef[$sortnumber]['imagemax']=725;
$userdef[$sortnumber]['imagemay']=52;
$userdef[$sortnumber]['maxcount']=575;
$userdef[$sortnumber]['XcorrectMainText']=25;
$userdef[$sortnumber]['logrotatelines']=2050;

90
contrib/contrib/RSSImonitor.pl Executable file
View File

@ -0,0 +1,90 @@
#!/usr/bin/perl -w
#
# RSSImonitor.pl
# (c) 2010 Dr. Boris Neubert
# omega at online dot de
#
#
# This perl script evaluates the RSSI information from
# your devices in order to help you finding the best
# location to place your CUL or CUN device.
#
# Instructions:
#
# 1. Make your CUN or CUL create additional events:
# attr CUN addvaltrigger
#
# 2. Log the RSSI events to a single file:
# define RSSI.log FileLog /path/to/RSSI.log .*:RSSI.*
#
# 3. Wait some time until all devices have sent something.
#
# 4. Run the log file through RSSImonitor:
# RSSImonitor.pl < /path/to/RSSI.log
#
# 5. The output lists any device from the log together with
# the minimum, maximum and average RSSI as well as its
# standard deviation.
#
#
# type perldoc perldsc to learn about hashes of arrays
#
use strict;
my %RSSI;
sub storeRSSI {
my ($device, $value)= @_;
if(!($RSSI{$device})) {
$RSSI{$device}= [];
#print "new device $device\n";
}
push @{ $RSSI{$device} }, $value;
#print "device: $device, value: $value\n";
}
sub readRSSI {
while( <> ) {
my ($timestamp, $device, $keyword, $value)= split;
if($keyword eq "RSSI:") {
storeRSSI($device, $value);
}
}
}
sub calcStats {
my ($device)= @_;
my $min= 100.;
my $max= -100.;
my $m1= 0.;
my $m2= 0.;
my $n= $#{ $RSSI{$device} }+1;
my ($i, $value);
my ($avg, $sigma);
foreach $i ( 0 .. $#{ $RSSI{$device} } ) {
$value= $RSSI{$device}[$i];
if($value< $min) { $min= $value; }
if($value> $max) { $max= $value; }
$m1+= $value;
$m2+= $value*$value;
}
$avg= $m1/$n;
$sigma= sqrt($m2/$n-$avg*$avg);
return ($min, $max, $avg, $sigma);
}
#
# main
#
readRSSI;
my $device;
printf("%12s\t%s\t%s\t%s\t%s\n", "Device", "Min", "Max", "Avg", "StdDev");
foreach $device (keys %RSSI) {
my ($min, $max, $avg, $sigma)= calcStats($device);
printf("%12s\t%.1f\t%.1f\t%.1f\t%.1f\n", $device, $min, $max, $avg, $sigma);
}

138
contrib/contrib/WBS/18_WBS.pm Normal file
View File

@ -0,0 +1,138 @@
################################################################################
# Web based Sensors = 18_WBS.pm
# Sensors updated only via Web
#
# Version: 1.0.1
# Date: 24.05.2010
# Author: Axel Rieger
#
################################################################################
#
# Define:
# define <NAME> WBS TYPE CODE
#
# Type = READING-NAME f.e.
# CODE = Unique-Code for WBS-Sensors max. 16 Chars
#
# Example
# define WBS001 WBS Temperature 1032D8ED01080011
# $defs$defs{WBS001}{TYPE} = WBS
# $defs$defs{WBS001}{CODE} = 1032D8ED01080011
# $defs{WBS001}{READINGS}{Temperature}{VAL} = 0
# $defs{WBS001}{READINGS}{Temperature}{TIME} = TimeNow()
# Only One READING for each WBS
#
# Updates via WEB:
# MSG-Format:
# WBS:SENSOR-CODE:VALUE
# WBS -> Web Based Sensor -> matching in FHEM
# Sensor-Code -> Unique-Code for WBS-Sensors max. 16 Chars
# Value -> Data from Sensor like 18°C -> Format: INT only [1...90.-]
# max. lenght Value: -xxx.xxx 8 Chars
# max-Lenght MSG: 3:16:8 = 29 Chars
# Example: Temperature form Dallas 1820-Temp-Sensors 24.32 °Celsius
# WBS:1032D8ED01080011:23.32
# Update via http-get-request
# http://[MY_FHEMWEB:xxxx]/fhem/rawmsg?WBS:1032D8ED01080011:23.32
################################################################################
package main;
use strict;
use warnings;
use POSIX;
use Data::Dumper;
use vars qw(%defs);
use vars qw(%attr);
use vars qw(%data);
use vars qw(%modules);
################################################################################
sub WBS_Initialize($)
{
my ($hash) = @_;
$hash->{Match} = "^WBS:";
$hash->{DefFn} = "WBS_Define";
$hash->{UndefFn} = "WBS_Undef";
$hash->{ParseFn} = "WBS_Parse";
$hash->{AttrList} = "IODEV do_not_notify:0,1 loglevel:0,5 disable:0,1";
$hash->{defptr} = {};
#Rebuild DefPtr
my $mod = "WBS";
foreach my $d (sort keys %defs) {
next if($defs{$d}{TYPE} ne $mod);
Log 0, "WBS-DEFPTR-FOUND: " . $defs{$d}{NAME} . " : " . $defs{$d}{CODE};
$modules{WBS}{defptr}{$defs{$d}{CODE}} = $defs{$d}{NAME};
}
}
################################################################################
sub WBS_Define($)
{
# define <NAME> WBS TYPE CODE
my ($self, $defs) = @_;
Log 0, "WBS|DEFINE: " . Dumper(@_);
my @a = split(/ /, $defs);
return "WBS|Define|ERROR: Unknown argument count " . int(@a) . " , usage define <NAME> WBS TYPE CODE" if(int(@a) != 4);
my $mod = $a[1];
my $Type = $a[2];
my $Code = $a[3];
if(defined($modules{WBS}{defptr}{$Code})) {
return "WBS|Define|ERROR: Code is used";
}
if(length($Code) > 16) {
return "WBS|Define|ERROR: Max. Length CODE > 16";
}
$self->{CODE} = $Code;
$self->{STATE} = "NEW: " . TimeNow();
$self->{WBS_TYPE} = $Type;
$self->{READINGS}{$Type}{VAL} = 0;
$self->{READINGS}{$Type}{TIME} = TimeNow();
$modules{WBS}{defptr}{$Code} = $self->{NAME};
return undef;
}
################################################################################
sub WBS_Undef($$)
{
my ($hash, $name) = @_;
Log 0, "WBS|Undef: " . Dumper(@_);
my $mod = $defs{$name}{TYPE};
my $Code = $defs{$name}{CODE};
if(defined($modules{$mod}{defptr}{$Code})) {
delete $modules{$mod}{defptr}{$Code}
}
return undef;
}
################################################################################
sub WBS_Parse($$)
{
my ($iodev,$rawmsg) = @_;
# MSG: WBS:1032D8ED01080011:23.32
my ($null,$code,$value) = split(/:/, $rawmsg);
if(length($code) > 16 ) {
return "WBS|Parse|ERROR: Max. Length CODE > 16";
}
if(length($value) > 8) {
return "WBS|Parse|ERROR: Max. Length VALUE > 8";
}
# Find Device-Name
my $mod = "WBS";
if(!defined($modules{$mod}{defptr}{$code})){
return "WBS|Parse|ERROR: Unkown Device for $code";
}
my $wbs_name = $modules{$mod}{defptr}{$code};
my $wbs = $defs{$wbs_name};
#LogLevel
my $ll = 0;
if(defined($attr{$wbs_name}{loglevel})) {$ll = $attr{$wbs_name}{loglevel};}
#Clean-Value
$value =~ s/[^0123456789.-]//g;
# Get Reading
my $reading = $wbs->{WBS_TYPE};
$wbs->{READINGS}{$reading}{VAL} = $value;
$wbs->{READINGS}{$reading}{TIME} = TimeNow();
# State: [FirstChar READING]:VALUE
my $fc = uc(substr($reading,0,1));
$wbs->{STATE} = "$fc: $value | " . TimeNow();
# Changed
$wbs->{CHANGED}[0] = "$reading:$value";
return $wbs_name;
}
################################################################################
1;

123
contrib/contrib/WBS/99_CGI_RAWMSG.pm Normal file
View File

@ -0,0 +1,123 @@
################################################################################
# Route RAW-Sensor-Data via FHEMWEB/CGI to fhem.pl: Function -> disptach($$$)
# 99_CGI_RAWMSG
#
# Version: 1.0.1
# Date: 24.05.2010
# Author: Axel Rieger
#
################################################################################
# Examples for RAW-Sensor-Data
# WBS = WeB-Sensors
# WBS:SENSOR-CODE:SENSOR-TYPE:VALUE:TIMESTAMP
# HMS -> H909801530400F4
# CUL_WS -> K21500163
################################################################################
package main;
use strict;
use warnings;
use Data::Dumper;
use vars qw(%data);
use vars qw($__ME);
################################################################################
sub CGI_RAWMSG_Initialize($)
{
# FHEM Part
my ($hash) = @_;
$hash->{Clients} = ":CUL_WS:HMS:WBS:";
my %mc = (
"1:CUL_WS" => "^K.....",
"2:HMS" => "^810e04....(1|5|9).a001",
"3:WBS" => "^WBS:",
);
$hash->{MatchList} = \%mc;
# CGI Part
my $cgi_key = "rawmsg";
my $cgi_name = "CGI_RAWMSG";
# PRIV-CGI
my $fhem_url = "/" . $cgi_key ;
$data{FWEXT}{$fhem_url}{FUNC} = "CGI_RAWMSG_Dispatch";
$data{FWEXT}{$fhem_url}{LINK} = $cgi_key;
$data{FWEXT}{$fhem_url}{NAME} = $cgi_name;
# Create IO-Device for fhem-dispatcher
$data{$cgi_key}{NAME} = $cgi_name;
$data{$cgi_key}{MatchList} = \%mc;
if(!defined($defs{$cgi_name})){
fhem "define $cgi_name dummy";
$defs{$cgi_name}{STATE} = "AKTIV 99_CGI_RAWMSG";
$defs{$cgi_name}{TYPE} = "CGI_RAWMSG";
fhem "attr $cgi_name comment DUMMY_DEVICE_FOR_99_CGI_RAWMSG";
}
}
################################################################################
sub CGI_RAWMSG_Dispatch($$)
{
my ($htmlarg) = @_;
my ($ret_param,$ret_txt,@tmp,$rawmsg,$cgikey);
Log 5, "CGI_RAWMSG|Dispatch|START: $htmlarg";
$ret_param = "text/plain; charset=ISO-8859-1";
$ret_txt = "ERROR;NODATA";
# print "CGI_RAWMSG|Dispatch: " . Dumper(@_) . "\n";
# Aufurf: http://[FHEMWEB]/fhem/rawmsg?TEST12345
# htmlarg = /rawmsg?TEST12345
if($htmlarg =~ /\?/) {
@tmp = split(/\?/,$htmlarg);
$cgikey = shift(@tmp);
$cgikey =~ s/\///;
$rawmsg = shift(@tmp);
# HELP
if($rawmsg eq "help") {
no strict "refs";
$ret_txt = &CGI_RAWMSG_help;
use strict "refs";
return ($ret_param, $ret_txt);
}
# Check rawmsg
foreach my $m (sort keys %{$data{$cgikey}{MatchList}}) {
Log 5, "CGI_RAWMSG|MatchList-RAWMSG: $rawmsg";
Log 5, "CGI_RAWMSG|MatchList-Key: $m";
Log 5, "CGI_RAWMSG|MatchList-Val: " . $data{$cgikey}{MatchList}{$m};
my $match = $data{$cgikey}{MatchList}{$m};
if($rawmsg =~ m/$match/) {
Log 5, "CGI_RAWMSG|MatchList-Key FOUND: $m";
# $ret_txt = "HTMLARG = $htmlarg\n";
# $ret_txt .= "CGI-KEY = $cgikey\n";
# $ret_txt .= "RAWMSG = $rawmsg\n";
# Dummy-Device
my $name = $data{$cgikey}{NAME};
my $hash = $defs{$name};
$hash->{"${name}_MSGCNT"}++;
$hash->{"${name}_TIME"} = TimeNow();
$hash->{RAWMSG} = $rawmsg;
my %addvals = (RAWMSG => $rawmsg);
my $ret_disp = &Dispatch($hash, $rawmsg, \%addvals);
if(defined($ret_disp)) {$ret_txt = "OK;" . join(";" ,@$ret_disp) . "\n";}
else {$ret_txt = "ERROR;NODEVICEFOUND";}
return ($ret_param, $ret_txt);
}
}
$ret_txt = "ERROR;NODATAMATCH";
}
return ($ret_param, $ret_txt);
}
################################################################################
sub CGI_RAWMSG_help
{
my $txt = "Route RAW-Sensor-Data via FHEMWEB/CGI to FHEM\n";
$txt .= "FHEM.PL Function -> disptach($$$)\n";
$txt .= "Examples for RAW-Sensor-Data \n";
$txt .= "WBS = WeB-Sensors\n";
$txt .= "WBS:SENSOR-CODE:SENSOR-TYPE:VALUE:TIMESTAMP\n";
$txt .= "HMS -> H909801530400F4\n";
$txt .= "CUL_WS -> K21500163 \n";
retrun $txt;
}
################################################################################
sub CGI_RAWMSG_new_iodev
{
}
################################################################################
1;
################################################################################

22
contrib/contrib/aut.holiday Normal file
View File

@ -0,0 +1,22 @@
# Siehe auch
# http://de.wikipedia.org/wiki/Feiertage_in_Österreich
1 01-01 Neujahr
1 01-06 Heilige Drei Koenige
1 05-01 Tag der Arbeit
1 08-15 Mariae Himmelfahrt
1 10-26 Nationalfeiertag
1 11-01 Allerheiligen
1 12-08 Mariä Empfängnis
1 12-24 Weihnachten
1 12-25 1. Weihnachtstag
1 12-26 2. Weihnachtstag
1 12-31 Silvester
2 1 Ostermontag
2 39 Christi Himmelfahrt
2 50 Pfingsten
2 60 Fronleichnam
4 07-01 08-31 Sommerferien

19
contrib/contrib/by.holiday Normal file
View File

@ -0,0 +1,19 @@
# Siehe auch
# http://de.wikipedia.org/wiki/Feiertage_in_Deutschland
1 01-01 Neujahr
1 01-06 Heilige Drei Koenige
1 05-01 Tag der Arbeit
1 08-15 Mariae Himmelfahrt (nur bei ueberwiegend katholischer Bevoelkerung)
1 10-03 Tag der deutschen Einheit
1 11-01 Allerheiligen
1 12-25 1. Weihnachtstag
1 12-26 2. Weihnachtstag
2 -2 Karfreitag
2 1 Ostermontag
2 39 Christi Himmelfahrt
2 50 Pfingsten
2 60 Fronleichnam
#5 -1 Wed 11 23 Buss und Bettag (first Wednesday before Nov, 23rd)<br>

27
contrib/contrib/checkmsg.pl Executable file
View File

@ -0,0 +1,27 @@
#!/usr/bin/perl
die("Usage: checkmsg HEX-FHZ-MESSAGE\n") if(int(@ARGV) != 1);
my $msg = $ARGV[0];
die("Bad prefix (not 0x81)\n") if($msg !~ m/^81/);
print("Prefix is ok (0x81)\n");
my $l = hex(substr($msg, 2, 2));
my $rl = length($msg)/2-2;
die("Bad length $rl (should be $l)\n") if($rl != $l);
print("Length is ok ($l)\n");
my @data;
for(my $i = 8; $i < length($msg); $i += 2) {
push(@data, ord(pack('H*', substr($msg, $i, 2))));
}
my $rcrc = 0;
map { $rcrc += $_; } @data;
$rcrc &= 0xFF;
my $crc = hex(substr($msg, 6, 2));
my $str = sprintf("Bad CRC 0x%02x (should be 0x%02x)\n", $crc, $rcrc);
die($str) if($crc ne $rcrc);
printf("CRC is ok (0x%02x)\n", $crc);
exit(0);

35
contrib/contrib/crc.pl Executable file
View File

@ -0,0 +1,35 @@
#!/usr/bin/perl
die("Usage: crc <HEX-MESSAGE> <CRC>\n") if(int(@ARGV) != 2);
my $msg = $ARGV[0];
$msg =~ s/ //g;
my $des = $ARGV[1];
$des =~ s/ //g;
# FFFF: 77 72 statt 2c 7f
# FFFF: 5C AC statt DC D9
#for(my $ic = 0; $ic < 65536; $ic++) {
for(my $ic = 0; $ic < 2; $ic++) {
my $crc = ($ic == 0?0:0xffffffff);
for(my $i = 0; $i < length($msg); $i += 2) {
my $n = ord(pack('H*', substr($msg, $i, 2)));
my $od = $n;
for my $b (0..7) {
my $crcbit = ($crc & 0x80000000) ? 1 : 0;
my $databit = ($n & 0x80) ? 1 : 0;
$crc <<= 1;
$n <<= 1;
$crc ^= 0x04C11DB7 if($crcbit != $databit);
# printf("%3d.%d %02x CRC %x ($crcbit $databit)\n", $i/2, $b, $n, $crc);
}
# printf("%3d %02x CRC %02x %02x\n", $i/2, $od, ($crc&0xff00)>>8, $crc&0xff);
}
# print "$ic\n" if($ic % 10000 == 0);
printf("%02x %02x\n",($crc&0xff00)>>8,$crc&0xff);
print "got $ic\n"
if(sprintf("%02x%02x",($crc&0xff00)>>8,$crc&0xff) eq $des);
}

341
contrib/contrib/dblog/93_DbLog.pm Executable file
View File

@ -0,0 +1,341 @@
##############################################
#
# 93_DbLog.pm
# written by Dr. Boris Neubert 2007-12-30
# e-mail: omega at online dot de
#
##############################################
package main;
use strict;
use warnings;
use DBI;
sub DbLog($$$);
################################################################
sub
DbLog_Initialize($)
{
my ($hash) = @_;
$hash->{DefFn} = "DbLog_Define";
$hash->{UndefFn} = "DbLog_Undef";
$hash->{NotifyFn} = "DbLog_Log";
$hash->{AttrFn} = "DbLog_Attr";
$hash->{AttrList} = "disable:0,1";
}
#####################################
sub
DbLog_Define($@)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "wrong syntax: define <name> DbLog configuration regexp"
if(int(@a) != 4);
my $regexp = $a[3];
eval { "Hallo" =~ m/^$regexp$/ };
return "Bad regexp: $@" if($@);
$hash->{REGEXP} = $regexp;
$hash->{configuration}= $a[2];
return "Can't connect to database." if(!DbLog_Connect($hash));
$hash->{STATE} = "active";
return undef;
}
#####################################
sub
DbLog_Undef($$)
{
my ($hash, $name) = @_;
my $dbh= $hash->{DBH};
$dbh->disconnect() if(defined($dbh));
return undef;
}
################################################################
sub
DbLog_Attr(@)
{
my @a = @_;
my $do = 0;
if($a[0] eq "set" && $a[2] eq "disable") {
$do = (!defined($a[3]) || $a[3]) ? 1 : 2;
}
$do = 2 if($a[0] eq "del" && (!$a[2] || $a[2] eq "disable"));
return if(!$do);
$defs{$a[1]}{STATE} = ($do == 1 ? "disabled" : "active");
return undef;
}
################################################################
sub
DbLog_ParseEvent($$)
{
my ($type, $event)= @_;
my @result;
# split the event into reading and argument
# "day-temp: 22.0 (Celsius)" -> "day-temp", "22.0 (Celsius)"
my @parts= split(/: /,$event);
my $reading= $parts[0]; if(!defined($reading)) { $reading= ""; }
my $arg= $parts[1];
# the interpretation of the argument depends on the device type
#default
my $value= $arg; if(!defined($value)) { $value= ""; }
my $unit= "";
# EMEM, M232Counter, M232Voltage return plain numbers
if(($type eq "M232Voltage") ||
($type eq "M232Counter") ||
($type eq "EMEM")) {
}
# FS20
elsif(($type eq "FS20") ||
($type eq "X10")) {
@parts= split(/ /,$value);
my $reading= $parts[0]; if(!defined($reading)) { $reading= ""; }
if($#parts>=1) {
$value= join(" ", shift @parts);
if($reading =~ m(^dim*%$)) {
$value= substr($reading,3,length($reading)-4);
$reading= "dim";
$unit= "%";
}
else {
$value= "";
}
}
}
# FHT
elsif($type eq "FHT") {
if($reading =~ m(-from[12]\ ) || $reading =~ m(-to[12]\ )) {
@parts= split(/ /,$event);
$reading= $parts[0];
$value= $parts[1];
$unit= "";
}
if($reading =~ m(-temp)) { $value=~ s/ \(Celsius\)//; $unit= "°C"; }
if($reading =~ m(temp-offset)) { $value=~ s/ \(Celsius\)//; $unit= "°C"; }
if($reading =~ m(^actuator[0-9]*)) {
if($value eq "lime-protection") {
$reading= "actuator-lime-protection";
undef $value;
}
elsif($value =~ m(^offset:)) {
$reading= "actuator-offset";
@parts= split(/: /,$value);
$value= $parts[1];
if(defined $value) {
$value=~ s/%//; $value= $value*1.; $unit= "%";
}
}
elsif($value =~ m(^unknown_)) {
@parts= split(/: /,$value);
$reading= "actuator-" . $parts[0];
$value= $parts[1];
if(defined $value) {
$value=~ s/%//; $value= $value*1.; $unit= "%";
}
}
elsif($value eq "synctime") {
$reading= "actuator-synctime";
undef $value;
}
elsif($value eq "test") {
$reading= "actuator-test";
undef $value;
}
elsif($value eq "pair") {
$reading= "actuator-pair";
undef $value;
}
else {
$value=~ s/%//; $value= $value*1.; $unit= "%";
}
}
}
# KS300
elsif($type eq "KS300") {
if($event =~ m(T:.*)) { $reading= "data"; $value= $event; }
if($event =~ m(avg_day)) { $reading= "data"; $value= $event; }
if($event =~ m(avg_month)) { $reading= "data"; $value= $event; }
if($reading eq "temperature") { $value=~ s/ \(Celsius\)//; $unit= "°C"; }
if($reading eq "wind") { $value=~ s/ \(km\/h\)//; $unit= "km/h"; }
if($reading eq "rain") { $value=~ s/ \(l\/m2\)//; $unit= "l/m2"; }
if($reading eq "rain_raw") { $value=~ s/ \(counter\)//; $unit= ""; }
if($reading eq "humidity") { $value=~ s/ \(\%\)//; $unit= "%"; }
if($reading eq "israining") {
$value=~ s/ \(yes\/no\)//;
$value=~ s/no/0/;
$value=~ s/yes/1/;
}
}
# HMS
elsif($type eq "HMS") {
if($event =~ m(T:.*)) { $reading= "data"; $value= $event; }
if($reading eq "temperature") { $value=~ s/ \(Celsius\)//; $unit= "°C"; }
if($reading eq "humidity") { $value=~ s/ \(\%\)//; $unit= "%"; }
if($reading eq "battery") {
$value=~ s/ok/1/;
$value=~ s/replaced/1/;
$value=~ s/empty/0/;
}
}
# CUL_WS
elsif($type eq "CUL_WS") {
if($event =~ m(T:.*)) { $reading= "data"; $value= $event; }
if($reading eq "temperature") { $unit= "°C"; }
if($reading eq "humidity") { $unit= "%"; }
}
# BS
elsif($type eq "BS") {
if($event =~ m(brightness:.*)) {
@parts= split(/ /,$event);
$reading= "lux";
$value= $parts[4]*1.;
$unit= "lux";
}
}
@result= ($reading,$value,$unit);
return @result;
}
################################################################
sub
DbLog_Log($$)
{
# Log is my entry, Dev is the entry of the changed device
my ($log, $dev) = @_;
# name and type required for parsing
my $n= $dev->{NAME};
my $t= $dev->{TYPE};
# timestamp in SQL format YYYY-MM-DD hh:mm:ss
#my ($sec,$min,$hr,$day,$mon,$yr,$wday,$yday,$isdst)= localtime(time);
#my $ts= sprintf("%04d-%02d-%02d %02d:%02d:%02d", $yr+1900,$mon+1,$day,$hr,$min,$sec);
my $re = $log->{REGEXP};
my $max = int(@{$dev->{CHANGED}});
for (my $i = 0; $i < $max; $i++) {
my $s = $dev->{CHANGED}[$i];
$s = "" if(!defined($s));
if($n =~ m/^$re$/ || "$n:$s" =~ m/^$re$/) {
my $ts = TimeNow();
$ts = $dev->{CHANGETIME}[$i] if(defined($dev->{CHANGETIME}[$i]));
# $ts is in SQL format YYYY-MM-DD hh:mm:ss
my @r= DbLog_ParseEvent($t, $s);
my $reading= $r[0];
my $value= $r[1];
my $unit= $r[2];
if(!defined $reading) { $reading= ""; }
if(!defined $value) { $value= ""; }
if(!defined $unit) { $unit= ""; }
my $is= "(TIMESTAMP, DEVICE, TYPE, EVENT, READING, VALUE, UNIT) VALUES " .
"('$ts', '$n', '$t', '$s', '$reading', '$value', '$unit')";
DbLog_ExecSQL($log, "INSERT INTO history" . $is);
DbLog_ExecSQL($log, "DELETE FROM current WHERE (DEVICE='$n') AND (READING='$reading')");
DbLog_ExecSQL($log, "INSERT INTO current" . $is);
}
}
return "";
}
################################################################
sub
DbLog_Connect($)
{
my ($hash)= @_;
my $configfilename= $hash->{configuration};
if(!open(CONFIG, $configfilename)) {
Log 1, "Cannot open database configuration file $configfilename.";
return 0; }
my @config=<CONFIG>;
close(CONFIG);
my %dbconfig;
eval join("", @config);
my $dbconn= $dbconfig{connection};
my $dbuser= $dbconfig{user};
my $dbpassword= $dbconfig{password};
Log 3, "Connecting to database $dbconn with user $dbuser";
my $dbh = DBI->connect_cached("dbi:$dbconn", $dbuser, $dbpassword);
if(!$dbh) {
Log 1, "Can't connect to $dbconn: $DBI::errstr";
return 0;
}
Log 3, "Connection to db $dbconn established";
$hash->{DBH}= $dbh;
return 1;
}
################################################################
sub
DbLog_ExecSQL1($$)
{
my ($dbh,$sql)= @_;
my $sth = $dbh->do($sql);
if(!$sth) {
Log 2, "DBLog error: " . $DBI::errstr;
return 0;
}
return 1;
}
sub
DbLog_ExecSQL($$)
{
my ($hash,$sql)= @_;
Log 5, "Executing $sql";
my $dbh= $hash->{DBH};
if(!DbLog_ExecSQL1($dbh,$sql)) {
#retry
$dbh->disconnect();
if(!DbLog_Connect($hash)) {
Log 2, "DBLog reconnect failed.";
return 0;
}
$dbh= $hash->{DBH};
if(!DbLog_ExecSQL1($dbh,$sql)) {
Log 2, "DBLog retry failed.";
return 0;
}
Log 2, "DBLog retry ok.";
}
return 1;
}
################################################################
1;

13
contrib/contrib/dblog/README Normal file
View File

@ -0,0 +1,13 @@
For usage instruction see commandref.html, section define
2007-12-30bn
- 93_DbLog.pm
copy this file into <modpath>/FHEM
- db.conf
sample database configuration file
- fhemdb_create.sql
sample sql command to create a mysql database for logging purposes
- fhemdb_get.pl
sample perl script for retrieving the current (latest) data from
the logging database

11
contrib/contrib/dblog/db.conf Normal file
View File

@ -0,0 +1,11 @@
#
# database configuration file
#
#
#
%dbconfig= (
connection => "mysql:database=fhem;host=db;port=3306",
user => "fhemuser",
password => "fhempassword",
);

7
contrib/contrib/dblog/fhemdb_create.sql Normal file
View File

@ -0,0 +1,7 @@
CREATE DATABASE `fhem` DEFAULT CHARACTER SET utf8 COLLATE utf8_bin;
CREATE USER 'fhemuser'@'%' IDENTIFIED BY 'fhempassword';
CREATE TABLE history (TIMESTAMP TIMESTAMP, DEVICE varchar(32), TYPE varchar(32), EVENT varchar(64), READING varchar(32), VALUE varchar(32), UNIT varchar(32));
CREATE TABLE current (TIMESTAMP TIMESTAMP, DEVICE varchar(32), TYPE varchar(32), EVENT varchar(64), READING varchar(32), VALUE varchar(32), UNIT varchar(32));
GRANT SELECT, INSERT, DELETE ON `fhem` .* TO 'fhemuser'@'%';

93
contrib/contrib/dblog/fhemdb_get.pl Executable file
View File

@ -0,0 +1,93 @@
#!/usr/bin/perl
#
################################################################
#
# Copyright notice
#
# (c) 2007 Copyright: Dr. Boris Neubert (omega at online dot de)
# All rights reserved
#
# This script 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.
#
# The GNU General Public License can be found at
# http://www.gnu.org/copyleft/gpl.html.
# A copy is found in the textfile GPL.txt and important notices to the license
# from the author is found in LICENSE.txt distributed with these scripts.
#
# This script 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.
#
# This copyright notice MUST APPEAR in all copies of the script!
#
################################################################
#
# this script returns the current reading for a device stored in
# the fhem logging database
#
# Usage:
# fhemdb_get.pl <device> <reading> [<reading> ...]
# Example:
# fhemdb_get.pl ext.ks300 temperature humidity
#
#
#
# global configuration
#
my $dbconn = "mysql:database=fhem;host=db;port=3306";
my $dbuser = "fhemuser";
my $dbpassword = "fhempassword";
#
# nothing to change below this line
#
use strict;
use warnings;
use DBI;
(@ARGV>=2) || die "Usage: fhemdb_get.pl <device> <reading> [<reading> ... ]";
my $device= $ARGV[0];
my @readings=@ARGV; shift @readings;
my $set= join(",", map({"\'" . $_ . "\'"} @readings));
my $dbh= DBI->connect_cached("dbi:$dbconn", $dbuser, $dbpassword) ||
die "Cannot connect to $dbconn: $DBI::errstr";
my $stm= "SELECT READING, VALUE FROM current WHERE
(DEVICE='$device') AND
(READING IN ($set))";
my $sth= $dbh->prepare($stm) ||
die "Cannot prepare statement $stm: $DBI::errstr";
my $rc= $sth->execute() ||
die "Cannot execute statement $stm: $DBI::errstr";
my %rs;
my $reading;
my $value;
while( ($reading,$value)= $sth->fetchrow_array) {
$rs{$reading}= $value;
}
foreach $reading (@readings) {
$value= $rs{$reading};
$value= "NULL" if(!defined($value));
print "$reading:$value ";
}
print "\n";
die $sth->errstr if $sth->err;
$dbh->disconnect();

474
contrib/contrib/em1010.pl Executable file
View File

@ -0,0 +1,474 @@
#!/usr/bin/perl
use strict;
use warnings;
use Device::SerialPort;
sub b($$);
sub w($$);
sub docrc($$);
sub checkcrc($$);
sub getData($);
sub makemsg($);
sub maketime($);
my %cmd = (
"getVersion" => 1,
"getTime" => 1,
"getDevStatus" => 1,
"getDevPage" => 1,
"getDevData" => 1,
"setPrice" => 1,
"setAlarm" => 1,
"setRperKW" => 1,
"get62" => 1,
"setTime" => 1,
"reset" => 1,
);
if(@ARGV < 2) {
printf("Usage: perl em1010.pl serial-device command args\n");
exit(1);
}
my $ser = $ARGV[0];
my $fd;
#####################
# Open serial port
my $serport = new Device::SerialPort ($ser);
die "Can't open $ser: $!\n" if(!$serport);
$serport->reset_error();
$serport->baudrate(38400);
$serport->databits(8);
$serport->parity('none');
$serport->stopbits(1);
$serport->handshake('none');
my $cmd = $ARGV[1];
if(!defined($cmd{$cmd})) {
printf("Unknown command $cmd, use one of " . join(" ",sort keys %cmd) . "\n");
exit(0);
}
###########################
no strict "refs";
&{$cmd }();
use strict "refs";
exit(0);
#########################
sub
maketime($)
{
my @l = localtime(shift);
return sprintf("%04d-%02d-%02d_%02d:%02d:00",
1900+$l[5],$l[4]+1,$l[3],$l[2],$l[1]-$l[1]%5);
}
#########################
sub
b($$)
{
my ($t,$p) = @_;
return ord(substr($t,$p,1));
}
#########################
sub
w($$)
{
my ($t,$p) = @_;
return b($t,$p+1)*256 + b($t,$p);
}
#########################
sub
dw($$)
{
my ($t,$p) = @_;
return w($t,$p+2)*65536 + w($t,$p);
}
#########################
sub
docrc($$)
{
my ($in, $val) = @_;
my ($crc, $bits) = (0, 8);
my $k = (($in >> 8) ^ $val) << 8;
while($bits--) {
if(($crc ^ $k) & 0x8000) {
$crc = ($crc << 1) ^ 0x8005;
} else {
$crc <<= 1;
}
$k <<= 1;
}
return (($in << 8) ^ $crc) & 0xffff;
}
#########################
sub
checkcrc($$)
{
my ($otxt, $len) = @_;
my $crc = 0x8c27;
for(my $l = 2; $l < $len+4; $l++) {
my $b = ord(substr($otxt,$l,1));
$crc = docrc($crc, 0x10) if($b==0x02 || $b==0x03 || $b==0x10);
$crc = docrc($crc, $b);
}
return ($crc == w($otxt, $len+4));
}
#########################
sub
esc($)
{
my ($b) = @_;
my $out = "";
$out .= chr(0x10) if($b==0x02 || $b==0x03 || $b==0x10);
$out .= chr($b);
}
#########################
sub
makemsg($)
{
my ($data) = @_;
my $len = length($data);
$data = chr($len&0xff) . chr(int($len/256)) . $data;
my $out = pack('H*', "0200");
my $crc = 0x8c27;
for(my $l = 0; $l < $len+2; $l++) {
my $b = ord(substr($data,$l,1));
$crc = docrc($crc, 0x10) if($b==0x02 || $b==0x03 || $b==0x10);
$crc = docrc($crc, $b);
$out .= esc($b);
}
$out .= esc($crc&0xff);
$out .= esc($crc/256);
$out .= chr(0x03);
return $out;
}
#########################
sub
getData($)
{
my ($d) = @_;
$d = makemsg(pack('H*', $d));
#print "Sending: " . unpack('H*', $d) . "\n";
for(my $rep = 0; $rep < 3; $rep++) {
#printf "write (try nr $rep)\n";
$serport->write($d);
my $retval = "";
my $esc = 0;
my $started = 0;
my $complete = 0;
for(;;) {
my ($rout, $rin) = ('', '');
vec($rin, $serport->FILENO, 1) = 1;
my $nfound = select($rout=$rin, undef, undef, 1.0);
die("Select error $nfound / $!\n") if($nfound < 0);
last if($nfound == 0);
my $buf = $serport->input();
die "EOF on $ser\n" if(!defined($buf) || length($buf) == 0);
for(my $i = 0; $i < length($buf); $i++) {
my $b = ord(substr($buf,$i,1));
if(!$started && $b != 0x02) { next; }
$started = 1;
if($esc) { $retval .= chr($b); $esc = 0; next; }
if($b == 0x10) { $esc = 1; next; }
$retval .= chr($b);
if($b == 0x03) { $complete = 1; last; }
}
if($complete) {
my $l = length($retval);
if($l < 8) { printf("Msg too short\n"); last; }
if(b($retval,1) != 0) { printf("Bad second byte\n"); last; }
if(w($retval,2) != $l-7) { printf("Length mismatch\n"); last; }
if(!checkcrc($retval,$l-7)) { printf("Bad CRC\n"); last; }
return substr($retval, 4, $l-7);
}
}
}
printf "Timeout reading the answer\n";
exit(1);
}
#########################
sub
hexdump($)
{
my ($d) = @_;
for(my $i = 0; $i < length($d); $i += 16) {
my $h = unpack("H*", substr($d, $i, 16));
$h =~ s/(....)/$1 /g;
printf "RAW %-40s\n", $h;
}
}
#########################
sub
getVersion()
{
my $d = getData("76");
printf "%d.%d\n", b($d,0), b($d,1);
}
#########################
sub
getTime()
{
my $d = getData("74");
printf("%4d-%02d-%02d %02d:%02d:%02d\n",
b($d,5)+2006, b($d,4), b($d,3),
b($d,0), b($d,1), b($d,2));
}
#########################
sub
getDevStatus()
{
die "Usage: getDevStatus devicenumber (1-12)\n" if(@ARGV != 3);
my $d = getData(sprintf("7a%02x",$ARGV[2]-1));
if($d eq ((pack('H*',"00") x 45) . pack('H*',"FF") x 6)) {
printf(" No device no. $ARGV[2] present\n");
return;
}
my $pulses=w($d,13);
my $pulses_max=w($d,15);
my $ec=w($d,49) / 10;
my $cur_energy=0;
my $cur_power=0;
my $cur_power_max=0;
my $sum_h_energy=0;
my $sum_d_energy=0;
my $sum_w_energy=0;
my $total_energy=0;
my $iec=0;
printf(" Readings (off 2): %d\n", w($d,2));
printf(" Nr devs (off 6): %d\n", b($d,6));
printf(" puls/5min (off 13): %d\n", $pulses);
printf(" puls.max/5min (off 15): %d\n", $pulses_max);
#printf(" Startblk (off 18): %d\n", b($d,18)+13);
#for (my $lauf = 19; $lauf < 45; $lauf += 2) {
# printf(" t wert (off $lauf): %d\n", w($d,$lauf));
#}
# The data must interpreted depending on the sensor type.
# Currently we use the EC value to quess the sensor type.
if ($ec eq 0) {
# Sensor 5..
$iec = 1000;
$cur_power = $pulses / 100;
$cur_power_max = $pulses_max / 100;
} else {
# Sensor 1..4
$iec = $ec;
$cur_energy = $pulses / $ec; # ec = U/kWh
$cur_power = $cur_energy / 5 * 60; # 5minute interval scaled to 1h
printf(" cur.energy(off ): %.3f kWh\n", $cur_energy);
}
$sum_h_energy= dw($d,33) / $iec; # 33= pulses this hour
$sum_d_energy= dw($d,37) / $iec; # 37= pulses today
$sum_w_energy= dw($d,41) / $iec; # 41= pulses this week
$total_energy= dw($d, 7) / $iec; # 7= pulses total
printf(" cur.power ( ): %.3f kW\n", $cur_power);
printf(" cur.power max ( ): %.3f kW\n", $cur_power_max);
printf(" energy h (off 33): %.3f kWh (h)\n", $sum_h_energy);
printf(" energy d (off 37): %.3f kWh (d)\n", $sum_d_energy);
printf(" energy w (off 41): %.3f kWh (w)\n", $sum_w_energy);
printf(" total energy (off 7): %.3f kWh (total)\n", $total_energy);
printf(" Alarm PA (off 45): %d W\n", w($d,45));
printf(" Price CF (off 47): %0.2f EUR/kWh\n", w($d,47)/10000);
printf(" R/kW EC (off 49): %d\n", $ec);
hexdump($d);
}
#########################
sub
getDevPage()
{
die "Usage: getDevPage pagenumber [length] (default length is 264)\n"
if(@ARGV < 3);
my $l = (@ARGV > 3 ? $ARGV[3] : 264);
my $d = getData(sprintf("52%02x%02x0000%02x%02x",
$ARGV[2]%256, int($ARGV[2]/256), $l%256, int($l/256)));
hexdump($d);
}
#########################
sub
getDevData()
{
my $smooth = 1; # Set this to 0 to get the "real" values
die "Usage: getDevData devicenumber (1-12)\n" if(@ARGV != 3);
my $d = getData(sprintf("7a%02x",$ARGV[2]-1));
if($d eq ((pack('H*',"00") x 45) . pack('H*',"FF") x 6)) {
printf(" No device no. $ARGV[2] present\n");
return;
}
my $nrreadings = w($d,2);
if($nrreadings == 0) {
printf("No data to read (yet?)\n");
exit(0);
}
my $step = b($d,6);
my $start = b($d,18)+13;
my $end = $start + int(($nrreadings-1)/64)*$step;
my $div = w($d,49)/10;
if ($div eq 0) {
$div = 1;
}
#printf("Total $nrreadings, $start - $end, Nr $step\n");
my $tm = time()-(($nrreadings-1)*300);
my $backlog = 0;
for(my $p = $start; $p <= $end; $p += $step) {
#printf("Get page $p\n");
$d = getData(sprintf("52%02x%02x00000801", $p%256, int($p/256)));
#hexdump($d);
my $max = (($p == $end) ? ($nrreadings%64)*4+4 : 260);
my $step = b($d, 7); # Switched from 6 to 7 (Thomas, 2009-12-31)
for(my $off = 8; $off <= $max; $off += 4) {
$backlog++;
if($smooth && (w($d,$off+2) == 0xffff)) { # "smoothing"
next;
} else {
my $v = w($d,$off)*12/$div/$backlog;
my $f1 = b($d,$off+2);
my $f2 = b($d,$off+3);
my $f3 = w($d,$off+2);
while($backlog--) {
printf("%s %0.3f kWh (%d %d %d)\n", maketime($tm), $v,
($backlog?-1:$f1), ($backlog?-1:$f2), ($backlog?-1:$f3));
$tm += 300;
}
$backlog = 0;
}
}
}
}
sub
setPrice()
{
die "Usage: setPrice device value_in_cent\n"
if(@ARGV != 4);
my $d = $ARGV[2];
my $v = $ARGV[3];
$d = getData(sprintf("79%02x2f02%02x%02x", $d-1, $v%256, int($v/256)));
if(b($d,0) == 6) {
print("OK");
} else {
print("Error occured");
hexdump($d);
}
}
sub
setAlarm()
{
die "Usage: setAlarm device value_in_kWh\n"
if(@ARGV != 4);
my $d = $ARGV[2];
my $v = $ARGV[3];
$d = getData(sprintf("79%02x2d02%02x%02x", $d-1, $v%256, int($v/256)));
if(b($d,0) == 6) {
print("OK");
} else {
print("Error occured");
hexdump($d);
}
}
sub
setRperKW()
{
die "Usage: setRperKW device rotations_per_KW\n"
if(@ARGV != 4);
my $d = $ARGV[2];
my $v = $ARGV[3];
$v = $v * 10;
$d = getData(sprintf("79%02x3102%02x%02x", $d-1, $v%256, int($v/256)));
if(b($d,0) == 6) {
print("OK");
} else {
print("Error occured");
hexdump($d);
}
}
sub
reset()
{
my $d = getData("4545");
hexdump($d);
}
sub
get62()
{
my $d = getData("62");
hexdump($d);
}
sub
setTime()
{
my $a2 = '';
my $a3 = '';
if (@ARGV == 2) {
my @lt = localtime;
$a2 = sprintf ("%04d-%02d-%02d", $lt[5]+1900, $lt[4]+1, $lt[3]);
$a3 = sprintf ("%02d:%02d:%02d", $lt[2], $lt[1], $lt[0]);
} else {
die "Usage: setTime [time] (as YYYY-MM-DD HH:MM:SS, localtime if empty)\n"
if(@ARGV != 4);
$a2 = $ARGV[2];
$a3 = $ARGV[3];
}
my @d = split("-", $a2);
my @t = split(":", $a3);
my $s = sprintf("73%02x%02x%02x00%02x%02x%02x",
$d[2],$d[1],$d[0]-2000+0xd0,
$t[0],$t[1],$t[2]);
print("-> $s\n");
my $d = getData($s);
if(b($d,0) == 6) {
print("OK");
} else {
print("Error occured");
hexdump($d);
}
}

28
contrib/contrib/executables Normal file
View File

@ -0,0 +1,28 @@
.f/usr/bin/fhem.pl
.f/usr/share/fhem/contrib/checkmsg.pl
.f/usr/share/fhem/contrib/crc.pl
.f/usr/share/fhem/contrib/dblog/fhemdb_get.pl
.f/usr/share/fhem/contrib/em1010.pl
.f/usr/share/fhem/contrib/fhem2speech/fhem-speech
.f/usr/share/fhem/contrib/fhem2speech/fhem-speech.agi
.f/usr/share/fhem/contrib/fs20_holidays.sh
.f/usr/share/fhem/contrib/garden.pl
.f/usr/share/fhem/contrib/getstate/fhem-getstate
.f/usr/share/fhem/contrib/init-scripts/fhem.1
.f/usr/share/fhem/contrib/init-scripts/fhem.2
.f/usr/share/fhem/contrib/init-scripts/fhem.3
.f/usr/share/fhem/contrib/km271.pl
.f/usr/share/fhem/contrib/ks300avg.pl
.f/usr/share/fhem/contrib/rolwzo_not_off.sh
.f/usr/share/fhem/contrib/rotateShiftWork/rotateShiftWork.sh
.f/usr/share/fhem/contrib/serial.pl
.f/usr/share/fhem/contrib/voip2fhem/voip2fhem
.f/usr/share/fhem/contrib/voip2fhem/voip2fhem_create_telefonlist
.f/usr/share/fhem/contrib/voip2fhem/voip2fhem_create_txt2gsm
.f/usr/share/fhem/contrib/ws2000_reader.pl
.f/usr/share/fhem/contrib/DEBIAN/postrm
.f/usr/share/fhem/contrib/DEBIAN/postinst
.f/usr/share/fhem/contrib/DEBIAN/prerm
.f/DEBIAN/postrm
.f/DEBIAN/postinst
.f/DEBIAN/prerm

45
contrib/contrib/fhem2speech/ChangeLog Normal file
View File

@ -0,0 +1,45 @@
2009-01-11 (1.4) Martin Fischer <m_fischer@gmx.de>
* test for arguments added
* new option --set to set device status added
* documentation updated
2009-01-07 (1.3) Martin Fischer <m_fischer@gmx.de>
* Perl modul JSON::XS for communication with FHEM included. This requires
jsonlist (fhem/contrib) for FHEM.
* several changes for parsing the JSON result
* buffering disabled
* output as asterisk AGI command added
* new subroutine for removing value units
2009-01-01 (1.2) Martin Fischer <m_fischer@gmx.de>
* Perl modul Term::ANSIColor removed
* external command 'recode' for converting UTF8 to latin1. mbrola need
this to speek german umlauts
* new output format gsm
* options for outputformat now configurable
* translation for special chars added
* new option --asterisk, -a to support asterisk parsing added
* new option --prefix to flag outfiles with a user prefix added
* new option --force to override existing files added
* support for reading files added
* several changes in subroutine text2speech (code cleanup)
2008-12-31 (1.1) Martin Fischer <m_fischer@gmx.de>
* command-line options now works with Getopt::Long
* check for external files (mbrola, txt2pho, sox, etc.) included
* include a debug routine. use it with --debug on command-line
* documentation added
* added support for quiet mode. use it with -q, --quiet
* FHEM error trap added
* new option -t "TEXT". read the given text
* new option to support female or male voice. use it with -S, --Sex
on command-line
* replace unwanted chars with text, e.g. - = Minus
* support for generating (cached) wave files
* update the documentation
* added cached files for all modes

BIN
contrib/contrib/fhem2speech/JSON-XS-2.231.tar.gz Normal file
View File

Binary file not shown.

345
contrib/contrib/fhem2speech/README.fhem-speech Normal file
View File

@ -0,0 +1,345 @@
NAME
fhem-speech - Synthesized voice (based on MBROLA) extension for FHEM
SYNOPSIS
fhem-speech -d device [-achopqS]
fhem-speech -d device --set state [-hp]
fhem-speech -f file [-acoqS]
fhem-speech -t "text" [-acoqS]
fhem-speech [-HmV?]
Try `fhem-speech --man` for full manual!
DESCRIPTION
fhem-speech
fhem-speech read the status of a FHEM device and talk using the MBROLA
speech synthesizer. Furthermore it can read the content of a given file
or text.
FHEM
FHEM is used to automate some common tasks in the household like
switching lamps/shutters/heating/etc. and to log events like
temperature/humidity/power consumption. Visit the FHEM's homepage
<http://www.koeniglich.de/fhem/fhem.html> for more information.
The MBROLA project
Central to the MBROLA project is MBROLA, a speech synthesizer based on
the concatenation of diphones. It takes a list of phonemes as input,
together with prosodic information, and produces speech samples on 16
bits (linear), at the sampling frequency of the diphone database used.
This synthesizer is provided for free, for non commercial, non military
applications only. Visit the MBROLA's homepage
<http://tcts.fpms.ac.be/synthesis/> for more information.
Asterisk
Optionally fhem-speech supports AGI commands to communicate with
Asterisk. Visit the Asterisk(R) homepage <http://www.asterisk.org/> for
more information.
OPTIONS
Mandatory arguments to long options are mandatory for short options too.
Ordering Options:
-d, --device device
Run in FHEM mode. Specifies the FHEM device to be queried. The given
device must be defined.
-f, --file file-name
Run in file mode. fhem-speech will read the given file.
-t, --text "TEXT"
Run in Speaker's mode. fhem-speech will read the given "TEXT".
Other options:
-a, --asterisk
Run in Asterisk mode. fhem-speech print out AGI-commands for direct
usage in Asterisk.
-c, --cache directory
Specifies the location of where the files should be saved if
fhem-speech started with the -o or --out argument.
Default location: current directory.
--force
Overwrites existing files.
-h, --host host
Specifies the hostaddress for FHEM.
Default address: "localhost".
-o, --out [gsm|wav]
fhem-speech saves the output to a file with the specified output
format.
Default address: "localhost".
-p, --port port
Communicate with FHEM on defined port.
Default port: "7072".
--prefix prefix
Set the given prefix in front of filename.
-q, --quiet
Run in quiet mode.
--set state
Send <state> to device.
-S, --sex [f|m]
Specifies the sex for the voice. It depends on which voices for
MBROLA have been installed.
Default: "de3" for the German female voice and "de2" for the German
male voice.
-m, --man
Show the manual page and exits.
-H, --help
Show a brief help message and exits.
-V, --version
Show fhem-speech's version number and exit.
EXAMPLES
Get status information for device <EG.wz.HZ> in quiet mode:
`fhem-speech -d EG.wz.HZ -q`
Same as above with a male voice. FHEM runs on IP 192.168.1.100:
`fhem-speech -d EG.wz.HZ -S m -h 192.168.1.100`
Get status information for device <EG.wz.HZ> in Asterisk mode:
`fhem-speech -d EG.wz.HZ -a -q -o gsm -c /var/lib/asterisk/sounds/fhem/`
Read the file <foobar>:
`fhem-speech -f foobar`
Read the given text "Geht nicht gibt's nicht.":
`fhem-speech -t "Geht nicht gibt's nicht."`
Set the state for device <EG.wz.SD.01>:
`fhem-speech -d EG.wz.SD.01 --set on`
INSTALLATION
Requirements
MBROLA
You need MBROLA synthesizer, a synthesis voice, txt2pho and sox. For
more information visit:
o MBROLA project, <http://tcts.fpms.ac.be/synthesis/>
o hadifix, <http://www.ikp.uni-bonn.de/dt/forsch/phonetik/hadifix/>
FHEM
For FHEM mode you need FHEM 4.5+ and the command extension "jsonlist".
For more information take a look at:
<fhem_src_path>/contrib/JsonList/README.JsonList
or visit the FHEM's homepage:
<http://www.koeniglich.de/fhem/fhem.html>
JSON::XS
The required command extension "jsonlist" send the result as a JSON
encoded string. fhem-speech need the Perl module JSON::XS to decode the
information.
There are several ways to install the module:
You can download the last version at:
<http://search.cpan.org/~mlehmann/JSON-XS-2.231/XS.pm>
Or you can use the package from the contrib-folder which was delivered
with fhem-speech.
You can use the cpan command on bash-prompt.
Installation
This describes the installation on ubuntu:
Make a temporarily directory for the needed files and change to the new
directory, e.g.:
`mkdir /usr/local/src/mbrola; cd !$`
Download the required files:
`wget http://www.ikp.uni-bonn.de/dt/forsch/phonetik/hadifix/txt2pho.zip`
`wget http://tcts.fpms.ac.be/synthesis/mbrola/bin/pclinux/mbrola3.0.1h_i386.deb`
Download at least one synthesis voice (e.g. German female voice):
`wget http://tcts.fpms.ac.be/synthesis/mbrola/dba/de3/de3.zip`
txt2pho
Install txt2pho:
`unzip txt2pho.zip -d /usr/share/`
`chmod 755 /usr/share/txt2pho/txt2pho`
Edit txt2phorc:
`vi /usr/share/txt2pho/txt2phorc`
and change the path for DATAPATH and INVPATH:
DATAPATH=/usr/share/txt2pho/data/
INVPATH=/usr/share/txt2pho/data/
Copy txt2phorc to /etc/txt2pho:
`cp /usr/share/txt2pho/txt2phorc /etc/txt2pho`
Synthesis Voice
Install the synthesis voice (e.g. German female voice):
`unzip de7.zip -d /usr/share/mbrola/de7`
fhem-speech use "de2" and "de3" as default voices. You can change this
if you like.
MBROLA
Install MBROLA:
`dpkg -i mbrola3.0.1h_i386.deb`
sox
Install sox:
`apt-get install sox libsox-fmt-all`
Test
Test your installation:
`echo "Test" | /usr/share/txt2pho/txt2pho |\
mbrola /usr/share/mbrola/de7/de7 - -.au | play -q -t au -`
fhem-speech
Copy the script fhem-speech to a directory of your choice, e.g.:
`cp fhem-speech /usr/local/bin`
and make it executable:
`chmod 775 /usr/local/bin/fhem-speech`
Perl
If you use the delivered module contrib/JSON-XS-2.231.tar.gz:
`tar xzf JSON-XS-2.231.tar.gz`
`cd JSON-XS-2.231`
`perl Makefile.pl`
`make`
`make test`
and as root:
`make install`
CONFIGURATION
Open fhem-speech with your prefered editor.
FHEM host settings
Change the default host, if you like:
###########################
# FHEM
$sys{fhem}{host} = "localhost";
$sys{fhem}{port} = "7072";
External commands
Change the paths depending on the installed distribution:
###########################
# Mandatory external Files
$sys{file}{mbrola} = "/usr/local/bin/mbrola";
$sys{file}{pipefilt} = "/usr/local/bin/pipefilt";
$sys{file}{play} = "/usr/bin/play";
$sys{file}{preproc} = "/usr/local/bin/preproc";
[...]
Change the default settings for synthesis voice:
###########################
# mbrola / txt2pho options
$sys{speech}{sex} = "f";
$sys{speech}{male} = "-f0.8 -t0.9 -l 15000";
$sys{speech}{female} = "-f1.2 -t1.0 -l 22050";
Translation
fhem-speech need the $lang{} settings to decide what messages from FHEM
to be spoken. For example take a look at the FHT part:
###########################
# FHEM Translation
[...]
###########################
# FHT
# keys:
$lang{'actuator'} = "Ventilstellung: %s Prozent";
$lang{'day-temp'} = "Temperatur Tag: %s Grad";
$lang{'desired-temp'} = "Angeforderte Temperatur: %s Grad";
$lang{'measured-temp'} = "Gemessene Temperatur: %s Grad";
$lang{'mode'} = "Modus: %s";
$lang{'night-temp'} = "Temperatur Nacht: %s Grad";
$lang{'windowopen-temp'} = "Temperatur Fenster offen: %s Grad";
[...]
On every FHEM response all of the defined $lang{} status information
will be spoken. If you don't like status information for e.g.
'windowopen-temp' then comment this out:
# $lang{'windowopen-temp'} = "Temperatur Fenster offen: %s Grad";
If you like to know the status for e.g. 'lowtemp-offset' add a line like
this:
$lang{'lowtemp-offset'} = "Versatz Temperatur %s Grad";
The '%s' stands as a placeholder for the value.
OPTIONAL
Asterisk
fhem-speech support AGI commands for direct output in Asterisk.
Wrapper
If you like fhem-speech for use in Asterisk, you have to install a
wrapper around fhem-speech. You can use the example from
contrib/fhem-speech.agi.
Copy the wrapper to your asterisk-environment, e.g:
`cp contrib/fhem-speech.agi /var/lib/asterisk/agi-bin/`
extension.conf
Take a look at the example from contrib/extension.conf.
LEGALESE
License GPLv3+: GNU GPL version 3 or later
<http://gnu.org/licenses/gpl.html>.
This is free software: you are free to change and redistribute it. There
is NO WARRANTY, to the extent permitted by law.
AUTHOR
Copyright (C) 2008 Martin Fischer <m_fischer@gmx.de>

163
contrib/contrib/fhem2speech/extensions.conf Normal file
View File

@ -0,0 +1,163 @@
; extensions.conf - the Asterisk dial plan
;
[myHCE]
; houseautomation
exten => 5000,1(myhce),Answer()
exten => 5000,n,Set(TIMEOUT(digit)=5)
exten => 5000,n,Set(TIMEOUT(response)=10)
; skip authentication for known numbers
exten => 5000,n,GotoIf($["${CALLERID(num)}" = "01601234567"]?5000,main)
exten => 5000,n,GotoIf($["${CALLERID(num)}" = "01701234567"]?5000,main)
; authentication
exten => 5000,n,Authenticate(1137)
exten => 5000,n,Wait(1)
; main menu
exten => 5000,n(main),NoOp(Main Menu)
exten => 5000,n,Set(GLOBAL(myHCE_ext)=${EXTEN})
exten => 5000,n,Set(GLOBAL(myHCE_pExt)=5000)
exten => 5000,n,Set(GLOBAL(myHCE_pCon)=myHCE)
include => myHCE-default
exten => 5000,n(menu),AGI(fhem-speech.agi,t,"Hauptmenü")
exten => 5000,n(choice),AGI(fhem-speech.agi,t,"Bitte wählen Sie")
exten => 5000,n,AGI(fhem-speech.agi,t,"1 für Statusabfrage")
exten => 5000,n,AGI(fhem-speech.agi,t,"2 für Steuerung")
exten => 5000,n,AGI(fhem-speech.agi,t,"5 für Hilfe")
exten => 5000,n,Background(silence/3)
exten => 5000,n,Goto(choice)
; help
exten => 5000,n(help),AGI(fhem-speech.agi,t,"Menüsteuerung für alle Menüs")
exten => 5000,n,AGI(fhem-speech.agi,t,"8 zurück zum letzten Menü")
exten => 5000,n,AGI(fhem-speech.agi,t,"9 zurück zum Hauptmenü")
exten => 5000,n,AGI(fhem-speech.agi,t,"0 zum Beenden")
exten => 5000,n,Background(silence/3)
exten => 5000,n,Goto(menu)
; selection
exten => 1,1,Goto(myHCE-status,5100,status)
exten => 2,1,Goto(myHCE-control,5200,control)
exten => 5,1,Goto(5000,help)
[myHCE-default]
; global menu navigation
exten => 8,1,Goto(${myHCE_pCon},${myHCE_pExt},menu)
exten => 9,1,Goto(myHCE,5000,main)
exten => 0,1,Goto(myHCE-exit,5099,exit)
; wrong input
exten => i,1,AGI(fhem-speech.agi,t,"Falsche Eingabe.")
exten => i,2,Goto(${myHCE_ext},menu)
[myHCE-exit]
; exit
exten => 5099,n(exit),AGI(fhem-speech.agi,t,"Verbindung wird getrennt. Vielen Dank!")
exten => 5099,n,Hangup()
[myHCE-status]
exten => 5100,1(status),NoOp(Status Menu)
exten => 5100,n,Set(GLOBAL(myHCE_ext)=${EXTEN})
exten => 5100,n,Set(GLOBAL(myHCE_pExt)=5000)
exten => 5100,n,Set(GLOBAL(myHCE_pCon)=myHCE)
include => myHCE-default
; submenu device status
exten => 5100,n(menu),AGI(fhem-speech.agi,t,"Menü Statusabfrage")
exten => 5100,n(choice),AGI(fhem-speech.agi,t,"Bitte wählen Sie")
exten => 5100,n,AGI(fhem-speech.agi,t,"1 für Wetterstation")
exten => 5100,n,AGI(fhem-speech.agi,t,"2 für Rauchmelder")
exten => 5100,n,AGI(fhem-speech.agi,t,"5 für Raumthermostate")
exten => 5100,n,Background(silence/3)
exten => 5100,n,Goto(choice)
; selection
exten => 1,1,Playback(beep)
exten => 1,n,AGI(fhem-speech.agi,d,GH.ga.WE.01)
exten => 1,n,Playback(beep)
exten => 1,n,Goto(5100,status)
exten => 2,1,Playback(beep)
exten => 2,n,AGI(fhem-speech.agi,d,NN.xx.RM.01)
exten => 2,n,Playback(beep)
exten => 2,n,Goto(5100,status)
exten => 5,1,Goto(myHCE-status_fht,5110,menu)
[myHCE-status_fht]
exten => 5110,1(status),NoOp(Status Menu)
exten => 5110,n,Set(GLOBAL(myHCE_ext)=${EXTEN})
exten => 5110,n,Set(GLOBAL(myHCE_pExt)=5100)
exten => 5110,n,Set(GLOBAL(myHCE_pCon)=myHCE-status)
include => myHCE-default
; submenu fht devices
exten => 5110,n(menu),AGI(fhem-speech.agi,t,"Menü Raumthermostate")
exten => 5110,n(choice),AGI(fhem-speech.agi,t,"Bitte wählen Sie")
exten => 5110,n,AGI(fhem-speech.agi,t,"1 für Wohnzimmer")
exten => 5110,n,AGI(fhem-speech.agi,t,"2 für Schlafzimmer")
exten => 5110,n,AGI(fhem-speech.agi,t,"3 für Büro")
exten => 5110,n,AGI(fhem-speech.agi,t,"4 für Badezimmer")
exten => 5110,n,Background(silence/3)
exten => 5110,n,Goto(choice)
; selection
exten => 1,1,Playback(beep)
exten => 1,n,AGI(fhem-speech.agi,d,EG.wz.HZ)
exten => 1,n,Playback(beep)
exten => 1,n,Goto(5110,status)
exten => 2,1,Playback(beep)
exten => 2,n,AGI(fhem-speech.agi,d,EG.sz.HZ)
exten => 2,n,Playback(beep)
exten => 2,n,Goto(5110,status)
exten => 3,1,Playback(beep)
exten => 3,n,AGI(fhem-speech.agi,d,EG.bu.HZ)
exten => 3,n,Playback(beep)
exten => 3,n,Goto(5110,status)
exten => 4,1,Playback(beep)
exten => 4,n,AGI(fhem-speech.agi,d,EG.bz.HZ)
exten => 4,n,Playback(beep)
exten => 4,n,Goto(5110,status)
[myHCE-control]
include => myHCE-default
exten => 5200,1(control),AGI(fhem-speech.agi,t,"Menü Steuerung")
exten => 5200,n(menu),AGI(fhem-speech.agi,t,"Bitte wählen Sie")
exten => 5200,n,AGI(fhem-speech.agi,t,"1 für Wohnzimmer")
exten => 5200,n,AGI(fhem-speech.agi,t,"2 für Schlafzimmer")
exten => 5200,n,AGI(fhem-speech.agi,t,"3 für Büro")
exten => 5200,n,AGI(fhem-speech.agi,t,"4 für Badezimmer")
exten => 5200,n,Background(silence/3)
exten => 5200,n,Goto(menu)
exten => 1,1,Goto(myHCE-control_wohnen,5210,menu)
exten => i,1,AGI(fhem-speech.agi,t,"Falsche Eingabe.")
exten => i,2,Goto(5200,menu)
[myHCE-control_wohnen]
include => myHCE-default
exten => 5210,1(control),AGI(fhem-speech.agi,t,"Menü Steuerung")
exten => 5210,n,AGI(fhem-speech.agi,t,"Wohnzimmer")
exten => 5210,n(menu),AGI(fhem-speech.agi,t,"Bitte wählen Sie")
exten => 5210,n,AGI(fhem-speech.agi,t,"1 für Lampen")
exten => 5210,n,Background(silence/3)
exten => 5210,n,Goto(menu)
exten => 1,1,Goto(myHCE-control_wohnen-lampen,5211,set)
exten => 8,1,Goto(myHCE-control,5200,menu)
exten => i,1,AGI(fhem-speech.agi,t,"Falsche Eingabe.")
exten => i,2,Goto(5200,menu)
[myHCE-control_wohnen-lampen]
include => myHCE-default
exten => 5211,1(set),AGI(fhem-speech.agi,t,"Steuerung Lampen")
exten => 5211,n,AGI(fhem-speech.agi,d,EG.wz.SD.Licht.grp)
exten => 5211,n(menu),AGI(fhem-speech.agi,t,"1 für an")
exten => 5211,n,AGI(fhem-speech.agi,t,"2 für aus")
exten => 5211,n,Background(silence/3)
exten => 5211,n,Goto(menu)
exten => 1,1,AGI(fhem-speech.agi,s,EG.wz.SD.Licht.grp,on)
exten => 1,n,Goto(5211,set)
exten => 2,1,AGI(fhem-speech.agi,s,EG.wz.SD.Licht.grp,off)
exten => 2,n,Goto(5211,set)
exten => 8,1,Goto(myHCE-control_wohnen,5210,menu)
exten => i,1,AGI(fhem-speech.agi,t,"Falsche Eingabe.")
exten => i,2,Goto(5211,menu)

1169
contrib/contrib/fhem2speech/fhem-speech Executable file
View File

File diff suppressed because it is too large Load Diff

55
contrib/contrib/fhem2speech/fhem-speech.agi Executable file
View File

@ -0,0 +1,55 @@
#!/usr/bin/perl
################################################################
#
# $Id: fhem-speech.agi,v 1.1 2009-01-12 10:26:50 rudolfkoenig Exp $
#
use strict;
$|=1;
# Setup some variables
my $sounds = "/var/lib/asterisk/sounds/fhem/";
my %AGI;
my $tests = 0;
my $fail = 0;
my $pass = 0;
while(<STDIN>) {
chomp;
last unless length($_);
if (/^agi_(\w+)\:\s+(.*)$/) {
$AGI{$1} = $2;
}
}
print STDERR "AGI Environment Dump:\n";
foreach my $i (sort keys %AGI) {
print STDERR " -- $i = $AGI{$i}\n";
}
sub checkresult {
my ($res) = @_;
my $retval;
$tests++;
chomp $res;
if ($res =~ /^200/) {
$res =~ /result=(-?\d+)/;
if (!length($1)) {
print STDERR "FAIL ($res)\n";
$fail++;
} else {
print STDERR "PASS ($1)\n";
$pass++;
}
} else {
print STDERR "FAIL (unexpected result '$res')\n";
$fail++;
}
}
system("fhem-speech -d $ARGV[1] -a -q -o gsm -c $sounds") if ($ARGV[0] eq "d");
system("fhem-speech -t $ARGV[1] -a -q -o gsm -c $sounds") if ($ARGV[0] eq "t");
system("fhem-speech -d $ARGV[1] --set $ARGV[2]") if ($ARGV[0] eq "s");

183
contrib/contrib/fhemupdate.pl Executable file
View File

@ -0,0 +1,183 @@
#!/usr/bin/perl
# Server-Side script to check out the fhem SVN repository, and upload the
# changed files to the server
$ENV{CVS_RSH}="/usr/bin/ssh";
print "\n\n";
print localtime() . "\n";
#my $homedir="/Users/rudi/Projects/fhem/fhemupdate";
my $homedir="/home/rudi/fhemupdate";
#goto NEWSTYLE;
chdir("$homedir/culfw");
system("svn update .");
chdir("$homedir/fhem");
system("mkdir -p UPLOAD");
system("svn update .");
die "SVN failed, exiting\n" if($?);
my $ndiff = `diff fhem.pl fhem.pl.txt | wc -l`;
if($ndiff != 4) { # more than the standard stuff is different
print "Modifying fhem.pl: >$ndiff<\n";
system('perl -p -e "s/=DATE=/"`date +"%Y-%m-%d"`"/;'.
's/=VERS=/"`grep ^VERS= Makefile | '.
'sed -e s/VERS=//`"+SVN/" fhem.pl > fhem.pl.txt');
}
#################################
# Old style
my @filelist = (
"./fhem.pl.txt",
"FHEM/.*.pm",
"webfrontend/pgm2/.*",
"docs/commandref.html",
"docs/faq.html",
"docs/HOWTO.html",
"docs/fhem.*.png",
"docs/.*.jpg",
"../culfw/Devices/CUL/.*.hex",
);
# Read in the file timestamps
my %filetime;
my %filesize;
my %filedir;
foreach my $fspec (@filelist) {
$fspec =~ m,^(.+)/([^/]+)$,;
my ($dir,$pattern) = ($1, $2);
opendir DH, $dir || die("Can't open $dir: $!\n");
foreach my $file (grep { /$pattern/ && -f "$dir/$_" } readdir(DH)) {
my @st = stat("$dir/$file");
my @mt = localtime($st[9]);
$filetime{$file} = sprintf "%04d-%02d-%02d_%02d:%02d:%02d",
$mt[5]+1900, $mt[4]+1, $mt[3], $mt[2], $mt[1], $mt[0];
$filesize{$file} = $st[7];
$filedir{$file} = $dir;
}
closedir(DH);
}
my %oldtime;
if(open FH, "UPLOAD/filetimes.txt") {
while(my $l = <FH>) {
chomp($l);
my ($ts, $fs, $file) = split(" ", $l, 3);
$oldtime{"$file.txt"} = $ts if($file eq "fhem.pl");
$oldtime{$file} = $ts;
}
close(FH);
}
chdir("$homedir/fhem/UPLOAD");
open FH, ">filetimes.txt" || die "Can't open filetimes.txt: $!\n";
open FTP, ">script.txt" || die "Can't open script.txt: $!\n";
print FTP "cd fhem/fhemupdate\n";
print FTP "put filetimes.txt\n";
print FTP "pas\n"; # Without passive only 28 files can be transferred
my $cnt;
foreach my $f (sort keys %filetime) {
my $fn = $f;
$fn =~ s/.txt$// if($fn =~ m/.pl.txt$/);
print FH "$filetime{$f} $filesize{$f} $fn\n";
my $newfname = $f;
if(!$oldtime{$f} || $oldtime{$f} ne $filetime{$f}) {
print FTP "put $f\n";
system("cp ../$filedir{$f}/$f $f");
$cnt++;
}
}
close FH;
close FTP;
if($cnt) {
print "FTP Upload needed for $cnt files\n";
system("ftp -e fhem.de < script.txt");
}
NEWSTYLE:
#################################
# new Style
chdir("$homedir/fhem");
my $uploaddir2="UPLOAD2";
system("mkdir -p $uploaddir2");
my %filelist2 = (
"./fhem.pl.txt" => ".",
"FHEM/.*.pm" => "FHEM",
"../culfw/Devices/CUL/.*.hex" => "FHEM",
"webfrontend/pgm2/.*" => "www/pgm2",
"docs/commandref.html" => "www/pgm2",
"docs/faq.html" => "www/pgm2",
"docs/HOWTO.html" => "www/pgm2",
"docs/fhem.*.png" => "www/pgm2",
"docs/.*.jpg" => "www/pgm2",
);
# Read in the file timestamps
my %filetime2;
my %filesize2;
my %filedir2;
chdir("$homedir/fhem");
foreach my $fspec (keys %filelist2) {
$fspec =~ m,^(.+)/([^/]+)$,;
my ($dir,$pattern) = ($1, $2);
my $tdir = $filelist2{$fspec};
opendir DH, $dir || die("Can't open $dir: $!\n");
foreach my $file (grep { /$pattern/ && -f "$dir/$_" } readdir(DH)) {
my @st = stat("$dir/$file");
my @mt = localtime($st[9]);
$filetime2{"$tdir/$file"} = sprintf "%04d-%02d-%02d_%02d:%02d:%02d",
$mt[5]+1900, $mt[4]+1, $mt[3], $mt[2], $mt[1], $mt[0];
$filesize2{"$tdir/$file"} = $st[7];
$filedir2{"$tdir/$file"} = $dir;
}
closedir(DH);
}
chdir("$homedir/fhem/$uploaddir2");
my %oldtime;
if(open FH, "filetimes.txt") {
while(my $l = <FH>) {
chomp($l);
my ($ts, $fs, $file) = split(" ", $l, 3);
$oldtime{"$file.txt"} = $ts if($file =~ m/fhem.pl/);
$oldtime{$file} = $ts;
}
close(FH);
}
open FH, ">filetimes.txt" || die "Can't open filetimes.txt: $!\n";
open FTP, ">script.txt" || die "Can't open script.txt: $!\n";
print FTP "cd fhem/fhemupdate2\n";
print FTP "put filetimes.txt\n";
print FTP "pas\n"; # Without passive only 28 files can be transferred
my $cnt;
foreach my $f (sort keys %filetime2) {
my $fn = $f;
$fn =~ s/.txt$// if($fn =~ m/.pl.txt$/);
print FH "$filetime2{$f} $filesize2{$f} $fn\n";
my $newfname = $f;
if(!$oldtime{$f} || $oldtime{$f} ne $filetime2{$f}) {
$f =~ m,^(.*)/([^/]*)$,;
my ($tdir, $file) = ($1, $2);
system("mkdir -p $tdir") unless(-d $tdir);
print FTP "put $tdir/$file $tdir/$file\n";
system("cp ../$filedir2{$f}/$file $tdir/$file");
$cnt++;
}
}
close FH;
close FTP;
if($cnt) {
print "FTP Upload needed for $cnt files\n";
system("ftp -e fhem.de < script.txt");
}

34
contrib/contrib/fht.gnuplot Normal file
View File

@ -0,0 +1,34 @@
############################
# Display the measured temperature and actuator data logged
# as described in the 04_log config file.
# Copy your logfile to fht.log and then call
# gnuplot fht.gnuplot
# (i.e. this file)
# Note: The webfrontend pgm2 and pgm3 does this for you.
# More examples can be found in the webfrontend/pgm2 directory.
###########################
# Uncomment the following if you want to create a postscript file
# and comment out the pause at the end
#set terminal postscript color "Helvetica" 11
#set output 'fht.ps'
set xdata time
set timefmt "%Y-%m-%d_%H:%M:%S"
set xlabel " "
set ylabel "Temperature (Celsius)"
set y2label "Actuator (%)"
set ytics nomirror
set y2tics
set y2label "Actuator (%)"
set title 'FHT log'
plot \
"< awk '/measured/{print $1, $4}' fht.log"\
using 1:2 axes x1y1 title 'Measured temperature' with lines,\
"< awk '/actuator/{print $1, $4+0}' fht.log"\
using 1:2 axes x1y2 title 'Actuator (%)' with lines\
pause 100000

6
contrib/contrib/four2hex/Makefile Normal file
View File

@ -0,0 +1,6 @@
CC=gcc
four2hex : four2hex.c
install : four2hex
install -m 0755 four2hex /usr/local/bin/four2hex

23
contrib/contrib/four2hex/README Normal file
View File

@ -0,0 +1,23 @@
Four2hex was written to convert the housecode based on digits ranging from 1
to 4 into hex code and vica versa.
Four2hex is freeware based on the GNU Public license.
To built it:
$ make four2hex
Install it to /usr/local/bin:
$ su
# make install
Here an example from "four"-based to hex:
$ four2hex 12341234
1b1b
Here an example in the other (reverse) direction:
$ four2hex -r 1b1b
12341234
Enjoy.
Peter Stark, (Peter dot stark at t-online dot de)

94
contrib/contrib/four2hex/four2hex.c Normal file
View File

@ -0,0 +1,94 @@
/*
Four2hex was written to convert the housecode based on digits ranging from 1
to 4 into hex code and vica versa.
Four2hex is freeware based on the GNU Public license.
To built it:
$ make four2hex
Install it to /usr/local/bin:
$ su
# make install
Here an example from "four"-based to hex:
$ four2hex 12341234
1b1b
Here an example in the other (reverse) direction:
$ four2hex -r 1b1b
12341234
Enjoy.
Peter Stark, (Peter dot stark at t-online dot de)
*/
#include <stdio.h>
#include <ctype.h>
int atoh (const char c)
{
int ret=0;
ret = (int) (c - '0');
if (ret > 9) {
ret = (int) (c - 'a' + 10);
}
return ret;
}
int strlen(const char *);
main (int argc, char **argv)
{
char c, *s, *four;
long int result;
int b, i, h;
if (argc < 2 || argc >3) {
fprintf (stderr, "usage: four2hex four-string\n");
fprintf (stderr, " or: four2hex -r hex-string\n");
return (1);
}
result = 0L;
if (strcmp(argv[1], "-r") == 0) {
/* reverse (hex->4) */
for (s = argv[2]; *s != '\0'; s++) {
c = tolower(*s);
b = atoh(c);
for (i = 0; i < 2; i++) {
h = ((b & 0xc) >> 2) + 1;
b = (b & 0x3) << 2;
printf ("%d", h);
}
}
printf ("\n");
} else {
/* normal (4->hex) */
four = argv[1];
if (strlen(four) == 4 || strlen(four) == 8) {
for (s = four; *s != '\0'; s++) {
result = result << 2;
switch (*s) {
case '1' : result = result + 0; break;
case '2' : result = result + 1; break;
case '3' : result = result + 2; break;
case '4' : result = result + 3; break;
default :
fprintf (stderr, "four-string may contain '1' to '4' only\n");
break;
}
}
if (strlen(four) == 8) {
printf ("%04x\n", result);
} else {
printf ("%02x\n", result);
}
} else {
fprintf (stderr, "four-string must be of length 4 or 8\n");
return (1);
}
}
return (0);
}

94
contrib/contrib/fs20_holidays.sh Executable file
View File

@ -0,0 +1,94 @@
#!/bin/bash
#
# script to generate a random number of on/off events to simulate presence eg.
# while on holidays. normally this script would be executed by an event like a
# dawn-sensor (you wouldn't want light during the day...:-)
#
# Copyright STefan Mayer <stefan@clumsy.ch>
################## configuration ###########################
#number of events (min - max)
event_min=5
event_max=20
#maximum delay in minutes
delay_max=240
#minimum and maximum ontime in minutes
ontime_min=5
ontime_max=60
#devices to consider
declare -a devices='("dg.gang" "dg.wand" "dg.dusche" "dg.bad" "dg.reduit")'
#output variant [oft|onoff]
#oft: use one at with on-for-timer of system
#onoff: use two at, one for on one for off
variant="onoff"
#command to execute
#command_start="/opt/fhem/fhem.pl 7072 \""
command_start="echo /opt/fhem/fhem.pl 7072 \""
command_end="\""
##################### Shouldnt need any changes below here #####################
# count number of devices
count=0
for i in ${devices[*]}
do
((count++))
done
# echo $count
# maximum random in bash: 32768
random_max=32768
#number of events
event=$(($RANDOM * (($event_max - $event_min)) / $random_max +$event_min))
#initialize command
command=$command_start
for ((i=0; i<$event; i++))
do
#calculate starttime
starttime=$(($RANDOM * $delay_max / $random_max))
hour=$(($starttime / 60))
minute=$(($starttime % 60))
second=$(($RANDOM * 60 / $random_max))
#calculate ontime
ontime=$(($RANDOM * (($ontime_max - $ontime_min)) / $random_max +$ontime_min))
#choose device
dev=$(($RANDOM * $count / $random_max))
case $variant in
oft)
printf "event %02d: define at.random.%02d at +%02d:%02d:%02d set %s on-for-timer %d\n" $i $i $hour $minute $second ${devices[$dev]} $ontime
command=`printf "$command define at.random.%02d at +%02d:%02d:%02d set %s on-for-timer %d;;" $i $hour $minute $second ${devices[$dev]} $ontime`
;;
onoff)
offtime=$(($starttime + $ontime))
hour_off=$(($offtime / 60))
minute_off=$(($offtime % 60))
second_off=$(($RANDOM * 60 / $random_max))
printf "event %02d/on : define at.random.on.%02d at +%02d:%02d:%02d set %s on\n" $i $i $hour $minute $second ${devices[$dev]}
printf "event %02d/off: define at.random.off.%02d at +%02d:%02d:%02d set %s off\n" $i $i $hour_off $minute_off $second_off ${devices[$dev]}
command=`printf "$command define at.random.on.%02d at +%02d:%02d:%02d set %s on;;" $i $hour $minute $second ${devices[$dev]}`
command=`printf "$command define at.random.off.%02d at +%02d:%02d:%02d set %s off;;" $i $hour_off $minute_off $second_off ${devices[$dev]}`
;;
*)
echo "no variant specifieno variant specified!!"
;;
esac
done
command="$command $command_end"
#execute command
eval "$command"

212
contrib/contrib/garden.pl Executable file
View File

@ -0,0 +1,212 @@
#!/usr/bin/perl
use warnings;
use strict;
use IO::Socket::INET;
use IO::Handle;
STDOUT->autoflush(1);
#################
# Formula:
# Compute for the last <navg> days + today the avarage temperature and the
# sum of rain, then compute the multiplier: (temp/20)^2 - rain/5
# Now multiply the duration of each vent with this multiplier
# If the value is less than a minimum, then store the value and add it
# the next day
#################
my $test = 0; # Test only, do not switch anything
my $fhzport = 7072; # Where to contact it
my $avg = "/home/rudi/log/avg.log"; # KS300 avarage log file
my $navg = 2; # Number of last avg_days to consider
my $min = 300; # If the duration is < min (sec) then collect
my $col = "/home/rudi/log/gardencoll.log"; # File where it will be collected
my $pmp = "GPumpe"; # Name of the water pump, will be switched in first
my $maxmult = 4; # Maximum factor (corresponds to 40 degree avg.
# temp over $navg days, no rain)
if(@ARGV) {
if($ARGV[0] eq "test") {
$test = 1;
} else {
print "Usage: garden.pl [test]\n";
exit(1);
}
}
my %list = (
GVent1 => { Nr => 1, Dur => 720 },
GVent2 => { Nr => 2, Dur => 480 },
GVent3 => { Nr => 3, Dur => 720 },
GVent4 => { Nr => 4, Dur => 720 },
GVent6 => { Nr => 5, Dur => 720 },
GVent7 => { Nr => 6, Dur => 480 },
GVent8 => { Nr => 7, Dur => 480 },
);
##############################
# End of config
sub fhzcommand($);
sub doswitch($$);
sub donext($$);
my ($nlines, $temp, $rain) = (0, 0, 0);
my ($KS300name, $server, $last);
my @t = localtime;
printf("%04d-%02d-%02d %02d:%02d:%02d\n",
$t[5]+1900, $t[4]+1, $t[3], $t[2], $t[1], $t[0]);
###########################
# First read in the last avg_days
open(FH, $avg) || die("$avg: $!\n");
my @avg = <FH>;
close(FH);
my @tarr; # Want the printout in the right order
while(my $l = pop(@avg)) {
next if($l !~ m/avg_day/);
my @v = split(" ", $l);
push(@tarr, "$v[0]: T: $v[4], R: $v[10]") if($test);
$temp += $v[4]; $rain += $v[10];
$KS300name = $v[1];
$nlines++;
last if($nlines >= $navg);
}
###########################
# Now get the current day
foreach my $l (split("\n", fhzcommand("list $KS300name"))) {
next if($l !~ m/avg_day/);
my @v = split(" ", $l);
print("$v[0] $v[1]: T: $v[4], R: $v[10]\n") if($test);
$temp += $v[4]; $rain += $v[10];
$nlines++;
last;
}
if($test) {
foreach my $l (@tarr) {
print "$l\n";
}
}
###########################
# the collected data
my %coll;
if(open(FH, $col)) {
while(my $l = <FH>) {
my ($k, $v) = split("[ \n]", $l);
$coll{$k} = $v;
}
close(FH);
}
###########################
# The formula
$temp /= $nlines;
$rain /= $nlines;
# safety measures
$rain = 0 if($rain < 0);
$temp = 0 if($temp < 0);
$temp = 40 if($temp > 40);
my $mult = exp( 2.0 * log( $temp / 20 )) - $rain/5;
$mult = $maxmult if($mult > $maxmult);
if($mult <= 0) {
print("Multiplier is not positive ($mult), exiting\n");
exit(0);
}
printf("Multiplier is %.2f (T: $temp, R: $rain)\n", $mult, $temp, $rain);
my $have = 0;
if(!$test) {
open(FH, ">$col") || die("Can't open $col: $!\n");
}
foreach my $a (sort { $list{$a}{Nr} <=> $list{$b}{Nr} } keys %list) {
my $dur = int($list{$a}{Dur} * $mult);
if(defined($coll{$a})) {
$dur += $coll{$a};
printf(" $a: $dur ($coll{$a})\n");
} else {
printf(" $a: $dur\n");
}
if($dur > $min) {
$list{$a}{Act} = $dur;
$have += $dur;
} else {
print FH "$a $dur\n" if(!$test);
}
}
print("Total time is $have\n");
exit(0) if($test);
close(FH);
if($have) {
doswitch($pmp, "on") if($pmp);
sleep(3) if(!$test);
foreach my $a (sort { $list{$a}{Nr} <=> $list{$b}{Nr} } keys %list) {
next if(!$list{$a}{Act});
donext($a, $list{$a}{Act});
}
donext("", 0);
doswitch($pmp, "off") if($pmp);
}
###########################
# Switch the next dev on and the last one off
sub
donext($$)
{
my ($dev, $sl) = @_;
doswitch($dev, "on");
doswitch($last, "off");
$last = $dev;
if($test) {
print "sleeping $sl\n";
} else {
sleep($sl);
}
}
###########################
# Paranoid setting.
sub
doswitch($$)
{
my ($dev, $how) = @_;
return if(!$dev || !$how);
if($test) {
print "set $dev $how\n";
return;
}
fhzcommand("set $dev $how");
sleep(1);
fhzcommand("set $dev $how");
}
###########################
sub
fhzcommand($)
{
my $cmd = shift;
my ($ret, $buf) = ("", "");
$server = IO::Socket::INET->new(PeerAddr => "localhost:$fhzport");
die "Can't connect to the server at port $fhzport\n" if(!$server);
syswrite($server, "$cmd;quit\n");
while(sysread($server, $buf, 256) > 0) {
$ret .= $buf;
}
close($server);
return $ret;
}

139
contrib/contrib/getstate/99_getstate.pm Normal file
View File

@ -0,0 +1,139 @@
################################################################
#
# $Id: 99_getstate.pm,v 1.3 2009-12-16 16:46:00 m_fischer Exp $
#
# Copyright notice
#
# (c) 2008 Copyright: Martin Fischer (m_fischer at gmx dot de)
# All rights reserved
#
# This script 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.
#
# The GNU General Public License can be found at
# http://www.gnu.org/copyleft/gpl.html.
# A copy is found in the textfile GPL.txt and important notices to the license
# from the author is found in LICENSE.txt distributed with these scripts.
#
# This script 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.
#
################################################################
package main;
use strict;
use warnings;
use POSIX;
sub CommandGetState($);
sub stringToNumber($);
sub stripNumber($);
sub isNumber;
sub isInteger;
sub isFloat;
#####################################
sub
GetState_Initialize($$)
{
my %lhash = ( Fn=>"CommandGetState",
Hlp=>"<devspec>,list short status info" );
$cmds{getstate} = \%lhash;
}
#####################################
sub
CommandGetState($)
{
my ($cl, $param) = @_;
return "Usage: getstate <devspec>" if(!$param);
my $str;
my $sdev = $param;
if(!defined($defs{$sdev})) {
$str = "Please define $sdev first";
} else {
my $r = $defs{$sdev}{READINGS};
my $val;
my $v;
if($r && $defs{$sdev}{TYPE} ne "CUL_WS") {
foreach my $c (sort keys %{$r}) {
undef($v);
$val = $r->{$c}{VAL};
$val =~ s/\s+$//g;
$val = stringToNumber($val);
$val = stripNumber($val);
$v = $val if (isNumber($val) && !$v);
$v = $val if (isInteger($val) && !$v);
$v = $val if (isFloat($val) && !$v);
$c =~ s/:/-/g;
$str .= sprintf("%s:%s ",$c,$v) if(defined($v));
}
}
if ($r && $defs{$sdev}{TYPE} eq "CUL_WS") {
$v = $defs{$sdev}{READINGS}{state}{VAL};
$v =~ s/:\s+/:/g;
$v =~ s/\s+/ /g;
$str = $v;
}
}
return $str;
}
#####################################
sub stringToNumber($)
{
my $s = shift;
$s = "0" if($s =~ m/^(off|no \(yes\/no\))$/);
$s = "1" if($s =~ m/^(on|yes \(yes\/no\))$/);
return $s;
}
#####################################
sub stripNumber($)
{
my $s = shift;
my @strip = (" (Celsius)", " (l/m2)", " (counter)", " (%)", " (km/h)" , "%");
foreach my $pattern (@strip) {
$s =~ s/\Q$pattern\E//gi;
}
return $s;
}
#####################################
sub isNumber
{
$_[0] =~ /^\d+$/
}
#####################################
sub isInteger
{
$_[0] =~ /^[+-]?\d+$/
}
#####################################
sub isFloat
{
$_[0] =~ /^[+-]?\d+\.?\d*$/
}
1;

50
contrib/contrib/getstate/README.getstate Normal file
View File

@ -0,0 +1,50 @@
NAME
getstate.pm - Copyright (c)2008 Martin Fischer <m_fischer@gmx.de>
SYNOPSIS
getstate <devspec>
DESCRIPTION
The module getstate.pm extends FHEM to support a short status output of
a device. It is useful for monitoring the device in e.g. Cacti.
INSTALLATION
Copy the script 99_getstate.pm to FHEM modules directory, e.g.
'cp 99_getstate.pm /usr/share/fhem/FHEM'
and restart FHEM.
EXAMPLES
Output a short string of the "READINGS" for <devspec>.
Example for a FS20-Device:
fhem> getstate EG.sz.SD.Tv
state:0
Example for a FHT-Device:
fhem> getstate EG.wz.HZ
actuator:0 day-temp:21.5 desired-temp:21.5 lowtemp-offset:4.0 [...]
Example for a KS300/555-Device:
fhem> getstate GH.ga.WE.01
humidity:93 israining:0 rain:207.8 rain_raw:815 temperature:5.1 [...]
Example for a HMS-Device:
fhem> getstate NN.xx.RM.01
smoke_detect:0
CONTRIB
You can use the example script contrib/fhem-getstate as a "Data Input
Method" for your Cacti graphs.
LEGALESE
License GPLv3+: GNU GPL version 3 or later
<http://gnu.org/licenses/gpl.html>.
This is free software: you are free to change and redistribute it. There
is NO WARRANTY, to the extent permitted by law.
AUTHOR
Copyright (C) 2008 Martin Fischer <m_fischer@gmx.de>

91
contrib/contrib/getstate/fhem-getstate Executable file
View File

@ -0,0 +1,91 @@
#!/bin/bash
#
# $Id: fhem-getstate,v 1.2 2009-01-12 09:21:53 rudolfkoenig Exp $
#
# Copyright notice
#
# (c) 2008 Copyright: Martin Fischer (m_fischer at gmx dot de)
# All rights reserved
#
# This script 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.
#
# The GNU General Public License can be found at
# http://www.gnu.org/copyleft/gpl.html.
# A copy is found in the textfile GPL.txt and important notices to the license
# from the author is found in LICENSE.txt distributed with these scripts.
#
# This script 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.
#
################################################################
NCAT=`which netcat`
HOST="localhost"
PORT="7072"
VERS="$Revision: 1.2 $"
# Functions
function version {
echo "fhem-getstate, Version$VERS
Copyright (C) 2008 Martin Fischer <m_fischer@gmx.de>
License GPLv3+: GNU GPL version 3 or later <http://gnu.org/licenses/gpl.html>
This is free software: you are free to change and redistribute it.
There is NO WARRANTY, to the extent permitted by law.
Written by Martin Fischer"
exit $1
}
function longhelp {
echo "\
Usage: fhem-getstate [OPTION] DEVICE
Connect to a FHEM-Server running on 'localhost 7072' and print the status for
the given DEVICE as a space seperated list for use in e.g. Cacti.
Mandatory arguments:
-d DEVICE print the status for DEVICE as defined in FHEM
Optional:
-s SERVER Resolvable Hostname or IP address of FHEM (default: localhost)
-p PORT Listening Port of FHEM (default: 7072)
-q quiet mode
-h show this help
-v show version
Reports bugs to <m_fischer@gmx.de>.
"
exit $1
}
function usage {
echo >&2 "Usage: fhem-getstate [-s <server>] [-p <port>] -d <devspec> [-h] [-v]" && exit $1;
}
# check for arguments
if (( $# <= 0 )); then
usage 1;
fi
# get options
while getopts "s:p:d:hv" option; do
case $option in
d) DEV=$OPTARG;;
h) longhelp 0;;
p) PORT=$OPTARG;;
s) HOST="$OPTARG";;
v) version 0;;
?) usage 1;;
esac
done
(echo "getstate ${DEV}" | $NCAT -w1 ${HOST} ${PORT})
exit 0;

16
contrib/contrib/gplotmapping.txt Normal file
View File

@ -0,0 +1,16 @@
fhem <= 5.1 fhem >= 5.2
=====================================================
ks300_3.gplot -> dayAvgTemp5rain11.gplot
ks300_2.gplot -> hum6wind8.gplot
ks300_4.gplot -> monthAvgTemp5Rain11.gplot
em.gplot -> power4.gplot
cul_em.gplot -> power8.gplot
cul_emem.gplot -> power8top10.gplot
oregon_rain.gplot -> rain4.gplot
oregon_temp_press.gplot -> rain4press4.gplot
hms_t.gplot -> temp4.gplot
hms.gplot -> temp4hum6.gplot
ks300.gplot -> temp4rain10.gplot
oregon_wind.gplot -> wind4windDir4.gplot

14
contrib/contrib/he.holiday Normal file
View File

@ -0,0 +1,14 @@
# Siehe auch
# http://de.wikipedia.org/wiki/Feiertage_in_Deutschland
1 01-01 Neujahr
1 05-01 Tag der Arbeit
1 10-03 Tag der deutschen Einheit
1 12-25 1. Weihnachtstag
1 12-26 2. Weihnachtstag
2 -2 Karfreitag
2 1 Ostermontag
2 39 Christi Himmelfahrt
2 50 Pfingsten
2 60 Fronleichnam

46
contrib/contrib/init-scripts/fhem.1 Executable file
View File

@ -0,0 +1,46 @@
#! /bin/sh -e
#
#
#
# Written by Stefan Manteuffel
PATH=/bin:/usr/bin:/sbin:/usr/sbin:/usr/local/bin
DAEMON=/usr/bin/fhem.pl
PIDFILE=/var/run/fhem.pid
# Arguments to atd
#
ARGS="/etc/fhem.cfg"
test -x $DAEMON || exit 0
. /lib/lsb/init-functions
case "$1" in
start)
echo "Starting deferred execution scheduler..."
start-stop-daemon -b --start --quiet --pidfile $PIDFILE --startas $DAEMON -- $ARGS
log_end_msg $?
;;
stop)
log_begin_msg "Stopping deferred execution scheduler..."
start-stop-daemon --oknodo --stop --quiet --retry 30 --pidfile $PIDFILE --name fhem.pl
log_end_msg $?
;;
force-reload|restart)
log_begin_msg "Restarting deferred execution scheduler..."
if start-stop-daemon --stop --quiet --retry 30 --pidfile $PIDFILE --name fhem.pl; then
start-stop-daemon -b --start --quiet --pidfile $PIDFILE --startas $DAEMON -- $ARGS
log_end_msg $?
else
log_end_msg 1
fi
;;
*)
echo "Usage: /etc/init.d/fhem.pl {start|stop|restart|force-reload|reload}"
exit 1
;;
esac
exit 0

25
contrib/contrib/init-scripts/fhem.2 Executable file
View File

@ -0,0 +1,25 @@
#!/bin/sh
# by Matthias Bauer
case "$1" in
start)
echo "Starting $0"
fhem.pl /etc/fhem/fhem.conf
;;
stop)
echo "Stopping $0"
killall fhem.pl
;;
status)
cnt=`ps -ef | grep "fhem.pl" | grep -v grep | wc -l`
if [ "$cnt" -eq "0" ] ; then
echo "$0 is not running"
else
echo "$0 is running"
fi
;;
*)
echo "Usage: $0 {start|stop|status}"
exit 1
esac
exit 0

44
contrib/contrib/init-scripts/fhem.3 Normal file
View File

@ -0,0 +1,44 @@
#!/bin/sh
# description: Start or stop the fhem server
# Added by Alex Peuchert
### BEGIN INIT INFO
# Provides: fhem.pl
# Required-Start: $local_fs $remote_fs
# Required-Stop: $local_fs $remote_fs
# Default-Start: 2 3 4 5
# Default-Stop: 0 1 6
# Short-Description: FHEM server
### END INIT INFO
set -e
fhz=/usr/bin/fhem.pl
conf=/etc/fhem.cfg
port=7072
case "$1" in
'start')
echo "Starting fhem..."
$fhz $conf
RETVAL=$?
;;
'stop')
echo "Stopping fhem..."
$fhz $port "shutdown"
RETVAL=$?
;;
'status')
cnt=`ps -ef | grep "fhem.pl" | grep -v grep | wc -l`
if [ "$cnt" -eq "0" ] ; then
echo "fhem is not running"
else
echo "fhem is running"
fi
;;
*)
echo "Usage: $0 { start | stop | status }"
RETVAL=1
;;
esac
exit $RETVAL

14
contrib/contrib/init-scripts/fhem.upstart Normal file
View File

@ -0,0 +1,14 @@
# FHEM Service
description "fhem server"
author "Rudolf Koenig <r.koenig@koeniglich.de>"
start on (net-device-up
and local-filesystems
and runlevel [2345])
stop on runlevel [016]
expect fork
respawn
exec /usr/bin/fhem.pl /etc/fhem.cfg

234
contrib/contrib/inputevent/89_inputevent.pm Normal file
View File

@ -0,0 +1,234 @@
package main;
###########################
# 89_inputevent.pm
# Modul for FHEM
#
# contributed by Dirk Hoffmann 2010-2011
# $Id: 89_inputEvent.pm,v 0.2 2011/11/27 19:16:16 dirkho Exp $
#
#
# Linux::Input wird benötigt
###########################
use strict;
use Switch;
use warnings;
use IO::Select;
use Linux::Input;
use vars qw{%attr %defs};
sub Log($$);
our $FH;
####################################
# INPUTEVENT_Initialize
# Implements Initialize function
#
sub INPUTEVENT_Initialize($) {
my ($hash) = @_;
Log 1, "INPUT/Event Initialize";
# Provider
$hash->{ReadFn} = "INPUTEVENT_Read";
$hash->{ReadyFn} = "INPUTEVENT_Ready";
# Consumer
$hash->{DefFn} = "INPUTEVENT_Define";
$hash->{UndefFn} = "INPUTEVENT_Undef";
$hash->{SetFn} = "INPUTEVENT_Set";
$hash->{AttrList}= "model:EVENT loglevel:0,1,2,3,4,5";
$hash->{READINGS}{uTIME} = 0;
$hash->{READINGS}{lastCode} = 0;
}
#####################################
# INPUTEVENT_Define
# Implements DefFn function
#
sub INPUTEVENT_Define($$) {
my ($hash, $def) = @_;
my ($name, undef, $dev, $msIgnore) = split("[ \t][ \t]*", $def);
if (!$msIgnore) {
$msIgnore = 175;
}
delete $hash->{fh};
delete $hash->{FD};
my $fileno;
if($dev eq "none") {
Log 1, "Input device is none, commands will be echoed only";
return undef;
}
Log 4, "Opening input device at $dev. Repeated commands within $msIgnore miliseconds was ignored.";
if ($dev=~/^\/dev\/input/) {
my $OS=$^O;
if ($OS eq 'MSWin32') {
my $logMsg = "Input devices only avilable under Linux OS at this time.";
Log 1, $logMsg;
return $logMsg;
} else {
if ($@) {
my $logMsg = "Error using Modul Linux::Input";
$hash->{STATE} = $logMsg;
Log 1, $logMsg;
return $logMsg . " Can't open Linux::Input $@\n";
}
my $devObj = Linux::Input->new($dev);
if (!$devObj) {
my $logMsg = "Error opening device";
$hash->{STATE} = "error opening device";
Log 1, $logMsg . " $dev";
return "Can't open Device $dev: $^E\n";
}
my $select = IO::Select->new($devObj->fh);
foreach my $fh ($select->handles) {
$fileno = $fh->fileno;
}
$selectlist{"$name.$dev"} = $hash;
$hash->{fh} = $devObj->fh;
$hash->{FD} = $fileno;
$hash->{SelectObj} = $select;
$hash->{STATE} = "Opened";
$hash->{DeviceName}=$name;
$hash->{msIgnore}=$msIgnore;
Log 4, "$name connected to device $dev";
}
} else {
my $logMsg = "$dev is no device and not implemented";
$hash->{STATE} = $logMsg;
Log 1, $logMsg;
return $logMsg;
}
return undef;
}
#####################################
# implements UnDef-Function
#
sub INPUTEVENT_Undef($$) {
my ($hash, $arg) = @_;
my $name = $hash->{NAME};
my $fh = $hash->{fh};
delete $hash->{fh};
$hash->{STATE}='Closed';
if ($fh) {
$fh->close();
}
Log 5, "$name shutdown complete";
return undef;
}
#####################################
# INPUTEVENT_Set
# implement SetFn
# currently nothing to set
#
sub INPUTEVENT_Ready($$) {
my ($hash, $dev) = @_;
my $select= $hash->{SelectObj};
return ($select->can_read(0));
}
#####################################
# INPUTEVENT_Set
# implement SetFn
# currently nothing to set
#
sub INPUTEVENT_Set($@) {
my ($hash, @a) = @_;
my $name=$a[0];
my $msg = "$name => No Set function implemented";
Log 1,$msg;
return $msg;
}
#####################################
# INPUTEVENT_Read
# Implements ReadFn, called from global select
#
sub INPUTEVENT_Read($$) {
my ($hash) = @_;
my $fh = $hash->{fh};
my $select= $hash->{SelectObj};
my $name = $hash->{NAME};
my $message = undef;
if( $select->can_read(0) ){
$fh->read($message,16);
INPUTEVENT_Parse($hash, $message);
}
return 1;
}
#####################################
# INPUTEVENT_Parse
# decodes complete frame
# called directly from INPUTEVENT_Read
sub INPUTEVENT_Parse($$) {
my ($hash, $msg) = @_;
my $name = $hash->{NAME};
my $message;
my ($b0,$b1,$b2,$b3,$b4,$b5,$b6,$b7,$b8,$b9,$b10,$b11,$b12,$b13,$b14,$b15) =
map {$_ & 0x7F} unpack("U*",$msg);
my $sec = sprintf('%10s', $b0 + $b1*256 + $b2*256*256 + $b3*256*256*256);
my $ySec = sprintf('%06s', $b4 + $b5*256 + $b6*256*256);
my $type = $b8;
my $code = $b10;
my $value = sprintf('%07s', $b12 + $b13*256 + $b14*256*256);
if ($type eq 4 && $code eq 3) {
$message = "$name => $sec.$ySec, type: $type, code: $code, value: $value";
# Set $ignoreUSecs => µSec sice last command.
my $uTime = $sec * 1000000 + $ySec;
my $ignoreUSecs = $uTime - $hash->{READINGS}{uTIME};
$hash->{READINGS}{uTIME} = $uTime;
#Log 4, $hash->{READINGS}{lastCode} . " _ " . $value . " | " . $hash->{READINGS}{uTIME} . " --- " . $uTime . " +++ " . $ignoreUSecs;
# IR-codes was repeated with short delay. So we ignor commands the next µSeconds set in the define command. (Default 175000)
if (($ignoreUSecs > ($hash->{msIgnore} * 1000)) || ($hash->{READINGS}{lastCode} ne $value)) {
$hash->{READINGS}{LAST}{VAL} = unpack('H*',$msg);
$hash->{READINGS}{LAST}{TIME} = TimeNow();
$hash->{READINGS}{RAW}{TIME} = time();
$hash->{READINGS}{RAW}{VAL} = unpack('H*',$msg);
$hash->{READINGS}{lastCode} = $value;
Log 4, $message;
DoTrigger($name, $message);
}
}
}
#####################################
sub INPUTEVENT_List($$) {
my ($hash,$msg) = @_;
$msg = INPUTEVENT_Get($hash,$hash->{NAME},'list');
return $msg;
}
1;

Some files were not shown because too many files have changed in this diff Show More