Public
/
fhem-mirror
mirror of https://github.com/fhem/fhem-mirror.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Compare commits

base: Public:5.1
Branches Tags
Public:travis
Public:master
Public:renovate/configure
Public:main
Public:mirror_v2
Public:4.0
Public:4.1
Public:4.2
Public:4.3
Public:4.4
Public:4.5
Public:4.6
Public:4.7
Public:5.0
Public:5.1
Public:5.2
Public:5.3
Public:5.4
Public:5.5
Public:5.6
Public:5.7
Public:5.8
Public:5.9
Public:6.0
Public:6.1
Public:6.2
...
compare: Public:travis
Branches Tags
Public:master
Public:travis
Public:renovate/configure
Public:main
Public:mirror_v2
Public:4.0
Public:4.1
Public:4.2
Public:4.3
Public:4.4
Public:4.5
Public:4.6
Public:4.7
Public:5.0
Public:5.1
Public:5.2
Public:5.3
Public:5.4
Public:5.5
Public:5.6
Public:5.7
Public:5.8
Public:5.9
Public:6.0
Public:6.1
Public:6.2

No commits in common. "5.1" and "travis" have entirely different histories.
5.1 ... travis

338 changed files with 637 additions and 66686 deletions
Show Stats Expand all files Collapse all files

11
.github/dependabot.yml vendored Normal file
View File

@ -0,0 +1,11 @@
# To get started with Dependabot version updates, you'll need to specify which
# package ecosystems to update and where the package manifests are located.
# Please see the documentation for all configuration options:
# https://help.github.com/github/administering-a-repository/configuration-options-for-dependency-updates
version: 2
updates:
- package-ecosystem: "github-actions" # See documentation for possible values
directory: "/" # Location of package manifests
schedule:
interval: "daily"

104
.github/workflows/cache.yml vendored Normal file
View File

@ -0,0 +1,104 @@
name: Update cache from SVN
on:
# Allows you to run this workflow manually from the Actions tab
workflow_dispatch:
#schedule:
#- cron: '59 */3 * * *' # every third hour to keep cache up to date
jobs:
# This workflow contains a single job called "build"
mirror:
# The type of runner that the job will run on
runs-on: ubuntu-latest
continue-on-error: true
steps:
- name: install git-svn package
run: |
sudo apt-get remove git git-man
sudo apt-get update
sudo apt-get install git-svn --no-install-recommends
- name: checkout authors
uses: actions/checkout@v4.1.5
with:
ref: travis
path: ./authors
- name: Get current date
id: get-date
run: |
echo "::set-output name=timestamp::$(/bin/date -u "+%Y%m%d%H" )"
shell: bash
- name: Cache runners svn-2-git-fhem mirror directory
# Some room for improvement because we create a new cache on every run where a new ref is fetched, this isn't very nice, normaly we need only the last one and it takes 7 days until they are deleted
id: cache-fhem
uses: actions/cache@v4.0.2
with:
path: |
./src/fhem-mirror/.git
key: ${{ runner.os }}-fhemsvndir-${{ steps.get-date.outputs.timestamp }}
restore-keys: |
${{ runner.os }}-fhemsvndir-
#- name: remove gitconfig
# run: |
# rm ./src/fhem-mirror/.git/config
- name: checkout main branch
uses: actions/checkout@v4.1.5
with:
path: ./src/fhem-mirror
clean: false
- name: generate merged authors file
run: |
cd /tmp
svn log https://svn.fhem.de/fhem --xml --quiet | grep author | sort -u | perl -pe 's/.*>(.*?)<.*/$1 = $1 <>/' > ${GITHUB_WORKSPACE}/authors/authors_svn.txt;
cat ${GITHUB_WORKSPACE}/authors/authors.txt ${GITHUB_WORKSPACE}/authors/authors_svn.txt | sort -u -k1,1 > ${GITHUB_WORKSPACE}/authors/authors_merged.txt;
ls -la ${GITHUB_WORKSPACE}/authors/authors_merged.txt;
- name: fetch from svn
id: fetchsvn
timeout-minutes: 120
working-directory: ./src/fhem-mirror
run: |
echo "::group::git svn init"
git svn init --trunk=trunk --tags=tags --prefix=svn/ https://svn.fhem.de/fhem;
git config --replace-all svn.authorsfile "${GITHUB_WORKSPACE}/authors/authors_merged.txt"
git config --replace-all svn-remote.svn.preserve-empty-dirs "true" ;
git config --replace-all svn-remote.svn.placeholder-filename ".gitkeep" ;
echo "Current .git/config file content:";
cat ${GITHUB_WORKSPACE}/src/fhem-mirror/.git/config;
echo "::endgroup::"
echo "::set-output name=SVN_FETCH_STATUS::incomplete"
# Run fetches after init, go pick up some base refs for the cache on first run only!
RET=124
c=1
while [ $RET -eq 124 ]; do
echo "::group::Fetch ${c}/5"
timeout 1200 git svn --log-window-size=200 -q fetch && RET=$? || true
if [ "$RET" -ne 0 ] && [ "$RET" -ne 124 ]; then
echo "::set-output name=SVN_FETCH_STATUS::error"
fi
((c++)) && ((c==6)) && break
echo "::endgroup::"
done
if [ "$RET" -eq 0 ]; then
echo "::set-output name=SVN_FETCH_STATUS::complete"
fi
# - name: Copy Workflow Files to target
# if: ${{ steps.fetchsvn.outputs.SVN_FETCH_STATUS == 'complete' }}
# run: |
# cp -R ${GITHUB_WORKSPACE}/main/.github ./src/fhem-mirror
- name: Verify no fetch error state
if: ${{ steps.fetchsvn.outputs.SVN_FETCH_STATUS == 'error' }}
run: |
echo "A permanent error occured"
exit 1

143
.github/workflows/mirror.yml vendored Normal file
View File

@ -0,0 +1,143 @@
name: Mirror from SVN
on:
push:
# Allows you to run this workflow manually from the Actions tab
workflow_dispatch:
schedule:
- cron: '10 */10 * * *' # every hour to keep cache up to date
jobs:
# This workflow contains a single job called "build"
mirror:
# The type of runner that the job will run on
runs-on: ubuntu-latest
continue-on-error: true
steps:
- name: install git-svn package
run: |
sudo apt-get remove git git-man
sudo apt-get update
sudo apt-get install git-svn --no-install-recommends
- name: checkout mirror config branch
uses: actions/checkout@v4.1.5
- name: Get current date as seconds
id: get-date
run: |
echo "timestamp=$(/bin/date -u "+%Y%m%d%H" )" >> $GITHUB_OUTPUT
shell: bash
- name: generate merged authors file
run: |
ls -RLa ${GITHUB_WORKSPACE}
cd /tmp
mkdir -p ${GITHUB_WORKSPACE}/authors
svn log https://svn.fhem.de/fhem --xml --quiet | grep author | sort -u | perl -pe 's/.*>(.*?)<.*/$1 = $1 <>/' > ${GITHUB_WORKSPACE}/authors_svn.txt;
cat ${GITHUB_WORKSPACE}/authors.txt ${GITHUB_WORKSPACE}/authors_svn.txt | sort -u -k1,1 > ${GITHUB_WORKSPACE}/authors/authors_merged.txt;
ls -la ${GITHUB_WORKSPACE}/authors/authors_merged.txt;
- name: create tmpfs for svn repo
run: |
mkdir -p ./src/fhem-mirror
sudo mount -t tmpfs -o size=3G tmpfs ./src/fhem-mirror
- name: Cache runners svn-2-git-fhem mirror directory
# Some room for improvement because we create a new cache on every run where a new ref is fetched, this isn't very nice, normaly weneed only the last one and it takes 7 days until they are deleted
id: cache-fhem
uses: actions/cache@v4.0.2
with:
path: ./src/fhem-mirror/.git
key: ${{ runner.os }}-fhemsvndir-${{ steps.get-date.outputs.timestamp }}
restore-keys: |
${{ runner.os }}-fhemsvndir-
- name: list filesystem
run: |
df -h ./src/fhem-mirror
- name: clean cache
env:
Clean_Cache: ${{ secrets.CLEANCACHE }}
if: "${{ env.Clean_Cache == 'true' }}"
run: |
rm -r ./src/fhem-mirror/.git
#- name: 'Tar files'
# run: tar -cvf ${GITHUB_WORKSPACE}/svnMirror.tar ./src/fhem-mirror/
#- uses: actions/upload-artifact@v2
# with:
# name: mirror-artifact
# path: ./svnMirror.tar
- name: init mirror repository if it is not already a mirror
timeout-minutes: 1800
run: |
if [[ ! -d "${GITHUB_WORKSPACE}/src/fhem-mirror/.git" ]]; then
git init "${GITHUB_WORKSPACE}/src/fhem-mirror" ;
cd "${GITHUB_WORKSPACE}/src/fhem-mirror";
git svn init --trunk=trunk --tags=tags --prefix=svn/ https://svn.fhem.de/fhem;
git config --replace-all svn-remote.svn.preserve-empty-dirs "true" ;
git config --replace-all svn-remote.svn.placeholder-filename ".gitkeep" ;
git config --replace-all svn.authorsfile "${GITHUB_WORKSPACE}/authors/authors_merged.txt" ;
# Run extra fetches after init, go pick up some base refs for the cache on first run only!
timeout 900 git svn -q fetch || timeout 900 git svn -q fetch || timeout 900 git svn -q fetch || true
else
echo "Current .git/config file content:";
cat ${GITHUB_WORKSPACE}/src/fhem-mirror/.git/config;
fi
- name: fetch svn to git master branch
id: fetchsvn
timeout-minutes: 1800
run: |
echo "SVN_FETCH_STATUS=incomplete" >> $GITHUB_OUTPUT
cd "${GITHUB_WORKSPACE}/src/fhem-mirror";
RET=0
timeout 1800 git svn -q --log-window-size=5000 fetch || timeout 1500 git svn -q --log-window-size=5000 fetch || RET=$?;
if [[ $RET == 0 ]]; then
git switch master
git config --global user.email "actions@gitbhub.com"
git config --global user.name "Github Actions"
git reset --hard "remotes/svn/trunk"
echo "SVN_FETCH_STATUS=complete" >> $GITHUB_OUTPUT
elif [[ $RET != 124 ]]; then
echo "SVN_FETCH_STATUS=error" >> $GITHUB_OUTPUT
fi
- name: Verify no fetch error state
if: ${{ steps.fetchsvn.outputs.SVN_FETCH_STATUS == 'error' }}
run: |
echo "A permanent error occured"
exit 1
- name: Recreate tags from svn
if: ${{ steps.fetchsvn.outputs.SVN_FETCH_STATUS == 'complete' }}
working-directory: ./src/fhem-mirror
run: |
git for-each-ref --format="%(refname:lstrip=-1) %(objectname)" refs/remotes/svn/tags/FHEM_*_? \
| while read BRANCH REF
do
TAG_NAME=${BRANCH#FHEM_}
TAG_NAME=$(echo $TAG_NAME | sed 's/_/./g')
BODY="$(git log -1 --format=format:%B $REF)"
echo "branch=$BRANCH ref=$REF parent=$(git rev-parse $REF^) tagname=$TAG_NAME body=$BODY" >&2
git tag -a -f -m "$BODY" $TAG_NAME $REF^
# git branch -r -d origin/tags/$BRANCH
done
- name: push tags and commits into master branch (force)
if: ${{ steps.fetchsvn.outputs.SVN_FETCH_STATUS == 'complete' }}
working-directory: ./src/fhem-mirror
run: |
git remote set-url origin https://x-access-token:${{ secrets.GITHUB_TOKEN }}@github.com/${{ github.repository }} || git remote add origin https://x-access-token:${{ secrets.GITHUB_TOKEN }}@github.com/${{ github.repository }}
git fetch --unshallow || true
git push origin master --force --tags

13
CVSROOT/checkoutlist
View File

@ -1,13 +0,0 @@
# The "checkoutlist" file is used to support additional version controlled
# administrative files in $CVSROOT/CVSROOT, such as template files.
#
# The first entry on a line is a filename which will be checked out from
# the corresponding RCS file in the $CVSROOT/CVSROOT directory.
# The remainder of the line is an error message to use if the file cannot
# be checked out.
#
# File format:
#
# [<whitespace>]<filename><whitespace><error message><end-of-line>
#
# comment lines begin with '#'

15
CVSROOT/commitinfo
View File

@ -1,15 +0,0 @@
# The "commitinfo" file is used to control pre-commit checks.
# The filter on the right is invoked with the repository and a list
# of files to check. A non-zero exit of the filter program will
# cause the commit to be aborted.
#
# The first entry on a line is a regular expression which is tested
# against the directory that the change is being committed to, relative
# to the $CVSROOT. For the first match that is found, then the remainder
# of the line is the name of the filter to run.
#
# If the repository name does not match any of the regular expressions in this
# file, the "DEFAULT" line is used, if it is specified.
#
# If the name "ALL" appears as a regular expression it is always used
# in addition to the first matching regex or "DEFAULT".

21
CVSROOT/config
View File

@ -1,21 +0,0 @@
# Set this to "no" if pserver shouldn't check system users/passwords
#SystemAuth=no
# Put CVS lock files in this directory rather than directly in the repository.
#LockDir=/var/lock/cvs
# Set `TopLevelAdmin' to `yes' to create a CVS directory at the top
# level of the new working directory when using the `cvs checkout'
# command.
#TopLevelAdmin=no
# Set `LogHistory' to `all' or `TOFEWGCMAR' to log all transactions to the
# history file, or a subset as needed (ie `TMAR' logs all write operations)
#LogHistory=TOFEWGCMAR
# Set `RereadLogAfterVerify' to `always' (the default) to allow the verifymsg
# script to change the log message. Set it to `stat' to force CVS to verify# that the file has changed before reading it (this can take up to an extra
# second per directory being committed, so it is not recommended for large
# repositories. Set it to `never' (the previous CVS behavior) to prevent
# verifymsg scripts from changing the log message.
#RereadLogAfterVerify=always

19
CVSROOT/cvswrappers
View File

@ -1,19 +0,0 @@
# This file affects handling of files based on their names.
#
# The -m option specifies whether CVS attempts to merge files.
#
# The -k option specifies keyword expansion (e.g. -kb for binary).
#
# Format of wrapper file ($CVSROOT/CVSROOT/cvswrappers or .cvswrappers)
#
# wildcard [option value][option value]...
#
# where option is one of
# -f from cvs filter value: path to filter
# -t to cvs filter value: path to filter
# -m update methodology value: MERGE or COPY
# -k expansion mode value: b, o, kkv, &c
#
# and value is a single-quote delimited value.
# For example:
#*.gif -k 'b'

21
CVSROOT/editinfo
View File

@ -1,21 +0,0 @@
# The "editinfo" file is used to allow verification of logging
# information. It works best when a template (as specified in the
# rcsinfo file) is provided for the logging procedure. Given a
# template with locations for, a bug-id number, a list of people who
# reviewed the code before it can be checked in, and an external
# process to catalog the differences that were code reviewed, the
# following test can be applied to the code:
#
# Making sure that the entered bug-id number is correct.
# Validating that the code that was reviewed is indeed the code being
# checked in (using the bug-id number or a seperate review
# number to identify this particular code set.).
#
# If any of the above test failed, then the commit would be aborted.
#
# Actions such as mailing a copy of the report to each reviewer are
# better handled by an entry in the loginfo file.
#
# One thing that should be noted is the the ALL keyword is not
# supported. There can be only one entry that matches a given
# repository.

26
CVSROOT/loginfo
View File

@ -1,26 +0,0 @@
# The "loginfo" file controls where "cvs commit" log information
# is sent. The first entry on a line is a regular expression which must match
# the directory that the change is being made to, relative to the
# $CVSROOT. If a match is found, then the remainder of the line is a filter
# program that should expect log information on its standard input.
#
# If the repository name does not match any of the regular expressions in this
# file, the "DEFAULT" line is used, if it is specified.
#
# If the name ALL appears as a regular expression it is always used
# in addition to the first matching regex or DEFAULT.
#
# You may specify a format string as part of the
# filter. The string is composed of a `%' followed
# by a single format character, or followed by a set of format
# characters surrounded by `{' and `}' as separators. The format
# characters are:
#
# s = file name
# V = old version number (pre-checkin)
# v = new version number (post-checkin)
#
# For example:
#DEFAULT (echo ""; id; echo %s; date; cat) >> $CVSROOT/CVSROOT/commitlog
# or
#DEFAULT (echo ""; id; echo %{sVv}; date; cat) >> $CVSROOT/CVSROOT/commitlog

26
CVSROOT/modules
View File

@ -1,26 +0,0 @@
# Three different line formats are valid:
# key -a aliases...
# key [options] directory
# key [options] directory files...
#
# Where "options" are composed of:
# -i prog Run "prog" on "cvs commit" from top-level of module.
# -o prog Run "prog" on "cvs checkout" of module.
# -e prog Run "prog" on "cvs export" of module.
# -t prog Run "prog" on "cvs rtag" of module.
# -u prog Run "prog" on "cvs update" of module.
# -d dir Place module in directory "dir" instead of module name.
# -l Top-level directory only -- do not recurse.
#
# NOTE: If you change any of the "Run" options above, you'll have to
# release and re-checkout any working directories of these modules.
#
# And "directory" is a path to a directory relative to $CVSROOT.
#
# The "-a" option specifies an alias. An alias is interpreted as if
# everything on the right of the "-a" had been typed on the command line.
#
# You can encode a module within a module by using the special '&'
# character to interpose another module into the current module. This
# can be useful for creating a module that consists of many directories
# spread out over the entire source repository.

12
CVSROOT/notify
View File

@ -1,12 +0,0 @@
# The "notify" file controls where notifications from watches set by
# "cvs watch add" or "cvs edit" are sent. The first entry on a line is
# a regular expression which is tested against the directory that the
# change is being made to, relative to the $CVSROOT. If it matches,
# then the remainder of the line is a filter program that should contain
# one occurrence of %s for the user to notify, and information on its
# standard input.
#
# "ALL" or "DEFAULT" can be used in place of the regular expression.
#
# For example:
#ALL mail -s "CVS notification" %s

13
CVSROOT/rcsinfo
View File

@ -1,13 +0,0 @@
# The "rcsinfo" file is used to control templates with which the editor
# is invoked on commit and import.
#
# The first entry on a line is a regular expression which is tested
# against the directory that the change is being made to, relative to the
# $CVSROOT. For the first match that is found, then the remainder of the
# line is the name of the file that contains the template.
#
# If the repository name does not match any of the regular expressions in this
# file, the "DEFAULT" line is used, if it is specified.
#
# If the name "ALL" appears as a regular expression it is always used
# in addition to the first matching regex or "DEFAULT".

20
CVSROOT/taginfo
View File

@ -1,20 +0,0 @@
# The "taginfo" file is used to control pre-tag checks.
# The filter on the right is invoked with the following arguments:
#
# $1 -- tagname
# $2 -- operation "add" for tag, "mov" for tag -F, and "del" for tag -d
# $3 -- repository
# $4-> file revision [file revision ...]
#
# A non-zero exit of the filter program will cause the tag to be aborted.
#
# The first entry on a line is a regular expression which is tested
# against the directory that the change is being committed to, relative
# to the $CVSROOT. For the first match that is found, then the remainder
# of the line is the name of the filter to run.
#
# If the repository name does not match any of the regular expressions in this
# file, the "DEFAULT" line is used, if it is specified.
#
# If the name "ALL" appears as a regular expression it is always used
# in addition to the first matching regex or "DEFAULT".

21
CVSROOT/verifymsg
View File

@ -1,21 +0,0 @@
# The "verifymsg" file is used to allow verification of logging
# information. It works best when a template (as specified in the
# rcsinfo file) is provided for the logging procedure. Given a
# template with locations for, a bug-id number, a list of people who
# reviewed the code before it can be checked in, and an external
# process to catalog the differences that were code reviewed, the
# following test can be applied to the code:
#
# Making sure that the entered bug-id number is correct.
# Validating that the code that was reviewed is indeed the code being
# checked in (using the bug-id number or a seperate review
# number to identify this particular code set.).
#
# If any of the above test failed, then the commit would be aborted.
#
# Actions such as mailing a copy of the report to each reviewer are
# better handled by an entry in the loginfo file.
#
# One thing that should be noted is the the ALL keyword is not
# supported. There can be only one entry that matches a given
# repository.

339
LICENSE Normal file
View File

@ -0,0 +1,339 @@
GNU GENERAL PUBLIC LICENSE
Version 2, June 1991
Copyright (C) 1989, 1991 Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
Everyone is permitted to copy and distribute verbatim copies
of this license document, but changing it is not allowed.
Preamble
The licenses for most software are designed to take away your
freedom to share and change it. By contrast, the GNU General Public
License is intended to guarantee your freedom to share and change free
software--to make sure the software is free for all its users. This
General Public License applies to most of the Free Software
Foundation's software and to any other program whose authors commit to
using it. (Some other Free Software Foundation software is covered by
the GNU Lesser General Public License instead.) You can apply it to
your programs, too.
When we speak of free software, we are referring to freedom, not
price. Our General Public Licenses are designed to make sure that you
have the freedom to distribute copies of free software (and charge for
this service if you wish), that you receive source code or can get it
if you want it, that you can change the software or use pieces of it
in new free programs; and that you know you can do these things.
To protect your rights, we need to make restrictions that forbid
anyone to deny you these rights or to ask you to surrender the rights.
These restrictions translate to certain responsibilities for you if you
distribute copies of the software, or if you modify it.
For example, if you distribute copies of such a program, whether
gratis or for a fee, you must give the recipients all the rights that
you have. You must make sure that they, too, receive or can get the
source code. And you must show them these terms so they know their
rights.
We protect your rights with two steps: (1) copyright the software, and
(2) offer you this license which gives you legal permission to copy,
distribute and/or modify the software.
Also, for each author's protection and ours, we want to make certain
that everyone understands that there is no warranty for this free
software. If the software is modified by someone else and passed on, we
want its recipients to know that what they have is not the original, so
that any problems introduced by others will not reflect on the original
authors' reputations.
Finally, any free program is threatened constantly by software
patents. We wish to avoid the danger that redistributors of a free
program will individually obtain patent licenses, in effect making the
program proprietary. To prevent this, we have made it clear that any
patent must be licensed for everyone's free use or not licensed at all.
The precise terms and conditions for copying, distribution and
modification follow.
GNU GENERAL PUBLIC LICENSE
TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
0. This License applies to any program or other work which contains
a notice placed by the copyright holder saying it may be distributed
under the terms of this General Public License. The "Program", below,
refers to any such program or work, and a "work based on the Program"
means either the Program or any derivative work under copyright law:
that is to say, a work containing the Program or a portion of it,
either verbatim or with modifications and/or translated into another
language. (Hereinafter, translation is included without limitation in
the term "modification".) Each licensee is addressed as "you".
Activities other than copying, distribution and modification are not
covered by this License; they are outside its scope. The act of
running the Program is not restricted, and the output from the Program
is covered only if its contents constitute a work based on the
Program (independent of having been made by running the Program).
Whether that is true depends on what the Program does.
1. You may copy and distribute verbatim copies of the Program's
source code as you receive it, in any medium, provided that you
conspicuously and appropriately publish on each copy an appropriate
copyright notice and disclaimer of warranty; keep intact all the
notices that refer to this License and to the absence of any warranty;
and give any other recipients of the Program a copy of this License
along with the Program.
You may charge a fee for the physical act of transferring a copy, and
you may at your option offer warranty protection in exchange for a fee.
2. You may modify your copy or copies of the Program or any portion
of it, thus forming a work based on the Program, and copy and
distribute such modifications or work under the terms of Section 1
above, provided that you also meet all of these conditions:
a) You must cause the modified files to carry prominent notices
stating that you changed the files and the date of any change.
b) You must cause any work that you distribute or publish, that in
whole or in part contains or is derived from the Program or any
part thereof, to be licensed as a whole at no charge to all third
parties under the terms of this License.
c) If the modified program normally reads commands interactively
when run, you must cause it, when started running for such
interactive use in the most ordinary way, to print or display an
announcement including an appropriate copyright notice and a
notice that there is no warranty (or else, saying that you provide
a warranty) and that users may redistribute the program under
these conditions, and telling the user how to view a copy of this
License. (Exception: if the Program itself is interactive but
does not normally print such an announcement, your work based on
the Program is not required to print an announcement.)
These requirements apply to the modified work as a whole. If
identifiable sections of that work are not derived from the Program,
and can be reasonably considered independent and separate works in
themselves, then this License, and its terms, do not apply to those
sections when you distribute them as separate works. But when you
distribute the same sections as part of a whole which is a work based
on the Program, the distribution of the whole must be on the terms of
this License, whose permissions for other licensees extend to the
entire whole, and thus to each and every part regardless of who wrote it.
Thus, it is not the intent of this section to claim rights or contest
your rights to work written entirely by you; rather, the intent is to
exercise the right to control the distribution of derivative or
collective works based on the Program.
In addition, mere aggregation of another work not based on the Program
with the Program (or with a work based on the Program) on a volume of
a storage or distribution medium does not bring the other work under
the scope of this License.
3. You may copy and distribute the Program (or a work based on it,
under Section 2) in object code or executable form under the terms of
Sections 1 and 2 above provided that you also do one of the following:
a) Accompany it with the complete corresponding machine-readable
source code, which must be distributed under the terms of Sections
1 and 2 above on a medium customarily used for software interchange; or,
b) Accompany it with a written offer, valid for at least three
years, to give any third party, for a charge no more than your
cost of physically performing source distribution, a complete
machine-readable copy of the corresponding source code, to be
distributed under the terms of Sections 1 and 2 above on a medium
customarily used for software interchange; or,
c) Accompany it with the information you received as to the offer
to distribute corresponding source code. (This alternative is
allowed only for noncommercial distribution and only if you
received the program in object code or executable form with such
an offer, in accord with Subsection b above.)
The source code for a work means the preferred form of the work for
making modifications to it. For an executable work, complete source
code means all the source code for all modules it contains, plus any
associated interface definition files, plus the scripts used to
control compilation and installation of the executable. However, as a
special exception, the source code distributed need not include
anything that is normally distributed (in either source or binary
form) with the major components (compiler, kernel, and so on) of the
operating system on which the executable runs, unless that component
itself accompanies the executable.
If distribution of executable or object code is made by offering
access to copy from a designated place, then offering equivalent
access to copy the source code from the same place counts as
distribution of the source code, even though third parties are not
compelled to copy the source along with the object code.
4. You may not copy, modify, sublicense, or distribute the Program
except as expressly provided under this License. Any attempt
otherwise to copy, modify, sublicense or distribute the Program is
void, and will automatically terminate your rights under this License.
However, parties who have received copies, or rights, from you under
this License will not have their licenses terminated so long as such
parties remain in full compliance.
5. You are not required to accept this License, since you have not
signed it. However, nothing else grants you permission to modify or
distribute the Program or its derivative works. These actions are
prohibited by law if you do not accept this License. Therefore, by
modifying or distributing the Program (or any work based on the
Program), you indicate your acceptance of this License to do so, and
all its terms and conditions for copying, distributing or modifying
the Program or works based on it.
6. Each time you redistribute the Program (or any work based on the
Program), the recipient automatically receives a license from the
original licensor to copy, distribute or modify the Program subject to
these terms and conditions. You may not impose any further
restrictions on the recipients' exercise of the rights granted herein.
You are not responsible for enforcing compliance by third parties to
this License.
7. If, as a consequence of a court judgment or allegation of patent
infringement or for any other reason (not limited to patent issues),
conditions are imposed on you (whether by court order, agreement or
otherwise) that contradict the conditions of this License, they do not
excuse you from the conditions of this License. If you cannot
distribute so as to satisfy simultaneously your obligations under this
License and any other pertinent obligations, then as a consequence you
may not distribute the Program at all. For example, if a patent
license would not permit royalty-free redistribution of the Program by
all those who receive copies directly or indirectly through you, then
the only way you could satisfy both it and this License would be to
refrain entirely from distribution of the Program.
If any portion of this section is held invalid or unenforceable under
any particular circumstance, the balance of the section is intended to
apply and the section as a whole is intended to apply in other
circumstances.
It is not the purpose of this section to induce you to infringe any
patents or other property right claims or to contest validity of any
such claims; this section has the sole purpose of protecting the
integrity of the free software distribution system, which is
implemented by public license practices. Many people have made
generous contributions to the wide range of software distributed
through that system in reliance on consistent application of that
system; it is up to the author/donor to decide if he or she is willing
to distribute software through any other system and a licensee cannot
impose that choice.
This section is intended to make thoroughly clear what is believed to
be a consequence of the rest of this License.
8. If the distribution and/or use of the Program is restricted in
certain countries either by patents or by copyrighted interfaces, the
original copyright holder who places the Program under this License
may add an explicit geographical distribution limitation excluding
those countries, so that distribution is permitted only in or among
countries not thus excluded. In such case, this License incorporates
the limitation as if written in the body of this License.
9. The Free Software Foundation may publish revised and/or new versions
of the General Public License from time to time. Such new versions will
be similar in spirit to the present version, but may differ in detail to
address new problems or concerns.
Each version is given a distinguishing version number. If the Program
specifies a version number of this License which applies to it and "any
later version", you have the option of following the terms and conditions
either of that version or of any later version published by the Free
Software Foundation. If the Program does not specify a version number of
this License, you may choose any version ever published by the Free Software
Foundation.
10. If you wish to incorporate parts of the Program into other free
programs whose distribution conditions are different, write to the author
to ask for permission. For software which is copyrighted by the Free
Software Foundation, write to the Free Software Foundation; we sometimes
make exceptions for this. Our decision will be guided by the two goals
of preserving the free status of all derivatives of our free software and
of promoting the sharing and reuse of software generally.
NO WARRANTY
11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
REPAIR OR CORRECTION.
12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
POSSIBILITY OF SUCH DAMAGES.
END OF TERMS AND CONDITIONS
How to Apply These Terms to Your New Programs
If you develop a new program, and you want it to be of the greatest
possible use to the public, the best way to achieve this is to make it
free software which everyone can redistribute and change under these terms.
To do so, attach the following notices to the program. It is safest
to attach them to the start of each source file to most effectively
convey the exclusion of warranty; and each file should have at least
the "copyright" line and a pointer to where the full notice is found.
<one line to give the program's name and a brief idea of what it does.>
Copyright (C) <year> <name of author>
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 2 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, write to the Free Software Foundation, Inc.,
51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
Also add information on how to contact you by electronic and paper mail.
If the program is interactive, make it output a short notice like this
when it starts in an interactive mode:
Gnomovision version 69, Copyright (C) year name of author
Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
This is free software, and you are welcome to redistribute it
under certain conditions; type `show c' for details.
The hypothetical commands `show w' and `show c' should show the appropriate
parts of the General Public License. Of course, the commands you use may
be called something other than `show w' and `show c'; they could even be
mouse-clicks or menu items--whatever suits your program.
You should also get your employer (if you work as a programmer) or your
school, if any, to sign a "copyright disclaimer" for the program, if
necessary. Here is a sample; alter the names:
Yoyodyne, Inc., hereby disclaims all copyright interest in the program
`Gnomovision' (which makes passes at compilers) written by James Hacker.
<signature of Ty Coon>, 1 April 1989
Ty Coon, President of Vice
This General Public License does not permit incorporating your program into
proprietary programs. If your program is a subroutine library, you may
consider it more useful to permit linking proprietary applications with the
library. If this is what you want to do, use the GNU Lesser General
Public License instead of this License.

23
README.md Normal file
View File

@ -0,0 +1,23 @@
# fhem-mirror
READ-ONLY mirror of the [main Subversion repository](http://svn.fhem.de/fhem/trunk), updated multiple times every day.
## Branches
1. The [`master`](https://github.com/fhem/fhem-mirror/tree/master) branch hosts the current source code from [FHEM SVN Trunk](http://svn.fhem.de/fhem/trunk).
2. The [`travis`](https://github.com/fhem/fhem-mirror/tree/travis) branch is controlling the mirroring process, running on [Github Actions](https://github.com/fhem/fhem-mirror/actions/workflows/mirror.yml).
3. Under [`tags`](https://github.com/fhem/fhem-mirror/tags) FHEM Releases are mirrored also.
## Pull requests
Pull requests to any other branch besides [`travis`](https://github.com/fhem/fhem-mirror/tree/travis) will be rejected.
Instead, a module may have its own repository here on [Github.com/fhem](https://www.github.com/fhem) and will accept your patch using a [pull request](https://help.github.com/en/articles/about-pull-requests).
If you can't find a repository for the module you would like to contribute, visit the official [FHEM support forum](https://forum.fhem.de/) to post your patch. However, it might not be very welcome as it easily mixes up with user support requests and makes version control extremely difficult to handle. For that particular reason, please consider contacting the maintainer using the forum direct message function and send a link to where s/he can find your changed version or patch file.
## Author matching
Authors from the Subversion repository will be referred here without any email relation.
Those that also have an Github.com account might have a different username here.
The [`authors.txt`](https://github.com/fhem/fhem-mirror/blob/travis/authors.txt) file will ensure to re-write authors from the Subversion repository to their Github.com username and email address.
Should an author want to be re-matched for any _future_ commits, s/he may modify [`authors.txt`](https://github.com/fhem/fhem-mirror/blob/travis/authors.txt) file and send a [Git pull request](https://help.github.com/articles/creating-a-pull-request-from-a-fork/).
For that purpose, remember to fork the correct branch [`travis`](https://github.com/fhem/fhem-mirror/tree/travis), _not_ the [`master`](https://github.com/fhem/fhem-mirror/tree/master) branch.

17
authors.txt Normal file
View File

@ -0,0 +1,17 @@
(no author) = unknown <>
root = unknown <>
fhemupdate = svc8083 <svc8083@users.noreply.github.com>
loredo = jpawlowski <jpawlowski@users.noreply.github.com>
justme1968 = justme-1968 <justme-1968@users.noreply.github.com>
CoolTux = LeonGaultier <LeonGaultier@users.noreply.github.com>
neubert = borisneubert <borisneubert@users.noreply.github.com>
Sidey = sidey79 <sidey79@users.noreply.github.com>
yoda_gh = gernot-h <gernot-h@users.noreply.github.com>
DeeSPe = deespe <DeeSPe@users.noreply.github.com>
igami = igami <igami@users.noreply.github.com>
KernSani = KernSani <KernSani@users.noreply.github.com>
hexenmeister = hexenmeister <hexenmeister@users.noreply.github.com>
eisler = eisler <eisler@users.noreply.github.com>
marvin78 = marvin78 <marvin78@users.noreply.github.com>
dominik = dominikkarall <dominikkarall@users.noreply.github.com>
DS_Starter = nasseeder1 <nasseeder1@users.noreply.github.com>

631
fhem/CHANGED
View File

@ -1,631 +0,0 @@
- 2011-07-08 (5.1)
- feature: smallscreen optimizations for iPhone
- feature: FHT8V rewrite (and moved from contrib into the FHEM directory).
- feature: PID rewrite (and moved from contrib into the FHEM directory).
- feature: FHEM2FHEM module
- bugfix: CUL get should not digest foreign events (fhtsoftbuffer)
- bugfix: S300TH sanity check won't allow negative temperatures.
- feature: decode CUL uptime
- feature: USB doc changes, FHZ initFS20_02/stopHMS parameters by Andreas.
- feature: CUL_HM for some HomeMatic devices.
- bugfix: HTML-Syntax check of the pgm2 output and documents (*.html)
- feature: added date alias for FHT80b (Boris)
- feature: attr may be a regexp (for CUL_IR)
- feature: Homepage moved from koeniglich.de/fhem to fhem.de
- feature: eventMap attribute
- feature: 64_ESA2000 added (by STefan/Gerd)
- feature: new modules 66_ECMD.pm and 67_ECMDDevice.pm for ethersex-enabled
devices and alike.
- bugfix: serial port setting on Linux broken if running in the background
- feature: IPV6 support, FHEMWEB basicAuth and HTTPS support
- feature: createlog added to the autocreate module
- feature: contrib/tcptee.pl added
- feature: HMLAN support
- feature: Fritzbox7390 image
- feature: pgm2 tablet support, included into the default configuration
- feature: TUL/EIB Support (by Maz)
- feature: updatefhem/CULflash
- 2010-08-15 (5.0)
- **NOTE*: The default installation path is changed to satisfy lintian
- feature: KM271
- bugfix: 99_SUNRISE_EL endless loop bug
- feature: CUL: optional baudrate spec in definition
- feature: CUL: sendpool attribute
- feature: CUL_HOERMANN module added
- bugfix: DST change: absolute at and relative sunrise fix
- feature: FHEMWEB javascript additions for SVG plots (click on lines/labels)
- feature: FHEMWEB smallscreen attribute (for smartphones)
- bugfix: the internal fhem() used in perl oneliners does not return a value
- feature: Dimmer function of X10 module changed to match FS20
- feature: allow only meaningful readings (fill level > -5%) in USF1000
- feature: device attr links in commandref.html
- bugfix: make BS known to CUL to avoid lost messages if both FHZ1300 and CUL
are connected, adjust matching rule
- feature: Copy&Paste in SVG
- feature: Debian/Ubuntu Package. Install-path changes to satisfy lintian
- feature: Allnet 3076/4027/4000T
- feature: RFXCOMM Module for Oregon Weatherstations
- feature: Davis VantagePro2
- feature: ELV USB-WDE1
- feature: addvaltriggers CUL attribute for adding RSSI as a trigger
- feature: CUL_WS sanity check for large temp differences.
- 2010-03-13 (4.9)
- bugfix: changed the fhem prompt from FHZ> to fhem>
- bugfix: CUL_RFR fixes (chaining RFR's should work)
- bugfix: Path in the examples fixed (got corrupted)
- bugfix: PachLog fixes from Axel
- bugfix: HOWTO/Examples revisited for correctness
- bugfix: INITIALIZED, DEFINED, RENAMED, DELETED triggers
- feature: image weblinks from Stefan
- feature: OWFS support for passive Devices e.g. DS9097 (see commandref.html)
- bugfix: OWFS crash fhem with PGM2/3, xmllist (M.Fischer)
- bugfix: OWTEMP Defining a device without OWFS now fails (M.Fischer)
- bugfix: 21_OWTEMP.pm missing trigger fo notify/filelog (M.Fischer)
- feature: 99_getstate.pm get state from S555TH now (M.Fischer)
- feature: pgm3: automatic support for CUL_WS (S300TH) added (MartinH)
- bugfix: 21_OWTEMP.pm missing space within state logging (M.Fischer)
- bugfix: 21_OWTEMP.pm interval fixed (M.Fischer)
- bugfix: 21_OWTEMP.pm rewrite with errorcontrol and demo mode (M.Fischer)
- feature: ignore attribute
- bugfix: [pgm3] table-format on Android-Browser optimized
- feature: [pgm3] Skinable - change the colors.
- feature: [pgm3] Rooms possible for Webcam and Google-Weather
- bugfix: dummy/structure was listed twice in list and xmllist
- feature: 11_FHT.pm added new readings for warnings on battery, lowtemp,
window and windowsensor (M.Fischer)
- feature: autocreate.pm (create undefined RF devices, logs and plots)
- feature: on-for-timer added for X10 modules (Boris)
- bugfix: pgm3: Better check of availability of google-weather (MartinH)
- feature: pgm3: DBLog added for everything except UserDefs
(Gerhard Pfeffer / MartinH)
- feature: pgm2 style changes, SVG in background, optional compression
- 2009-11-28 (4.8)
- bugfix: loosing data when sending FS20 messages in a group
- bugfix: better handling of disconnected CUN
- feature: softfhtbuffer added to CUL
- bugfix: pgm3: Pulldown-Menu FHTDEV with error-check (MartinH)
- feature: duplicate buffer added for multi-cul/-fhz setups
- feature: 20_OWFS.pm for 1-Wire via OWFS added (Martin Fischer)
- feature: 21_OWTEMP.pm for 1-Wire Digital Thermometer added (Martin Fischer)
- feature: CUL_FHTTK from Kai
- feature: pgm3: Google-Weather, Battery-Check, Log-View added (MartinH)
- feature: CUL_RFR (RF_ROUTING) added
- feature: Command save retains now the order of the old config file
- feature: List parameter added (list .* RFR_MSGCNT)
- 2009-10-23 (4.7)
- bugfix: Reattached corrupted CUL device caused uninitialized message
- bugfix: CUL/HMS changes, HMS cleanup
- bugfix: EM/EMWZ/EMGZ set changed to work in FHEMWEB
- bugfix: Avoid unitialized in xmllist for corrupt readings, reporter Boris
- bugfix: Add binmode to 01_fhemweb.pm for windows
- bugfix: Uniform check for windows, enable CUL for windows.
- bugfix: CUL/HMS parsing patches from Peter
- bugfix: Fixes for Windows by Klaus
- bugfix: Another "rereadcfg" bugfix
- feature: Update to the current (1.27) CUL FHT interface
- feature: suppress inplausible readings from USF1000
- feature: get time, fwrev, set reopen for CM11 (Boris 2009-09-12)
- bugfix: FHZ_ReadAnswer bugfix for Windows (Klaus, 20.8.2009)
- feature: CUL: device access code reorganized, TCP/IP support added (CUN)
- feature: Pachube module from Axel
- feature: dumpdef module from Axel in contrib
- feature: javascripting support in FHEMWEB (Klaus/Axel)
- feature: Module 09_BS.pm for brightness sensor added (Boris 2009-09-20)
- 2009-07-03 (4.6)
- bugfix: fht actuator message clarification by Klaus
- feature: getstate command from Martin (25.12)
- bugfix: at drifts for relative timespecs
- bugfix: Add IODev to CUL/EM/CUL_WS/HMS/KS300
- bugfix: FileLog get (pgm2 plots) wont find the first row in the file
- feature: 00_CUL: Answer CUR requests (status/time/fht)
- bugfix: support for second correction factor for EMWZ in 15_CUL_EM added
- feature: CUL further sets/gets added
- feature: Removed msghist for multiple FHZ handling, IODev attribute added
- bugfix: cut off string "(counter)" from fallback value in 13_KS300.pm
- feature: daily/monthly cumulated values for EMWZ/EMGZ/EMWM with 15_CUL_EM
- feature: 01_FHEMWEB.pm: multiple room assignments
- feature: 01_FHEMWEB.pm: fixedrange with optional [day|week|month|year]
- feature: 01_FHEMWEB.pm: attr title and label for flexible .gplot files
- feature: fhem.pl: attr global logdir used by wildcard %ld
- feature: do not block on disconnected devices (FHZ/CM11/CUL)
- bugfix: deleting at definition in the at command
- bugfix: deleting a notify/at/watchdog definition in a notify/at/watchdog
- feature: devspec <attr>=<value>. E.g. set room=kitchen off; list disabled=
- feature: Common Module calling for CUL/FHZ/CM11
- feature: Store CUL sensitivity info
- feature: avoid the "unknown/help me" message for unloaded devices
- feature: structure module for large installations
- feature: Cost Control in 15_CUL_EM (CostPerUnit, BasisFeePerMonth)
- feature: add counter differential per time in 81_M232Counter.pm
- feature: added USB compendium to documentation
- feature: pgm3: Documentation for pgm3 updated, HMS100CO added (and bugfix)
- bugfix: Defining a repeated at job in a sunrise/sunset at job fails
- bugfix: FHT "summer" fix (avoiding a lot of syncnow)
- feature: FHEMWEB modules added
- feature: holiday module + doc + example + holiday2we attribute
- bugfix: sunrise stuff fixed, doc missing
- feature: CUL FHT sending added
- bugfix: workaround to make M232 counter wraparound
- feature: sequence module added
- feature: Google Weather API support for FHEM (Boris 2009-06-01)
- feature: lazy attribute for FHT devices (Boris 2009-06-09)
- feature: tmpcorr attribute for FHT devices
- feature: CUL_EM generates an event for each of the READINGS
- feature: USF1000S support for FHEM added (Boris 2009-06-20)
- feature: CUL supports HMS (culfw >= 1.22 needed)
- feature: CUL shutdown procedure added
- feature: 14_CUL_WS: better error checking
- bugfix: webpgm2 multi line editing is working again
- 2008-12-23 (4.5)
- bugfix: further 01_FHEMWEB cleanup
- feature: CUL support for FS20(r/w), FHT(readonly), KS300 and EM
- feature: command list outputs the device attributes too
- bugfix: rename bugs fixed
- bugfix: better integration of ReadyFn (Windows), slight overall speedup
- bugfix: Ignore/correct casing when autoloading modules
- bugfix: at is executed twice after a modify (rufus99, 2008-09-10)
- feature: FHT internal modifications (better protocol understanding)
- feature: add timestamp to inform
- feature: The strange stty settings in 00_FHEM.pm are optional
- bugfix: webpgm2 iPhone fix
- feature: fullinit and reopen commands for FHZ added (Boris 2008-11-01)
- bugfix: undefined NotifyFn in fhem.pl (Boris 2008-11-01)
- feature: new modules 00_CM11.pm and 20_X10.pm for integration of X10
devices in fhem (Boris 2008-11-02)
- feature: X10 support for pgm3 (Boris 2008-11-02)
- bugfix: FHT short message warning
- bugfix: rereadconfig crashes with active webpgm2 connections (2008-11-13)
- bugfix: watchdog crash (2008-11-15)
- bugfix: Strange call for nonexistent MyCUL: ReadFn
- feature: webpgm2: gplot output goes to /tmp/gnuplot.err
- feature: devspec TYPE,DEF,STATE. e.g. list TYPE:FS20, set DEF:123 on
- bugfix: at schedules 2 events after the DST change (fix not verified)
- feature: commandref.html reorg. There are now device sections.
- feature: CUL / CUL_EM / CUL_WS documentation
- feature: do not block fhem when the CUR is disconnected
- bugfix: correct correction factors for EMEM in 15_CUL_EM.pm
- bugfix: more stable CUL initialization
- feature: reworked 15_CUL_EM.pm to account for timer wraparounds, more
readings added
- feature: speed gain through disabled refreshvalues query to all FHTs at
definition; if you want it back at a "set myFHT report1 255
report2 255" command to the config file.
- feature: fhem commands may be added in modules. XmlList is external now.
- bugfix: rereadcfg from webpgm2 does not crash fhem.pl
- feature: jsonlist command from Martin (contrib/JsonList)
- feature: contrib/rotateShiftWork from Martin
- feature: contrib/fhem2speech from Martin
- bugfix: attributes of at devices disappear
- feature: attribute rainadjustment for KS300 (Boris 2008-12-17)
- bugfix: deleting at / watchdog while active creates an empty device
- feature: ExactId trigger added for wildcard HMS devices
- 2008-08-04 (4.4)
- feature: RM100-2 battery empty warning (mare 23.07.08)
- feature: optimising the pgm2/SVG memory usage
- feature: autoloading FHEM modules
- bugfix: STATE/$value is carrying again the correct value
- feature: enhancing the Makefile and the documentation
- feature: 90_at is using now InternalTimer, subsecond precision added
- feature: HMS100-FIT added (01.01.08 by Peter and 22.01.08 by Juergen)
- feature: 91_watchdog added to handle the HMS100-FIT
- feature: cum_kWh/cum_m3 added to EMWZ/EMGZ (11.01.08 by Peter)
- 2008-07-12 (4.3)
- bugfix: KS300 state was wrong after the STATE bugfix
- feature: HMS100CO (by Peter)
- feature: EMGZ (by Peter)
- feature: Generate warning if too many commands were sent in the last hour
- doc: linux.html: Introduction (Peter S.)
- feature: contrib/82_M232Voltage.pm (by Boris, 24.12)
- feature: delattr renamed to deleteattr (Rudi, 29.12)
- feature: defattr renamed to setdefaultattr (Rudi, 29.12)
- feature: device spec (list/range/regexp) for most commands implemented
- feature: %NAME, %EVENT, %TYPE parameters in notify definition
- feature: added 93_DbLog.pm, database logging facility (Boris, 30.12.)
- feature: webfrontend/pgm2 converted to a FHEM module
- bugfix: 99_SUNRISE_EL.pm: may schedule double events
- bugfix: 62_EMEM.pl, contrib/em1010.pl: correct readings for energy_kWh
and energy_kWh_w (Boris, 06.01.08)
- feature: global attr allowfrom, as wished by Holger (8.1.2008)
- feature: FHT: multiple commands, softbuffer changes, cmd rename, doc
- feature: EM1010PC: automatic reset
- feature: contrib/00_LIRC.pm (25.3, by Bernhard)
- bugfix : 00_FHZ: additional stty settings for strange Linux versions
- bugfix : pgm2 wrong temp summary for FHT's (reported by O.D., 16.4.2008)
- feature: FHEM modules may live on a filesystem with "ignorant" casing (FAT)
- feature: FileLog "set reopen" for manual tweaking of logfiles.
- feature: multiline commands are supported through the command line
- feature: pgm2 installation changes, multiple instances, external css
- feature: 87_ws2000.pm (thomas 10.05.08)
- contrib: ws2000_reader.pl Standalone decoder and server (thomas 10.05.08)
- doc: update fhem.html and commandline.html reflecting ws2000 and
windows installation(thomas 10.05.08)
- feature: add ReadyFn to fhem.pl in main loop to have an alternative for
select, which is not working on windows (thomas 11.05)
- feature: set timeout to 0.2s, if HandleTimeout returns undef=forever
- bugfix : WS2000:fixed serial port access on windows by replacing FD with
ReadyFn
- bugfix : FileLog: dont use FH->sync on windows (not implemented there)
- feature: EM, WS300, FHZ:Add Switch for Device::SerialPort and
Win32::SerialPort to get it running in Windows (sorry, untested)
- bugfix: FileLog undefined $data in FileLog_Get
- feature: fhem.pl check modules for compiletime errors and do not initialize
them
- feature: M232 add windows support (thomas 12.05.08)
- feature: add simple ELV IPWE1 support (thomas 12.05.08)
- feature: FileLog get to read logfiles. Used heavily by webpgm2
- feature: webpgm2: gnuplot-scroll mode to navigate/zoom in logfiles
- bugfix: deleting FS20 device won't result in unknown device (Daniel, 11.7)
- feature: webpgm2 generates SVG's from logs: no need for gnuplot
- bugfix: examples corrected to work with current syntax
- 2007-12-02 (4.2)
- feature: added archivedir/archivecmd to the the main logfile
- feature: 99_Sunrise_EL.pm (does not need any Date modules)
- bugfix: seldom xmllist error resulting in corrupt xml (Martin/Peter, 4.9)
- bugfix: FHT mode holiday_short added (9.9, Dirk)
- bugfix: Modifying a device from its own trigger crashes (Klaus, 10.9)
- feature: webpgm2 output reformatted
- feature: webpgm2 displaying multiple plots
- feature: FHT lime-protection code discovered by Dirk (7.10)
- feature: softwarebuffer for FHT devices (Dirk 17.10)
- feature: FHT low temperatur warning and offset (Dirk 17.10)
- change: change FHT state into warnings (Dirk 17.10)
NOTE: you'll get an undefined type state &
undefined type unknown_85 after upgrade.
- feature: Softwarebuffer code simplified (Rudi 22.11)
- bugfix: bug #12327 doppeltes my
- bugfix: set STATE from trigger
- bugfix: readings state vs STATE problem (xmllist/trigger)
- change: SUNRISE doc changed (99_SUNRISE.pm -> 99_SUNRISE_EL.pm)
- feature: support for the M232 ELV device (Boris, 25.11)
- feature: alternativ Quad-based numbers for the FS20 (Matthias, 24.11)
- feature: dummy type added (contrib/99_dummy.pm)
- 2007-08-05 (4.1)
- doc: linux.html (private udev-rules, not 50-..., ATTRS)
- bugfix: setting devices with "-" in their name did not work
- doc: fhem.pl and commandref.html (notifyon -> notify, correction
of examples)
- feature: modify command added
- feature: The "-" in the name is not allowed any more
- bugfix: disabled notify causes "uninitialized value" (STefan, 1.5)
- bugfix: deleted FS20 items are still logging (zombie) (Gerhard, 16.5)
- bugfix: added FS20S8, removed stty_parmrk (Martin, 24.5)
- feature: added archivedir/archivecmd to the FileLog
- feature: added EM1010PC/EM1000WZ/EM1000EM support
- bugfix: undefined messages for unknown HMS devs (Peter, 8.6)
- bugfix: em1010 and %oldvalue bugs (Peter, 9.6)
- bugfix: SCIVT solar controller (peterp, 1.7)
- bugfix: WS300 loglevel change (from 2 to 5 or device specific loglevel)
- feature: First steps for a Fritz!Box port. See the fritzbox.html
- 2007-04-14 (4.0)
- bugfix: deny at +{3}... (only +*{3} allowed), reported by Bernd, 25.01
- bugfix: allow numbers greater then 9 in at +{<number>}
- feature: new 50_WS300.pm from Martin (bugfix + rain statistics, 26.01)
- feature: renamed fhz1000 to fhem
- feature: added HISTORY and README.DEV
- doc: Added description of attribute "model".
- bugfix: delete the pidfile when terminating. (reported by Martin and Peter)
- feature: attribute showtime in web-pgm2 (show time instead of state)
- feature: defattr (default attribute for following defines)
- feature: added em1010.pl to the contrib directory
- doc: added linux.html (multiple devices, udev-links)
- REORGANIZATION:
- at/notify "renamed" to "define <name> at/notify"
- logfile/modpath/pidfile/port/verbose "renamed" to "attr global xxx"
- savefile renamed to "attr global statefile"
- save command added, it writes the configfile and the statefile
- delattr added
- list/xmllist format changed
- disable attribute for at/notify/filelog
See HISTORY for details and reasoning
- added rename command
- webpgm2 adapted to the new syntax, added device specific attribute
and "set" support, gnuplot files are configurable, links to the
documentation added.
- bugfix: more thorough serial line initialization
- 2007-01-25 (3.3)
- bugfix: 50_WS300.pm fix from Martin
- bugfix: pidfile does not work as expected (reported by Martin)
- bugfix: %U in the log-filename is wrong (bugreport by Juergen)
- feature: %V added to the log-filename
- feature: KS300 wind calibration possibility added
- feature: (software) filtering repeater messages (suggested by Martin)
- feature: the "client" fhz1000.pl can address another host
- bugfix: empty FHT battery is not reported (by Holger)
- feature: new FHT codes, e.g. month/day/hour/minute setting (by Holger)
- 2007-01-14 (3.2)
- bugfix: example $state changed to $value (remco)
- bugfix: sun*_rel does not work correctly with offset (Sebastian)
- feature: new HMS100TF codes (Sebastian)
- feature: logging unknown HMS with both unique and class ID (Sebastian)
- feature: WS300: "Wetter-Willi-Status", rain_raw/rain_cum added, historic
data (changes by Martin & Markus)
- bugfix: broken rereadcfg / CommandChain after init
(reported by Sebastian and Peter)
- bugfix: sunrise_coord returned "3", which is irritating
- 2007-01-08 (3.1)
- bugfix: delete checks the arg first "exactly", then as a regexp
- bugfix: sun*_rel does not work correctly with offset (Martin)
- feature: FAQ entry on how to install the sunrise stuff.
- feature: the inner core is modified to be able to handle
more than one "IO" device, i.e multiple FHZ at the same time,
or FHZ + FS10 + WS300. Consequences:
- "fhzdev <usbdevice>" replaced with "define <FHZNAME> FHZ <usbdevice>"
- "sendraw <fn> <code>" replaced with "set <FHZNAME> raw <fn> <code>"
- module function parameters changed (for module developers)
- set FHZ activefor dev
- select instead sleep after sending FHZ commands
- the at timer is more exact (around 1msec instead of 1 sec)
- ignoring FS20 device 0001/00/00
- feature: contrib/serial.pm to debug serial devices.
- feature: WS300 integrated: no external program needed (Martin)
- feature: updated to pgm3-0.7.0, see the CHANGELOG at Martins site
- 2006-12-28 (3.0)
- bugfix: KS300: Make the temperature negative, not the humidity
- bugfix: generate correct xmllist even with fhzdev none (Martin, 12.12)
- feature: one set command can handle multiple devices (range and enumeration)
- feature: new FS20 command on-till
- feature: perl: the current state is stored in the %value hash
- feature: perl: sunset renamed to sunset_rel, sunset_abs added (for on-till)
- feature: perl: isday function added
- feature: follow-on-for-timer attribute added to set the state to off
- bugfix: the ws300pc negative-temp bugfix included (from Martin Klerx)
- feature: version 0.6.2 of the webpgm3 included (from Martin Haas)
- 2006-11-27 (2.9a)
- bugfix: FileLog+Unknown device generates undefined messages
- bugfix: trigger with unknown device generates undefined messages
- 2006-11-19 (2.9)
- bugfix: fhz1000.pl dies at startup if the savefile does not exist
- bugfix: oldvalue hash is not initialized at startup (peter, Nov 09)
- feature: Notify reorganization (requested by juergen and matthias) :
- inform will be notified on both real events and set or trigger commands
- filelogs will additionally be notified on set or trigger commands
- the extra_notify flag is gone: it is default now, there is a
do_not_notify flag for the opposite behaviour.
- feature: at timespec as a function. Example: at +*{sunset()}
commandref.html and examples revisited.
- feature: 99_SUNRISE.pm added to use with the new at functionality
(replaces the old 99_SUNSET.pm)
- feature: webpgm2 "everything" room, at/notify section, arbitrary command
- bugfix: resetting the KS300
- feature: updated ws300pc (from martin klerx, Nov 08)
- bugfix: parsing timed commands implemented => thermo-off,thermo-on and
activate replaced with timed off-for-timer,on-for-timer and
on-old-for-timer (reported by martin klerx, Nov 08)
- feature: pidfile (requested by peter, Nov 10)
- bugfix: function 81 is not allowed
- 2006-11-08 (2.8)
- feature: store oldvalue for triggers. perl only. requested by peter.
- feature: inform cmd. Patch by Martin. There are many Martins around here :-)
- bugfix: XML: fix & and < and co
- bugfix: Accept KS300 negative temperature values
- change: the FS20 msg "rain-msg" is called now "activate"
- feature: start/stop rc script from Stefan (in the contrib directory)
- feature: attribute extra_notify: setting the device will trigger a notify
- feature: optional repeat count for the at command
- feature: skip_next attribute for the at command
- feature: WS300 support by Martin. Check the contrib/ws300 directory.
- bugfix: 91_DbLog.pm: retry if the connection is broken by Peter
- feature: Martin's pgm3-0.5.2 (see the CHANGELOG on his webpage)
- feature: RRD logging example by Peter (in the contrib/rrd directory)
- 2006-10-03 (2.7)
- bugfix: Another try on the > 25.5 problem. (Peters suggestion)
- feature: 99_ALARM.pm from Martin (in the contrib directory)
- feature: HMS100TFK von Peter P.
- feature: attribute loglevel
- feature: attribute dummy
- feature: attr command documented
- feature: the current version (0.5a) of the pgm3 from Martin.
- 2006-09-13 (2.6a)
- bugfix: the FHT > 25.5 problem again. A never ending story.
- 2006-09-08 (2.6)
- bugfix: updated the examples (hint from Juergen)
- bugfix: leading and trailing whitespaces in commands are ignored now
- feature: making life easier for perl oneliners: see commandref.html
(motivated by STefans suggestions)
- feature: include command and multiline commands in the configfiles (\)
- bugfix: web/pgm2 KS300 rain plot knows about the avg data
- bugfix: the FHT > 25.5 problem. Needs to be tested.
- feature: log unknown devices (peters idea, see notifyon description)
- feature: HMS wildcard device id for all HMS devices. See the define/HMS
section in the commandref.html for details.
NOTE: the wildcard for RM100-2 changed from 1001 to 1003.
(peters idea)
- feature: rolwzo_no_off.sh contrib file (for those who were already closed
out by automatically closing rollades, by Martin)
- feature: the current version (0.4.5) of the pgm3 from Martin.
- 2006-08-13 (2.5)
Special thanks to STefan Mayer for a lot of suggestions and bug reports
- If a command is enclosed in {}, then it will be evaluated as a perl
expression, if it is enclosed in "" then it is a shell command, else it is
a "normal" fhz1000 command.
"at" and "notifyon" follow this convention too.
Note: a shell command will always be issued in the background.
- won't die anymore if the at spec contains an unknown command
- rereadcfg added. Sending a HUP should work better now
- escaping % and @ in the notify argument is now possible with %% or @@
- new command trigger to test notify commands
- where you could specify an fhz command, now you can specify a list of
them, separated by ";". Escape is ;;
- KS300 sometimes reports "negative" rain when it begins to rain. Filter
such values. israining is set when the raincounter changed or the ks300
israining bit is set.
- sleep command, with millisecond accuracy
- HMS 100MG support by Peter Stark.
- Making FHT and FS20 messages more uniform
- contrib/fs20_holidays.sh by STefan Mayer
(simulate presence while on holiday)
- webfrontends/pgm4 by STefan Mayer: fs20.php
- KS300 avg. monthly values fixed (hopefully)
- deleted undocumented "exec" function (you can write it now as {...})
- 2006-07-23 (2.4)
- contrib/four2hex (to convert between ELV and our codes) by Peter Stark
- make dist added to set version (it won't work in a released version)
- reload function to reload (private) perl modules
- 20_FHT.pm fix: undef occures once without old data
- "setstate comment" is replaced with the attr command (i.e. attribute).
The corresponding xmllist COMMENT tag is replaced with the ATTR tag.
Devices or logs can have attr definitions.
- webfrontend/pgm2 (fhzweb.pl) updated to handle "room" attributes(showing
only devices in this room).
- version 0.4.2 of webfrontend/pgm3 integrated.
- contrib/ks300avg.pl to compute daily and monthly avarage values.
- the 40_KS300.pm module is computing daily and monthly avarages for the
temp/hum and wind values and sum of the rain. The cum_day and cum_month
state variables are used as helper values. To log the avarage use the
.*avg.* regexp. The regexp for the intraday log will trigger it also.
- Added the contrib file garden.pl as a more complex example: garden
irrigation. The program computes the time for irrigation from the avarage
temperature reported by the ks300-2.
- Enable uppercase hex codes (Bug reported by STefan Mayer)
- Renamed the unknown_XX FHT80b codes to code_XXXXXX, this will produce
"Undefined type" messages when reading the old save file
- RM100-2 added (thanks for the codes from andikt).
- 2006-6-22 (2.3)
- CRC checking (i.e. ignoring messages with bad CRC, message on verbose 4)
- contrib/checkmesg.pl added to check message consistency (debugging)
- FHT: unknown_aa, unknown_ba codes added. What they are for?
- Empty modpath / no modpath error messages added (some user think modpath is
superfluous)
- Unparsed messages (verbose 5) now printed as hex
- Try to reattach to the usb device if it disappears: no need to
restart the server if the device is pulled out from the USB socket and
plugged in again (old versions go into a busy loop here).
- Supressing the seldom (ca 1 out of 700) short KS300 messages.
(not sure how to interpret them)
- Added KS300 "israining" status flag. Note: this not always triggers when it
is raining, but there seems to be a correlation. To be evaluated in more
detail.
- notifyon can now execute "private" perl code as well (updated
commandref.html, added the file example/99_PRIV.pm)
- another "perl code" example is logging the data into the database
(with DBI), see the file contrib/91_DbLog.pm. Tested with an Oracle DB.
- logs added to the xmllist
- FHT80b: Fix measured-temp over 25.5 (handling the tempadd messages better)
- 2006-05-20 (2.2)
- FHZ1300 support verified (+ doc changes)
- KS300 support added (with Temperature, Humidity, Wind speed, Rain).
Not verified/undecoded: subzero temp, weak battery, Is-raining flag,
wind speed > 100km/h
- webpgm2 log fix for "offed" FHT devices (with no actuator data)
- webpgm3 upgrade (by Martin Haas, see webpgm/pgm3/docs/CHANGES for details)
- HMS logging/state format changed to make it similar to KS300
- added HMS100WD (thanks to Sascha Pollok)
- ntfy/logging changed to be able to notify for multiple attributes
arriving in one message
- central FHTcode settable (see commandref.html)
- optionally listen for non-local requests (port <num> global)
- unknown logging
- FAQ
- 2006-04-15 (2.1)
- webfrontend/pgm2 changes:
- make it work on Asus dsl-routers (no "use warnings")
- css/readonly configurable
- Formatting for HMS data
- comments can be added to each device (setstate <dev> comment:xxx)
- testbed to dry-test functionality (test directory)
- added an empty hull for the KS300 weather module
- added undocumented "exec" function to call arbitrary program parts
for debugging. Example: exec FhzDecode("81xx04xx0101a0011234030011");
- webfrontend/pgm3, contributed by Martin Haas
- fixed pgm1: changing values should work now
- 2006-04-02 (2.0)
- XmlList and webfrontend/pgm1 programs from Raoul Matthiessen
- list tries to display the state and not the last command
- Both log facilities (FileLog and Log) take wildcards
(week, year, month, etc) to make logfile rotating easier
- webfrontend/pgm2
- 2006-02-12 (1.9b)
- Bugfix: Fixing the same bug again (thanks to Martin)
- 2006-02-12 (1.9a)
- Bugfix: wrong rights for HMS and wrong place for readonly
(thanks to Juergen)
- 2006-02-10 (1.9)
(aka as the Juergen release)
- The FHZ1300 is reported to work
- Bugfix: spaces before comment in the config file should be ignored
- added FS20STR codes to 10_FS20.pm
- names restricted to A-Za-z0-9.:- (especially _ is not allowed)
- delete calles now an UndefFn in the module
- implementation of FS20 function group/local master/global master
- the list command tells you the definition of the device too
- 2006-01-05 (1.8)
- Bugfix: detailed FS20 status was not set from external event
- Bugfix: setstate for FS20 returned the last state set
- Bugfix: undefined FS20 devices (can) crash the server
- HMS module added by Martin Mueller
(currently supporting the HMS100T & HMS100TF)
- Log modules added, the first one being a simple FileLog
(inspired by Martin Mueller)
- A little gnuplot script to display temperature and actuator changes
- 2006-01-04 (1.7)
- the at command can be used to execute something repeatedly with *
- ntfy can filter on device or on device+event with a regexp
- checking the delete and notify regexps if they make sense
- the FHT init string is now a set command (refreshvalues)
- shutdown saves the detailed device information too
- 2006-01-03 (1.6)
- signal handling (to save the state on shutdown)
- module FHZ addded (for the FHZ1000PC device itself)
- added the get function (to make the initialization prettier)
- the module ST was renamed to FS20
- FS20 timer commands added
- modules command removed (we are loading everything from the modpath
directory)
- FHT80b module added (yes, it is already useful, you can set
and view a lot of values)
- documentation adapted
- Added a TODO file
- 2005-12-26 (1.5)
- "modularized" in preparation for the FHT80B -> each device has a type
- added relative "at" commands (with +HH:MM:SS)
- multiple commands on one line separated with ;
- sleeping 0.22 seconds after an ST command
- some commands/syntax changed:
- switch => set
- device => fhzdevice
- define <name> ... => define <name> <type> ...
- the state of the devices and the at commands are saved
- at start always sending a "set 0001 00 01" to enable the FHZ receiever.
This is a workaround.
- doc rewrite, examples directory
- 2005-11-10 (1.4)
- Reformatting the package and the documentation
- New links
- 2005-10-27 (1.3)
- Bugfix: multiple at commands at the same time.

743
fhem/FHEM/00_CM11.pm
View File

@ -1,743 +0,0 @@
################################################################
#
# Copyright notice
#
# (c) 2008 Dr. Boris Neubert (omega@online.de)
#
# 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.
# 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!
#
################################################################
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
sub CM11_Write($$$);
sub CM11_Read($);
sub CM11_Ready($$);
my $msg_pollpc = pack("H*", "5a"); # interface poll signal (CM11->PC)
my $msg_pollpcpf = pack("H*", "a5"); # power fail poll signal (CM11->PC)
my $msg_pollack = pack("H*", "c3"); # response to poll signal (PC->CM11)
my $msg_pollackpf= pack("H*", "fb"); # response to power fail poll signal (PC->CM11)
my $msg_txok = pack("H*", "00"); # OK for transmission (PC->CM11)
my $msg_ifrdy = pack("H*", "55"); # interface ready (CM11->PC)
my $msg_statusrq = pack("H*", "8b"); # status request (PC->CM11)
my %housecodes_rcv = qw(0110 A 1110 B 0010 C 1010 D
0001 E 1001 F 0101 G 1101 H
0111 I 1111 J 0011 K 1011 L
0000 M 1000 N 0100 O 1100 P);
my %unitcodes_rcv = qw(0110 1 1110 2 0010 3 1010 4
0001 5 1001 6 0101 7 1101 8
0111 9 1111 10 0011 11 1011 12
0000 13 1000 14 0100 15 1100 16);
my %functions_rcv = qw(0000 ALL_UNITS_OFF
0001 ALL_LIGHTS_ON
0010 ON
0011 OFF
0100 DIM
0101 BRIGHT
0110 ALL_LIGHTS_OFF
0111 EXTENDED_CODE
1000 HAIL_REQUEST
1001 HAIL_ACK
1010 PRESET_DIM1
1011 PRESET_DIM2
1100 EXTENDED_DATA_TRANSFER
1101 STATUS_ON
1110 STATUS_OFF
1111 STATUS_REQUEST);
my %gets = (
"fwrev" => "xxx",
"time" => "xxx",
);
my %sets = (
"reopen" => "xxx",
);
#####################################
sub
CM11_Initialize($)
{
my ($hash) = @_;
# Provider
$hash->{ReadFn} = "CM11_Read";
$hash->{WriteFn} = "CM11_Write";
$hash->{Clients} = ":X10:";
$hash->{ReadyFn} = "CM11_Ready";
# Normal Device
$hash->{DefFn} = "CM11_Define";
$hash->{UndefFn} = "CM11_Undef";
$hash->{GetFn} = "CM11_Get";
$hash->{SetFn} = "CM11_Set";
$hash->{StateFn} = "CM11_SetState";
$hash->{AttrList}= "do_not_notify:1,0 dummy:1,0 " .
"model:CM11 loglevel:0,1,2,3,4,5,6";
}
#####################################
sub
CM11_DoInit($$$)
{
my ($name,$type,$po) = @_;
my @init;
$po->reset_error();
$po->baudrate(4800);
$po->databits(8);
$po->parity('none');
$po->stopbits(1);
$po->handshake('none');
if($type && $type eq "strangetty") {
# 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;
$defs{$name}{STATE} = "Initialized";
}
#####################################
sub
CM11_Reopen($)
{
my ($hash) = @_;
my $dev = $hash->{DeviceName};
$hash->{PortObj}->close();
Log 1, "Device $dev closed";
for(;;) {
sleep(5);
if($^O =~ m/Win/) {
$hash->{PortObj} = new Win32::SerialPort($dev);
}else{
$hash->{PortObj} = new Device::SerialPort($dev);
}
if($hash->{PortObj}) {
Log 1, "Device $dev reopened";
$hash->{FD} = $hash->{PortObj}->FILENO if($^O !~ m/Win/);
CM11_DoInit($hash->{NAME}, $hash->{ttytype}, $hash->{PortObj});
return;
}
}
}
#####################################
sub
CM11_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $po;
return "wrong syntax: define <name> CM11 devicename ".
"[normal|strangetty] [mobile]" if(@a < 3 || @a > 5);
delete $hash->{PortObj};
delete $hash->{FD};
my $name = $a[0];
my $dev = $a[2];
$hash->{ttytype} = $a[3] if($a[3]);
$hash->{MOBILE} = 1 if($a[4] && $a[4] eq "mobile");
$hash->{STATE} = "defined";
if($dev eq "none") {
Log 1, "CM11 device is none, commands will be echoed only";
$attr{$name}{dummy} = 1;
return undef;
}
$hash->{DeviceName} = $dev;
$hash->{PARTIAL} = "";
Log 3, "CM11 opening CM11 device $dev";
if ($^O=~/Win/) {
require Win32::SerialPort;
$po = new Win32::SerialPort ($dev);
} else {
require Device::SerialPort;
$po = new Device::SerialPort ($dev);
}
if(!$po) {
my $msg = "Can't open $dev: $!";
Log(3, $msg) if($hash->{MOBILE});
return $msg if(!$hash->{MOBILE});
$readyfnlist{"$name.$dev"} = $hash;
return "";
}
Log 3, "CM11 opened CM11 device $dev";
$hash->{PortObj} = $po;
if( $^O !~ /Win/ ) {
$hash->{FD} = $po->FILENO;
$selectlist{"$name.$dev"} = $hash;
} else {
$readyfnlist{"$name.$dev"} = $hash;
}
CM11_DoInit($name, $hash->{ttytype}, $po);
#CM11_SetInterfaceTime($hash);
#CM11_GetInterfaceStatus($hash);
return undef;
}
#####################################
sub
CM11_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};
}
}
$hash->{PortObj}->close() if($hash->{PortObj});
return undef;
}
#####################################
sub
CM11_SetState($$$$)
{
my ($hash, $tim, $vt, $val) = @_;
return undef;
}
#####################################
sub
CM11_LogReadWrite($@)
{
my ($rw,$hash, $msg, $trlr) = @_;
my $name= $hash->{NAME};
Log GetLogLevel($name,5),
"CM11 device " . $name . ": $rw " .
sprintf("%2d: ", length($msg)) . unpack("H*", $msg);
}
sub
CM11_LogRead(@)
{
CM11_LogReadWrite("read ", @_);
}
sub
CM11_LogWrite(@)
{
CM11_LogReadWrite("write", @_);
}
#####################################
sub
CM11_SimpleWrite($$)
{
my ($hash, $msg) = @_;
return if(!$hash || !defined($hash->{PortObj}));
CM11_LogWrite($hash,$msg);
$hash->{PortObj}->write($msg);
}
#####################################
sub
CM11_ReadDirect($$)
{
# This is a direct read for CM11_Write
my ($hash,$arg) = @_;
return undef if(!$hash || !defined($hash->{FD}));
my $name= $hash->{NAME};
my $prefix= "CM11 device " . $name . ":";
my $rin= '';
my $nfound;
if($^O eq 'MSWin32') {
$nfound= CM11_Ready($hash, undef);
} else {
vec($rin, $hash->{FD}, 1) = 1;
my $to = 20; # seconds timeout (response might be damn slow)
$to = $hash->{RA_Timeout} if($hash->{RA_Timeout}); # ...or less
$nfound = select($rin, undef, undef, $to);
if($nfound < 0) {
next if ($! == EAGAIN() || $! == EINTR() || $! == 0);
Log GetLogLevel($name,3), "$prefix Select error $nfound / $!";
return undef;
}
}
if(!$nfound) {
Log GetLogLevel($name,3), "$prefix Timeout reading $arg";
return undef;
}
my $buf = $hash->{PortObj}->input();
CM11_LogRead($hash,$buf);
return $buf;
}
#####################################
sub
CM11_Write($$$)
{
# send two bytes, verify checksum, send ok
my ($hash,$b1,$b2) = @_;
my $name = $hash->{NAME};
my $prefix= "CM11 device $name:";
if(!$hash || !defined($hash->{PortObj})) {
Log GetLogLevel($name,3),
"$prefix device is not active, cannot send";
return;
}
# checksum
my $b1d = unpack('C', $b1);
my $b2d = unpack('C', $b2);
my $checksum_w = ($b1d + $b2d) & 0xff;
my $data;
# try 5 times to send
my $try= 5;
for(;;) {
$try--;
# send two bytes
$data= $b1 . $b2;
CM11_LogWrite($hash,$data);
$hash->{PortObj}->write($data);
# get checksum
my $checksum= CM11_ReadDirect($hash, "checksum");
return 0 if(!defined($checksum)); # read failure
my $checksum_r= unpack('C', $checksum);
if($checksum_w ne $checksum_r) {
Log 5,
"$prefix wrong checksum (send: $checksum_w, received: $checksum_r)";
return 0 if(!$try);
my $nexttry= 6-$try;
Log 5,
"$prefix retrying (" . $nexttry . "/5)";
} else {
Log 5, "$prefix checksum correct, OK for transmission";
last;
}
}
# checksum ok => send OK for transmission
$data= $msg_txok;
CM11_LogWrite($hash,$data);
$hash->{PortObj}->write($data);
my $ready= CM11_ReadDirect($hash, "ready");
return 0 if(!defined($ready)); # read failure
if($ready ne $msg_ifrdy) {
Log GetLogLevel($name,3),
"$prefix strange ready signal (" . unpack('C', $ready) . ")";
return 0
} else {
Log 5, "$prefix ready";
}
# we are fine
return 1;
}
#####################################
sub
CM11_GetInterfaceStatus($)
{
my ($hash)= @_;
CM11_SimpleWrite($hash, $msg_statusrq);
my $statusmsg= "";
while(length($statusmsg)<14) {
my $buf= CM11_ReadDirect($hash, "status");
return if(!defined($buf)); # read error
$statusmsg.= $buf;
}
return $statusmsg;
}
#####################################
sub CM11_Get($@)
{
my ($hash, @a) = @_;
return "CM11: get needs only one parameter" if(@a != 2);
return "Unknown argument $a[1], choose one of " . join(",", sort keys %gets)
if(!defined($gets{$a[1]}));
my ($fn, $arg) = split(" ", $gets{$a[1]});
my $v = join(" ", @a);
my $name = $hash->{NAME};
Log GetLogLevel($name,2), "CM11 get $v";
my $statusmsg= CM11_GetInterfaceStatus($hash);
if(!defined($statusmsg)) {
$v= "error";
Log 2, "CM11 error, device is irresponsive."
} else {
my $msg= unpack("H*", $statusmsg);
Log 5, "CM11 got ". $msg;
if($a[1] eq "fwrev") {
$v = hex(substr($msg, 14, 1));
} elsif($a[1] eq "time") {
my $sec= hex(substr($msg, 4, 2));
my $hour= hex(substr($msg, 8, 2))*2;
my $min= hex(substr($msg, 6, 2));
if($min>59) {
$min-= 60;
$hour++;
}
my $day= hex(substr($msg, 10, 2));
$day+= 256 if(hex(substr($msg, 12, 1)) & 0xf);
$v= sprintf("%d.%02d:%02d:%02d", $day,$hour,$min,$sec);
}
}
$hash->{READINGS}{$a[1]}{VAL} = $v;
$hash->{READINGS}{$a[1]}{TIME} = TimeNow();
return "$a[0] $a[1] => $v";
}
#####################################
sub
CM11_Set($@)
{
my ($hash, @a) = @_;
return "CM11: set needs one parameter" if(@a != 2);
return "Unknown argument $a[1], choose one of " . join(" ", sort keys %sets)
if(!defined($sets{$a[1]}));
my ($fn, $arg) = split(" ", $sets{$a[1]});
my $v = join(" ", @a);
my $name = $hash->{NAME};
Log GetLogLevel($name,2), "CM11 set $v";
if($a[1] eq "reopen") {
CM11_Reopen($hash);
}
return undef;
}
#####################################
sub
CM11_SetInterfaceTime($)
{
my ($hash)= @_;
# 7 Bytes, Bits 0..55 are
# 55 to 48 timer download header (0x9b)
# 47 to 40 Current time (seconds)
# 39 to 32 Current time (minutes ranging from 0 to 119)
# 31 to 23 Current time (hours/2, ranging from 0 to 11)
# 23 to 16 Current year day (bits 0 to 7)
# 15 Current year day (bit 8)
# 14 to 8 Day mask (SMTWTFS)
# 7 to 4 Monitored house code
# 3 Reserved
# 2 Battery timer clear flag
# 1 Monitored status clear flag
# 0 Timer purge flag
# make the interface happy (time is set to zero)
my $data = pack('C7', 0x9b,0x00,0x00,0x00,0x00,0x00,0x03);
CM11_SimpleWrite($hash, $data);
# get checksum (ignored)
my $checksum= CM11_ReadDirect($hash, "checksum");
return 0 if(!defined($checksum)); # read failure
# tx OK
CM11_SimpleWrite($hash, $msg_txok);
# get ready (ignored)
my $ready= CM11_ReadDirect($hash, "ready");
return 0 if(!defined($ready)); # read failure
return 1;
}
#####################################
sub
CM11_Read($)
{
#
# prolog
#
my ($hash) = @_;
my $buf = $hash->{PortObj}->input();
my $name = $hash->{NAME};
# prefix for logging
my $prefix= "CM11 device " . $name . ":";
# Lets' try again: Some drivers return len(0) on the first read...
if(defined($buf) && length($buf) == 0) {
$buf = $hash->{PortObj}->input();
}
# USB troubleshooting
if(!defined($buf) || length($buf) == 0) {
my $dev = $hash->{DeviceName};
Log 1, "USB device $dev disconnected, waiting to reappear";
$hash->{PortObj}->close();
DoTrigger($name, "DISCONNECTED");
delete($hash->{PortObj});
delete($selectlist{"$name.$dev"});
$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);
}
#
# begin of message digesting
#
# concatenate yet unparsed message and newly received data
my $x10data = $hash->{PARTIAL} . $buf;
CM11_LogRead($hash,$buf);
Log 5, "$prefix Data: " . unpack('H*',$x10data);
# normally the while loop will run only once
while(length($x10data) > 0) {
# we cut off everything before the latest poll signal
my $p= index(reverse($x10data), $msg_pollpc);
if($p<0) { $p= index(reverse($x10data), $msg_pollpcpf); }
if($p>=0) { $x10data= substr($x10data, -$p-1); }
# to start with, a single 0x5a is received
if( substr($x10data,0,1) eq $msg_pollpc ) { # CM11 polls PC
Log 5, "$prefix start of message";
CM11_SimpleWrite($hash, $msg_pollack); # PC ready
$x10data= substr($x10data,1); # $x10data now empty
next;
}
# experimental code follows
#if( substr($x10data,0,2) eq pack("H*", "98e6") ) { # CM11 polls PC
# Log 5, "$prefix 98e6";
# CM11_SimpleWrite($hash, $msg_pollack); # PC ready
# $x10data= "";
# next;
#}
#if( substr($x10data,0,1) eq pack("H*", "98") ) { # CM11 polls PC
# Log 5, "$prefix 98";
# next;
#}
# a single 0xa5 is a power-fail macro download poll
if( substr($x10data,0,1) eq $msg_pollpcpf ) { # CM11 polls PC
Log 5, "$prefix power-fail poll";
# the documentation wrongly says that the macros should be downloaded
# in fact, the time must be set!
if(CM11_SetInterfaceTime($hash)) {
Log 5, "$prefix power-fail poll satisfied";
} else {
Log 5, "$prefix power-fail poll satisfaction failed";
}
$x10data= substr($x10data,1); # $x10data now empty
next;
}
# a single 0x55 is a leftover from a failed transmission
if( substr($x10data,0,1) eq $msg_ifrdy ) { # CM11 polls PC
Log 5, "$prefix skipping leftover ready signal";
$x10data= substr($x10data,1);
next;
}
# the message comes in small chunks of 1 or few bytes instead of the
# whole buffer at once
my $len= ord(substr($x10data,0,1))-1; # upload buffer size
last if(length($x10data)< $len+2); # wait for complete msg
# message is now complete, start interpretation
# mask: Bits 0 (LSB)..7 (MSB) correspond to data bytes 0..7
# bit= 0: unitcode, bit= 1: function
my $mask= unpack('B8', substr($x10data,1,1));
$x10data= substr($x10data,2); # cut off length and mask
# $x10data now contains $len data bytes
my $databytes= unpack('H*', substr($x10data,0));
Log 5, "$prefix message complete " .
"(length $len, mask $mask, data $databytes)";
# the following lines decode the messages into unitcodes and functions
# in general we have 0..n unitcodes followed by 1..m functions in the
# message
my $i= 0;
my $dmsg= "";
while($i< $len) {
my $data= substr($x10data, $i);
my $bits = unpack('B8', $data);
my $nibble_hi = substr($bits, 0, 4);
my $nibble_lo = substr($bits, 4, 4);
my $housecode= $housecodes_rcv{$nibble_hi};
# one hash for unitcodes X_UNIT and one hash for functions
# X_FUNC is maintained per housecode X= A..P
my $housecode_unit= $housecode . "_UNIT";
my $housecode_func= $housecode . "_FUNC";
my $isfunc= (substr($mask, -$i-1, 1));
if($isfunc) {
# data byte is function
my $x10func= $functions_rcv{$nibble_lo};
if(($x10func eq "DIM") || ($x10func eq "BRIGHT")) {
my $level= ord(substr($x10data, ++$i));
$x10func.= " $level";
}
elsif($x10func eq "EXTENDED_DATA_TRANSFER") {
$data= substr($x10data, 2+(++$i));
my $command= substr($x10data, ++$i);
$x10func.= unpack("H*", $data) . ":" .
unpack("H*", $command);
}
$hash->{$housecode_func}= $x10func;
Log 5, "$prefix $housecode_func: " .
$hash->{$housecode_func};
# dispatch message to clients
my $hu = $hash->{$housecode_unit};
$hu= "" unless(defined($hu));
my $hf = $hash->{$housecode_func};
my $dmsg= "X10:$housecode;$hu;$hf";
Dispatch($hash, $dmsg, undef);
} else {
# data byte is unitcode
# if a command was executed before, clear unitcode list
if(defined($hash->{$housecode_func})) {
undef $hash->{$housecode_unit};
undef $hash->{$housecode_func};
}
# get unitcode of unitcode
my $unitcode= $unitcodes_rcv{$nibble_lo};
# append to list of unitcodes
my $unitcodes= $hash->{$housecode_unit};
if(defined($hash->{$housecode_unit})) {
$unitcodes= $hash->{$housecode_unit} . " ";
} else {
$unitcodes= "";
}
$hash->{$housecode_unit}= "$unitcodes$unitcode";
Log 5, "$prefix $housecode_unit: " .
$hash->{$housecode_unit};
}
$i++;
}
$x10data= '';
}
$hash->{PARTIAL} = $x10data;
}
#####################################
sub
CM11_Ready($$)
{
my ($hash, $dev) = @_;
my $po=$hash->{PortObj};
if(!$po) { # Looking for the device
my $dev = $hash->{DeviceName};
my $name = $hash->{NAME};
$hash->{PARTIAL} = "";
if ($^O=~/Win/) {
$po = new Win32::SerialPort ($dev);
} else {
$po = new Device::SerialPort ($dev);
}
return undef if(!$po);
Log 1, "USB device $dev reappeared";
$hash->{PortObj} = $po;
if( $^O !~ /Win/ ) {
$hash->{FD} = $po->FILENO;
delete($readyfnlist{"$name.$dev"});
$selectlist{"$name.$dev"} = $hash;
} else {
$readyfnlist{"$name.$dev"} = $hash;
}
CM11_DoInit($name, $hash->{ttytype}, $po);
DoTrigger($name, "CONNECTED");
return undef;
}
# This is relevant for windows only
return undef if !$po;
my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags)=$po->status;
return ($InBytes>0);
}
1;

1175
fhem/FHEM/00_CUL.pm
View File

File diff suppressed because it is too large Load Diff

798
fhem/FHEM/00_FHZ.pm
View File

@ -1,798 +0,0 @@
##############################################
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
sub FHZ_Write($$$);
sub FHZ_Read($);
sub FHZ_ReadAnswer($$$);
sub FHZ_Crc(@);
sub FHZ_CheckCrc($);
sub FHZ_XmitLimitCheck($$);
sub FHZ_DoInit($$$);
my $msgstart = pack('H*', "81");# Every msg starts with this
# See also "FHZ1000 Protocol" http://fhz4linux.info/tiki-index.php?page=FHZ1000%20Protocol
# NOTE: for protocol analysis, especially the "serial" vs. "FHTcode" case
# is interestingly different yet similar:
# - code 0x84 (FHZ area) vs. 0x83 (FHT area),
# - register 0x57, _read_ vs. 0x9e, _write_ (hmm, or is this "house code" 0x9e01?)
# - _read_ 8 nibbles (4 bytes serial), _write_ 1 (1 byte FHTcode - align-corrected to two nibbles, right?)
# I did some few tests already (also scripted tests), no interesting findings so far,
# but despite that torture my 1300PC still works fine ;)
my %gets = (
"init1" => "c9 02011f64",
"init2" => "c9 02011f60",
"init3" => "c9 02011f0a",
"serial" => "04 c90184570208",
"fhtbuf" => "04 c90185", # get free FHZ memory (e.g. 23 bytes free)
# NOTE: there probably is another command to return the number of pending
# FHT msg submissions in FHZ (including last one), IOW: 1 == "empty";
# see thread "Kommunikation FHZ1000PC zum FHT80b" for clues;
# TODO: please analyze in case you use homeputer!!
);
my %sets = (
"time" => "c9 020161",
"initHMS" => "04 c90186",
"stopHMS" => "04 c90197",
"initFS20" => "04 c90196",
"initFS20_02" => "04 c9019602", # some alternate variant
"FHTcode" => "04 c901839e0101", # (parameter range 1-99, "Zentralencode" in contronics speak; randomly chosen - and forgotten!! - by FHZ, thus better manually hardcode it in fhem.cfg)
"raw" => "xx xx",
"initfull" => "xx xx",
"reopen" => "xx xx",
"close" => "xx xx",
"open" => "xx xx",
);
my %setnrparam = (
"time" => 0,
"initHMS" => 0,
"stopHMS" => 0,
"initFS20" => 0,
"initFS20_02" => 0,
"FHTcode" => 1,
"raw" => 2,
"initfull" => 0,
"reopen" => 0,
"close" => 0,
"open" => 0,
);
my %codes = (
"^8501..\$" => "fhtbuf",
);
#####################################
# Note: we are a data provider _and_ a consumer at the same time
sub
FHZ_Initialize($)
{
my ($hash) = @_;
# Provider
$hash->{ReadFn} = "FHZ_Read";
$hash->{WriteFn} = "FHZ_Write";
$hash->{Clients} = ":FHZ:FS20:FHT:HMS:KS300:USF1000:BS:";
my %mc = (
"1:USF1000" => "^81..(04|0c)..0101a001a5ceaa00....",
"2:BS" => "^81..(04|0c)..0101a001a5cf",
"3:FS20" => "^81..(04|0c)..0101a001",
"4:FHT" => "^81..(04|09|0d)..(0909a001|83098301|c409c401)..",
"5:HMS" => "^810e04....(1|5|9).a001",
"6:KS300" => "^810d04..4027a001",
);
$hash->{MatchList} = \%mc;
$hash->{ReadyFn} = "FHZ_Ready";
# Consumer
$hash->{Match} = "^81..C9..0102";
$hash->{ParseFn} = "FHZ_Parse";
# Normal devices
$hash->{DefFn} = "FHZ_Define";
$hash->{UndefFn} = "FHZ_Undef";
$hash->{GetFn} = "FHZ_Get";
$hash->{SetFn} = "FHZ_Set";
$hash->{StateFn} = "FHZ_SetState";
$hash->{AttrList}= "do_not_notify:1,0 dummy:1,0 " .
"showtime:1,0 model:fhz1000,fhz1300 loglevel:0,1,2,3,4,5,6 ".
"fhtsoftbuffer:1,0 addvaltrigger";
}
#####################################
sub
FHZ_Ready($)
{
my ($hash) = @_;
my $po=$hash->{PortObj};
if(!$po) { # Looking for the device
my $dev = $hash->{DeviceName};
my $name = $hash->{NAME};
$hash->{PARTIAL} = "";
if($^O =~ m/Win/) {
$po = new Win32::SerialPort ($dev);
} else {
$po = new Device::SerialPort ($dev);
}
return undef if(!$po);
Log 1, "USB device $dev reappeared";
$hash->{PortObj} = $po;
if($^O !~ m/Win/) {
$hash->{FD} = $po->FILENO;
delete($readyfnlist{"$name.$dev"});
$selectlist{"$name.$dev"} = $hash;
} else {
$readyfnlist{"$name.$dev"} = $hash;
}
FHZ_DoInit($name, $hash->{ttytype}, $po);
DoTrigger($name, "CONNECTED");
return undef;
}
# This is relevant for windows only
my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags)=$po->status;
return ($InBytes>0);
}
#####################################
sub
FHZ_Set($@)
{
my ($hash, @a) = @_;
return "Need one to three parameter" if(@a < 2);
return "Unknown argument $a[1], choose one of " . join(" ", sort keys %sets)
if(!defined($sets{$a[1]}));
return "Need one to three parameter" if(@a > 4);
return "Wrong number of parameters for $a[1], need " . ($setnrparam{$a[1]}+2)
if(@a != ($setnrparam{$a[1]} + 2));
my ($fn, $arg) = split(" ", $sets{$a[1]});
my $v = join(" ", @a);
my $name = $hash->{NAME};
Log GetLogLevel($name,2), "FHZ set $v";
if($a[1] eq "initfull") {
my @init;
push(@init, "get $name init2");
push(@init, "get $name serial");
push(@init, "set $name initHMS");
push(@init, "set $name initFS20");
push(@init, "set $name time");
push(@init, "set $name raw 04 01010100010000");
CommandChain(3, \@init);
return undef;
} elsif($a[1] eq "reopen") {
FHZ_Reopen($hash);
return undef;
} elsif($a[1] eq "close") {
FHZ_Close($hash);
return undef;
} elsif($a[1] eq "open") {
FHZ_Open($hash);
return undef;
} elsif($a[1] eq "raw") {
$fn = $a[2];
$arg = $a[3];
} elsif($a[1] eq "time") {
my @t = localtime;
$arg .= sprintf("%02x%02x%02x%02x%02x",
$t[5]%100, $t[4]+1, $t[3], $t[2], $t[1]);
} elsif($a[1] eq "FHTcode") {
return "invalid argument, must be hex" if(!$a[2] ||
$a[2] !~ m/^[A-F0-9]{2}$/);
$arg .= $a[2];
}
FHZ_Write($hash, $fn, $arg) if(!IsDummy($hash->{NAME}));
return undef;
}
#####################################
sub
FHZ_Get($@)
{
my ($hash, @a) = @_;
return "\"get FHZ\" needs only one parameter" if(@a != 2);
return "Unknown argument $a[1], choose one of " . join(",", sort keys %gets)
if(!defined($gets{$a[1]}));
my ($fn, $arg) = split(" ", $gets{$a[1]});
my $v = join(" ", @a);
my $name = $hash->{NAME};
Log GetLogLevel($name,2), "FHZ get $v";
FHZ_ReadAnswer($hash, "Flush", 0);
FHZ_Write($hash, $fn, $arg) if(!IsDummy($hash->{NAME}));
my $msg = FHZ_ReadAnswer($hash, $a[1], 1.0);
Log 5, "GET Got: $msg";
return $msg if(!$msg || $msg !~ /^81..c9..0102/);
if($a[1] eq "serial") {
$v = substr($msg, 22, 8)
} elsif($a[1] eq "fhtbuf") {
$v = substr($msg, 16, 2);
} else {
$v = substr($msg, 12);
}
$hash->{READINGS}{$a[1]}{VAL} = $v;
$hash->{READINGS}{$a[1]}{TIME} = TimeNow();
return "$a[0] $a[1] => $v";
}
#####################################
sub
FHZ_SetState($$$$)
{
my ($hash, $tim, $vt, $val) = @_;
return "Undefined value $vt" if(!defined($gets{$vt}));
return undef;
}
#####################################
sub
FHZ_DoInit($$$)
{
my ($name,$type,$po) = @_;
my @init;
$po->reset_error();
$po->baudrate(9600);
$po->databits(8);
$po->parity('none');
$po->stopbits(1);
$po->handshake('none');
if($type && $type eq "strangetty") {
# 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;
push(@init, "get $name init2");
push(@init, "get $name serial");
push(@init, "set $name initHMS");
push(@init, "set $name initFS20");
push(@init, "set $name time");
# Workaround: Sending "set 0001 00 off" after initialization to enable
# the fhz1000 receiver, else we won't get anything reported.
push(@init, "set $name raw 04 01010100010000");
CommandChain(3, \@init);
# Reset the counter
my $hash = $defs{$name};
delete($hash->{XMIT_TIME});
delete($hash->{NR_CMD_LAST_H});
$hash->{STATE} = "Initialized";
return undef;
}
#####################################
sub
FHZ_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $po;
return "wrong syntax: define <name> FHZ devicename ".
"[normal|strangetty] [mobile]" if(@a < 3 || @a > 5);
delete $hash->{PortObj};
delete $hash->{FD};
my $name = $a[0];
my $dev = $a[2];
$hash->{ttytype} = $a[3] if($a[3]);
$hash->{MOBILE} = 1 if($a[4] && $a[4] eq "mobile");
$hash->{STATE} = "defined";
$attr{$name}{fhtsoftbuffer} = 0;
if($dev eq "none") {
Log 1, "FHZ device is none, commands will be echoed only";
$attr{$name}{dummy} = 1;
return undef;
}
$hash->{DeviceName} = $dev;
$hash->{PARTIAL} = "";
Log 3, "FHZ opening FHZ device $dev";
if($^O =~ m/Win/) {
require Win32::SerialPort;
$po = new Win32::SerialPort ($dev);
} else {
require Device::SerialPort;
$po = new Device::SerialPort ($dev);
}
if(!$po) {
my $msg = "Can't open $dev: $!";
Log(3, $msg) if($hash->{MOBILE});
return $msg if(!$hash->{MOBILE});
$readyfnlist{"$name.$dev"} = $hash;
return "";
}
Log 3, "FHZ opened FHZ device $dev";
$hash->{PortObj} = $po;
if($^O !~ m/Win/) {
$hash->{FD} = $po->FILENO;
$selectlist{"$name.$dev"} = $hash;
} else {
$readyfnlist{"$name.$dev"} = $hash;
}
FHZ_DoInit($name, $hash->{ttytype}, $po);
return undef;
}
#####################################
sub
FHZ_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};
}
}
$hash->{PortObj}->close() if($hash->{PortObj});
delete($hash->{PortObj});
delete($hash->{FD});
return undef;
}
#####################################
sub
FHZ_Parse($$)
{
my ($hash,$msg) = @_;
my $omsg = $msg;
$msg = substr($msg, 12); # The first 12 bytes are not really interesting
my $type = "";
my $name = $hash->{NAME};
foreach my $c (keys %codes) {
if($msg =~ m/$c/) {
$type = $codes{$c};
last;
}
}
if(!$type) {
Log 4, "FHZ $name unknown: $omsg";
$hash->{CHANGED}[0] = "$msg";
return $hash->{NAME};
}
if($type eq "fhtbuf") {
$msg = substr($msg, 4, 2);
}
Log 4, "FHZ $name $type: $msg";
$hash->{CHANGED}[0] = "$type: $msg";
return $hash->{NAME};
}
#####################################
sub
FHZ_Crc(@)
{
my $sum = 0;
map { $sum += $_; } @_;
return $sum & 0xFF;
}
#####################################
sub
FHZ_CheckCrc($)
{
my $msg = shift;
return 0 if(length($msg) < 8);
my @data;
for(my $i = 8; $i < length($msg); $i += 2) {
push(@data, ord(pack('H*', substr($msg, $i, 2))));
}
my $crc = hex(substr($msg, 6, 2));
# FS20 Repeater generate a CRC which is one or two greater then the computed
# one. The FHZ1000 filters such pakets, so we do not see them
return (($crc eq FHZ_Crc(@data)) ? 1 : 0);
}
#####################################
# This is a direct read for commands like get
sub
FHZ_ReadAnswer($$$)
{
my ($hash,$arg, $to) = @_;
return undef if(!$hash || ($^O!~/Win/ && !defined($hash->{FD})));
my ($mfhzdata, $rin) = ("", '');
my $buf;
for(;;) {
if($^O =~ m/Win/) {
$hash->{PortObj}->read_const_time($to*1000); # set timeout (ms)
# Read anstatt input sonst funzt read_const_time nicht.
$buf = $hash->{PortObj}->read(999);
return "Timeout reading answer for get $arg"
if(length($buf) == 0);
} else {
vec($rin, $hash->{FD}, 1) = 1;
my $nfound = select($rin, undef, undef, $to);
if($nfound < 0) {
next if ($! == EAGAIN() || $! == EINTR() || $! == 0);
die("Select error $nfound / $!\n");
}
return "Timeout reading answer for get $arg"
if($nfound == 0);
$buf = $hash->{PortObj}->input();
}
Log 4, "FHZ/RAW: " . unpack('H*',$buf);
$mfhzdata .= $buf;
next if(length($mfhzdata) < 2);
my $len = ord(substr($mfhzdata,1,1)) + 2;
if($len>20) {
Log 4, "Oversized message (" . unpack('H*',$mfhzdata) .
"), dropping it ...";
return undef;
}
return unpack('H*', $mfhzdata) if(length($mfhzdata) == $len);
}
}
##############
# Compute CRC, add header, glue fn and messages
sub
FHZ_CompleteMsg($$)
{
my ($fn,$msg) = @_;
my $len = length($msg);
my @data;
for(my $i = 0; $i < $len; $i += 2) {
push(@data, ord(pack('H*', substr($msg, $i, 2))));
}
return pack('C*', 0x81, $len/2+2, ord(pack('H*',$fn)), FHZ_Crc(@data), @data);
}
#####################################
# Check if the 1% limit is reached and trigger notifies
sub
FHZ_XmitLimitCheck($$)
{
my ($hash,$bstring) = @_;
my $now = time();
$bstring = unpack('H*', $bstring);
return if($bstring =~ m/c90185$/); # fhtbuf
if(!$hash->{XMIT_TIME}) {
$hash->{XMIT_TIME}[0] = $now;
$hash->{NR_CMD_LAST_H} = 1;
return;
}
my $nowM1h = $now-3600;
my @b = grep { $_ > $nowM1h } @{$hash->{XMIT_TIME}};
if(@b > 163) { # Maximum nr of transmissions per hour (unconfirmed).
my $me = $hash->{NAME};
Log GetLogLevel($me,2), "FHZ TRANSMIT LIMIT EXCEEDED";
DoTrigger($me, "TRANSMIT LIMIT EXCEEDED");
} else {
push(@b, $now);
}
$hash->{XMIT_TIME} = \@b;
$hash->{NR_CMD_LAST_H} = int(@b);
}
#####################################
sub
FHZ_Write($$$)
{
my ($hash,$fn,$msg) = @_;
if(!$hash || !defined($hash->{PortObj})) {
Log 5, "FHZ device $hash->{NAME} is not active, cannot send";
return;
}
###############
# insert value into the msghist. At the moment this only makes sense for FS20
# devices. As the transmitted value differs from the received one, we have to
# recompute.
if($fn eq "04" && substr($msg,0,6) eq "010101") {
AddDuplicate($hash->{NAME},
"0101a001" . substr($msg, 6, 6) . "00" . substr($msg, 12));
}
my $bstring = FHZ_CompleteMsg($fn, $msg);
Log 5, "Sending " . unpack('H*', $bstring);
if(!$hash->{QUEUE}) {
FHZ_XmitLimitCheck($hash,$bstring);
$hash->{QUEUE} = [ $bstring ];
$hash->{PortObj}->write($bstring) if($hash->{PortObj});
##############
# Write the next buffer not earlier than 0.22 seconds (= 65.6ms + 10ms +
# 65.6ms + 10ms + 65.6ms), else it will be discarded by the FHZ1X00 PC
InternalTimer(gettimeofday()+0.25, "FHZ_HandleWriteQueue", $hash, 1);
} else {
push(@{$hash->{QUEUE}}, $bstring);
}
}
#####################################
sub
FHZ_HandleWriteQueue($)
{
my $hash = shift;
my $arr = $hash->{QUEUE};
if(defined($arr) && @{$arr} > 0) {
shift(@{$arr});
if(@{$arr} == 0) {
delete($hash->{QUEUE});
return;
}
my $bstring = $arr->[0];
FHZ_XmitLimitCheck($hash,$bstring);
$hash->{PortObj}->write($bstring) if($hash->{PortObj});
InternalTimer(gettimeofday()+0.25, "FHZ_HandleWriteQueue", $hash, 1);
}
}
#####################################
sub
FHZ_Reopen($)
{
my ($hash) = @_;
my $dev = $hash->{DeviceName};
$hash->{PortObj}->close();
Log 1, "USB device $dev closed";
for(;;) {
sleep(5);
if($^O =~ m/Win/) {
$hash->{PortObj} = new Win32::SerialPort($dev);
}else{
$hash->{PortObj} = new Device::SerialPort($dev);
}
if($hash->{PortObj}) {
Log 1, "USB device $dev reopened";
$hash->{FD} = $hash->{PortObj}->FILENO if($^O !~ m/Win/);
FHZ_DoInit($hash->{NAME}, $hash->{ttytype}, $hash->{PortObj});
return;
}
}
}
#####################################
sub
FHZ_Close($)
{
my ($hash) = @_;
my $dev = $hash->{DeviceName};
return if(!$dev);
my $name = $hash->{NAME};
$hash->{PortObj}->close();
Log 1, "USB device $dev closed";
delete($hash->{PortObj});
delete($hash->{FD});
delete($selectlist{"$name.$dev"});
#$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");
}
#####################################
sub
FHZ_Open($)
{
my ($hash) = @_;
my $dev = $hash->{DeviceName};
return if(!$dev);
my $name = $hash->{NAME};
$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");
}
#####################################
sub
FHZ_Read($)
{
my ($hash) = @_;
my $buf = $hash->{PortObj}->input();
my $iohash = $modules{$hash->{TYPE}}; # Our (FHZ) module pointer
my $name = $hash->{NAME};
###########
# Lets' try again: Some drivers return len(0) on the first read...
if(defined($buf) && length($buf) == 0) {
$buf = $hash->{PortObj}->input();
}
if(!defined($buf) || length($buf) == 0) {
my $dev = $hash->{DeviceName};
Log 1, "USB device $dev disconnected, waiting to reappear";
delete($hash->{FD});
$hash->{PortObj}->close();
delete($hash->{PortObj});
delete($hash->{FD});
delete($selectlist{"$name.$dev"});
$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");
}
my $fhzdata = $hash->{PARTIAL};
Log 4, "FHZ/RAW: " . unpack('H*',$buf) .
" (Unparsed: " . unpack('H*', $fhzdata) . ")";
$fhzdata .= $buf;
while(length($fhzdata) > 2) {
###################################
# Skip trash.
my $si = index($fhzdata, $msgstart);
if($si) {
if($si == -1) {
Log(5, "Bogus message received, no start character found");
$fhzdata = "";
last;
} else {
Log(5, "Bogus message received, skipping to start character");
$fhzdata = substr($fhzdata, $si);
}
}
my $len = ord(substr($fhzdata,1,1)) + 2;
if($len>20) {
Log 4,
"Oversized message (" . unpack('H*',$fhzdata) . "), dropping it ...";
$fhzdata = "";
next;
}
last if(length($fhzdata) < $len);
my $dmsg = unpack('H*', substr($fhzdata, 0, $len));
if(FHZ_CheckCrc($dmsg)) {
if(substr($fhzdata,2,1) eq $msgstart) { # Skip function 0x81
$fhzdata = substr($fhzdata, 2);
next;
}
$hash->{"${name}_MSGCNT"}++;
$hash->{"${name}_TIME"} = TimeNow();
$hash->{RAWMSG} = $dmsg;
my %addvals = (RAWMSG => $dmsg);
my $foundp = Dispatch($hash, $dmsg, \%addvals);
$fhzdata = substr($fhzdata, $len);
} else {
Log 4, "Bad CRC message, skipping it (Bogus message follows)";
$fhzdata = substr($fhzdata, 2);
}
}
$hash->{PARTIAL} = $fhzdata;
}
1;

461
fhem/FHEM/00_HMLAN.pm
View File

@ -1,461 +0,0 @@
##############################################
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_OpenDev($$);
sub HMLAN_CloseDev($);
sub HMLAN_SimpleWrite(@);
sub HMLAN_SimpleRead($);
sub HMLAN_Disconnected($);
my %sets = (
"hmPairForSec" => "HomeMatic",
"hmPairSerial" => "HomeMatic",
);
sub
HMLAN_Initialize($)
{
my ($hash) = @_;
# 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";
}
#####################################
sub
HMLAN_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
if(@a != 3) {
my $msg = "wrong syntax: define <name> HMLAN ip[:port]";
Log 2, $msg;
return $msg;
}
HMLAN_CloseDev($hash);
my $name = $a[0];
my $dev = $a[2];
$dev .= ":1000" if($dev !~ m/:/);
$attr{$name}{hmId} = sprintf("%06X", time() % 0xffffff);
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 = HMLAN_OpenDev($hash, 0);
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};
}
}
HMLAN_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 = $!;
HMLAN_Disconnected($hash);
return("HMLAN_ReadAnswer $arg: $err", undef);
}
return ("Timeout reading answer for get $arg", undef)
if($nfound == 0);
$buf = HMLAN_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") {
HMLAN_SimpleWrite($hash, "+$dst,00,00,\r\n+$dst,00,00,\r\n+$dst");
HMLAN_SimpleWrite($hash, "-$dst");
HMLAN_SimpleWrite($hash, "+$dst,00,00,\r\n+$dst,00,00,\r\n+$dst");
$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);
}
#####################################
# called from the global loop, when the select for hash->{FD} reports data
sub
HMLAN_Read($)
{
my ($hash) = @_;
my $buf = HMLAN_SimpleRead($hash);
my $name = $hash->{NAME};
if(!defined($buf) || length($buf) == 0) {
HMLAN_Disconnected($hash);
return "";
}
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 $rmsg";
if($rmsg =~ m/^E(......),(....),(........),(..),(....),(.*)/) {
($src, $status, $msec, $d2, $rssi, $msg) =
($1, $2, $3, $4, $5, $6);
$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);
$dmsg = sprintf("A%02X%s", length($msg)/2, uc($msg));
$dmsg .= "NACK" if($status !~ m/...1/);
$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($owner ne $myId && !AttrVal($name, "dummy", 0)) {
Log 1, "HMLAN setting owner to $myId from $owner";
HMLAN_SimpleWrite($hash, "A$myId");
}
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 HMLAN_OpenDev($hash, 1);
}
########################
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";
$msg .= "\r\n" unless($nonl);
syswrite($hash->{TCPDev}, $msg) if($hash->{TCPDev});
}
########################
sub
HMLAN_SimpleRead($)
{
my ($hash) = @_;
if($hash->{TCPDev}) {
my $buf;
if(!defined(sysread($hash->{TCPDev}, $buf, 256))) {
HMLAN_Disconnected($hash);
return undef;
}
return $buf;
}
return undef;
}
########################
sub
HMLAN_CloseDev($)
{
my ($hash) = @_;
my $name = $hash->{NAME};
my $dev = $hash->{DeviceName};
return if(!$dev);
if($hash->{TCPDev}) {
$hash->{TCPDev}->close();
delete($hash->{TCPDev});
}
delete($selectlist{"$name.$dev"});
delete($readyfnlist{"$name.$dev"});
delete($hash->{FD});
}
########################
sub
HMLAN_OpenDev($$)
{
my ($hash, $reopen) = @_;
my $dev = $hash->{DeviceName};
my $name = $hash->{NAME};
$hash->{PARTIAL} = "";
Log 3, "HMLAN opening $name device $dev"
if(!$reopen);
if($dev =~ m/^.+:\d+$/) { # 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 $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;
InternalTimer(gettimeofday()+25, "HMLAN_KeepAlive", $hash, 0);
}
if($reopen) {
Log 1, "HMLAN $dev reappeared ($name)";
} else {
Log 3, "HMLAN device opened";
}
$hash->{STATE}="Initialized";
DoTrigger($name, "CONNECTED") if($reopen);
return "";
}
#####################################
sub
HMLAN_KeepAlive($)
{
my $hash = shift;
return if(!$hash->{FD});
HMLAN_SimpleWrite($hash, "K");
InternalTimer(gettimeofday()+25, "HMLAN_KeepAlive", $hash, 1);
}
sub
HMLAN_Disconnected($)
{
my $hash = shift;
my $dev = $hash->{DeviceName};
my $name = $hash->{NAME};
return if(!defined($hash->{FD})); # Already deleted or RFR
Log 1, "$dev disconnected, waiting to reappear";
RemoveInternalTimer($hash);
HMLAN_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;

557
fhem/FHEM/00_KM271.pm
View File

@ -1,557 +0,0 @@
##############################################
# Thx to Himtronics
# http://www.mikrocontroller.net/topic/141831
# http://www.mikrocontroller.net/attachment/63563/km271-protokoll.txt
# Buderus documents: 63011376, 63011377, 63011378
# e.g. http://www.buderus.de/pdf/unterlagen/0063061377.pdf
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
sub KM271_Read($);
sub KM271_Ready($);
sub KM271_OpenDev($);
sub KM271_CloseDev($);
sub KM271_SimpleWrite(@);
sub KM271_SimpleRead($);
sub KM271_crc($);
sub KM271_setbits($$);
sub KM271_GetReading($$);
sub KM271_SetReading($$$$$);
my %km271_sets = (
"hk1_nachtsoll" => "07006565%02x656565", # 0.5 celsius
"hk1_tagsoll" => "0700656565%02x6565", # 0.5 celsius
"hk1_betriebsart" => "070065656565%02x65",
"ww_soll" => "0C07656565%02x6565", # 1.0 celsius
"ww_betriebsart" => "0C0E%02x6565656565",
"logmode" => "EE0000",
);
# Message address:byte_offset in the message
# Attributes:
# d:x (divide), p:x (add), bf:x (bitfield), a:x (array) ne (generate no event)
# mb:x (multi-byte-message, x-bytes, low byte), s (signed value)
my %km271_tr = (
"CFG_SommerAb" => "0000:1", # 6510242a021e
"CFG_Raum_Temp_Nacht" => "0000:2,d:2",
"CFG_Raum_Temp_Tag" => "0000:3,d:2",
"CFG_Betriebsart" => "0000:4,a:4",
"CFG_Auslegung" => "000e:4", # 01045a054d65
"CFG_FrostAb" => "0015:2", # 030104650005
"CFG_Raum_Temp_Aufschalt" => "0015:0,s",
"CFG_Absenkungsart" => "001c:1,a:6", # 0c0101656565
"CFG_Fernbedienung" => "0031:4,a:0", # 656565fc0104
"CFG_Raum_Temp_Offset" => "0031:3,s", #
"CFG_GebaeudeArt" => "0070:2,p:1", # f66502066565
"CFG_WW_Temperatur" => "007e:3", # 65fb28373c65
"CFG_ZirkPumpe" => "0085:5", # 026565016502
"CFG_Warmwasser" => "0085:3,a:0",
"CFG_Display_Lang" => "0093:0,a:3", # 000302656565
"CFG_Display" => "0093:1,a:1",
"CFG_MaxAus" => "009a:3", # 65016554050c
"CFG_PumpLogik" => "00a1:0", # 2a0565656509
"CFG_Abgastemp" => "00a1:5,p:-9,a:5",
"CFG_Programm" => "0100:0,a:2", # 01ffff00ffff
"CFG_UrlaubsTage" => "0169:3", # 01ffff03ffff
"CFG_UhrDiff" => "01e0:1,s", # 010065656565
"HK1_Betriebswerte1" => "8000:0,bf:0",
"HK1_Betriebswerte2" => "8001:0,bf:1",
"HK1_Vorlaufsolltemperatur" => "8002:0",
"HK1_Vorlaufisttemperatur" => "8003:0,ne", # 23% of all messages
"HK1_Raumsolltemperatur" => "8004:0,d:2",
"HK1_Raumisttemperatur" => "8005:0,d:2",
"HK1_Einschaltoptimierungszeit" => "8006:0",
"HK1_Ausschaltoptimierungszeit" => "8007:0",
"HK1_Pumpenleistung" => "8008:0",
"HK1_Mischerstellung" => "8009:0",
"HK1_Heizkennlinie_bei_+_10_Grad" => "800c:0",
"HK1_Heizkennlinie_bei_0_Grad" => "800d:0",
"HK1_Heizkennlinie_bei_-_10_Grad" => "800e:0",
"HK2_Betriebswerte1" => "8112:0,bf:0",
"HK2_Betriebswerte2" => "8113:0,bf:1",
"HK2_Vorlaufsolltemperatur" => "8114:0",
"HK2_Vorlaufisttemperatur" => "8115:0,ne",
"HK2_Raumsolltemperatur" => "8116:0,d:2",
"HK2_Raumisttemperatur" => "8117:0,d:2",
"HK2_Einschaltoptimierungszeit" => "8118:0",
"HK2_Ausschaltoptimierungszeit" => "8119:0",
"HK2_Pumpenleistung" => "811a:0",
"HK2_Mischerstellung" => "811b:0",
"HK2_Heizkennlinie_bei_+_10_Grad" => "811e:0",
"HK2_Heizkennlinie_bei_0_Grad" => "811f:0",
"HK2_Heizkennlinie_bei_-_10_Grad" => "8120:0",
"WW_Betriebswerte1" => "8424:0,bf:2",
"WW_Betriebswerte2" => "8425:0,bf:3",
"WW_Solltemperatur" => "8426:0",
"WW_Isttemperatur" => "8427:0",
"WW_Einschaltoptimierungszeit" => "8428:0",
"WW_Ladepumpe" => "8429:0,bf:5",
"Kessel_Vorlaufsolltemperatur" => "882a:0",
"Kessel_Vorlaufisttemperatur" => "882b:0,ne", # 23% of all messages
"Brenner_Einschalttemperatur" => "882c:0",
"Brenner_Ausschalttemperatur" => "882d:0",
"Kessel_Integral1" => "882e:0,ne",
"Kessel_Integral" => "882f:0,ne,mb:2", # 46% of all messages
"Kessel_Fehler" => "8830:0,bf:6",
"Kessel_Betrieb" => "8831:0,bf:4",
"Brenner_Ansteuerung" => "8832:0,a:0",
"Abgastemperatur" => "8833:0",
"Brenner_Stellwert" => "8834:0",
"Brenner_Laufzeit1_Minuten2" => "8836:0",
"Brenner_Laufzeit1_Minuten1" => "8837:0",
"Brenner_Laufzeit1_Minuten" => "8838:0,mb:3",
"Brenner_Laufzeit2_Minuten2" => "8839:0",
"Brenner_Laufzeit2_Minuten1" => "883a:0",
"Brenner_Laufzeit2_Minuten" => "883b:0,mb:3",
"Aussentemperatur" => "893c:0,s",
"Aussentemperatur_gedaempft" => "893d:0,s",
"Versionsnummer_VK" => "893e:0",
"Versionsnummer_NK" => "893f:0",
"Modulkennung" => "8940:0",
);
my %km271_rev;
my @km271_bitarrays = (
# 0 - HK_Betriebswerte1
[ "leer", "Ausschaltoptimierung", "Einschaltoptimierung", "Automatik",
"Warmwasservorrang", "Estrichtrocknung", "Ferien", "Frostschutz",
"Manuell" ],
# 1 - HK_Betriebswerte2
[ "leer", "Sommer", "Tag", "keine Kommunikation mit FB", "FB fehlerhaft",
"Fehler Vorlauffuehler", "maximaler Vorlauf",
"externer Stoehreingang", "frei" ],
# 2 - WW_Betriebswerte1
[ "aus", "Automatik", "Desinfektion", "Nachladung", "Ferien",
"Fehler Desinfektion", "Fehler Fuehler", "Fehler WW bleibt kalt",
"Fehler Anode" ],
# 3 - WW_Betriebswerte2
[ "aus", "Laden", "Manuell", "Nachladen", "Ausschaltoptimierung",
"Einschaltoptimierung", "Tag", "Warm", "Vorrang" ],
# 4 - Kessel_Betrieb
[ "aus", "Tag", "Automatik", "Sommer",
"Bit3", "Bit4", "Bit5", "Bit6", "Bit7" ],
# 5 - WW_Ladepumpe
[ "aus", "Ladepumpe", "Zirkulationspumpe", "Absenkung Solar",
"Bit3", "Bit4", "Bit5", "Bit6", "Bit7" ],
# 6 - Kessel_Fehler
[ "keine", "Bit1", "Bit2", "Bit3", "Bit4",
"Abgastemperatur ueberschritten", "Bit6", "Bit7" ],
);
my @km271_arrays = (
# 0 - Brenner_Ansteuerung , CFG_Fernbedienung, CFG_Warmwasser
[ "aus", "an" ],
# 1 - CFG_Display
[ "Automatik", "Kessel", "Warmwasser", "Aussen" ],
# 2 - CFG_Programm
[ "Eigen1", "Familie", "Frueh", "Spaet", "Vormit", "Nachmit",
"Mittag", "Single", "Senior" ],
# 3 - CFG_Display_Lang
[ "DE", "FR", "IT", "NL", "EN", "PL" ],
# 4 - CFG_Betriebsart
[ "Nacht", "Tag", "Automatik" ],
# 5 - CFG_Abgastemp
[ "Aus","50","55","60","65","70","75","80","85","90","95","100","105",
"110","115","120","125","130","135","140","145","150","155","160","165",
"170","175","180","185","190","195","200","205","210","215","220","225",
"230","235","240","245","250" ],
# 6 - CFG_Absenkungsart
[ "Abschalt","Reduziert","Raumhal","Aussenhal"]
);
my %km271_set_betriebsart = (
"nacht" => 0,
"tag" => 1,
"automatik" => 2,
);
sub
KM271_Initialize($)
{
my ($hash) = @_;
$hash->{ReadFn} = "KM271_Read";
$hash->{ReadyFn} = "KM271_Ready";
$hash->{DefFn} = "KM271_Define";
$hash->{UndefFn} = "KM271_Undef";
$hash->{SetFn} = "KM271_Set";
$hash->{AttrList}= "do_not_notify:1,0 all_km271_events loglevel:0,1,2,3,4,5,6";
my @a = ();
$hash->{SENDBUFFER} = \@a;
%km271_rev = ();
foreach my $k (sort keys %km271_tr) { # Reverse map
my $v = $km271_tr{$k};
my ($addr, $b) = split("[:,]", $v);
$km271_rev{$addr}{$b} = $k;
}
}
#####################################
sub
KM271_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "wrong syntax: define <name> KM271 [devicename|none]"
if(@a != 3);
KM271_CloseDev($hash);
my $name = $a[0];
my $dev = $a[2];
if($dev eq "none") {
Log 1, "KM271 device is none, commands will be echoed only";
return undef;
}
$hash->{DeviceName} = $dev;
my $ret = KM271_OpenDev($hash);
return $ret;
}
#####################################
sub
KM271_Undef($$)
{
my ($hash, $arg) = @_;
KM271_CloseDev($hash);
return undef;
}
#####################################
sub
KM271_Set($@)
{
my ($hash, @a) = @_;
return "\"set KM271\" needs at least an argument" if(@a < 2);
my $fmt = $km271_sets{$a[1]};
return "Unknown argument $a[1], choose one of " .
join(" ", sort keys %km271_sets) if(!defined($fmt));
my ($val, $numeric_val);
if($fmt =~ m/%/) {
return "\"set KM271 $a[1]\" needs at least one parameter" if(@a < 3);
$val = $a[2];
$numeric_val = ($val =~ m/^[.0-9]+$/);
}
if($a[1] =~ m/^hk.*soll$/) {
return "Argument must be numeric (between 10 and 30)" if(!$numeric_val);
$val *= 2;
}
if($a[1] =~ m/^ww.*soll$/) {
return "Argument must be numeric (between 30 and 60)" if(!$numeric_val);
}
if($a[1] =~ m/_betriebsart/) {
$val = $km271_set_betriebsart{$val};
return "Unknown arg, use one of " .
join(" ", sort keys %km271_set_betriebsart) if(!defined($val));
}
my $data = ($val ? sprintf($fmt, $val) : $fmt);
push @{$hash->{SENDBUFFER}}, $data;
KM271_SimpleWrite($hash, "02") if(!$hash->{WAITING});
return undef;
}
#####################################
# called from the global loop, when the select for hash->{FD} reports data
sub
KM271_Read($)
{
my ($hash) = @_;
my $name = $hash->{NAME};
my ($data, $crc);
my $buf = KM271_SimpleRead($hash);
Log 5, "KM271RAW: " . unpack('H*', $buf);
if(!defined($buf)) {
Log 1, "$name: EOF";
KM271_CloseDev($hash);
return;
}
$buf = unpack('H*', $buf);
if(@{$hash->{SENDBUFFER}} || $hash->{DATASENT}) { # Send data
if($buf eq "02") { # KM271 Wants to send, override
KM271_SimpleWrite($hash, "02");
return;
}
if($buf eq "10") {
if($hash->{DATASENT}) {
delete($hash->{DATASENT});
KM271_SimpleWrite($hash, "02") if(@{$hash->{SENDBUFFER}});
return;
}
$data = pop @{ $hash->{SENDBUFFER} };
$data =~ s/10/1010/g;
$crc = KM271_crc($data);
KM271_SimpleWrite($hash, $data."1003$crc"); # Send the data
}
if($buf eq "15") { # NACK from the KM271
Log 1, "$name: NACK!";
delete($hash->{DATASENT});
KM271_SimpleWrite($hash, "02") if(@{$hash->{SENDBUFFER}});
return;
}
} elsif($buf eq "02") { # KM271 Wants to send
KM271_SimpleWrite($hash, "10"); # We are ready
$hash->{PARTIAL} = "";
$hash->{WAITING} = 1;
return;
}
$hash->{PARTIAL} .= $buf;
my $len = length($hash->{PARTIAL});
return if($hash->{PARTIAL} !~ m/^(.*)1003(..)$/);
($data, $crc) = ($1, $2);
$hash->{PARTIAL} = "";
delete($hash->{WAITING});
if(KM271_crc($data) ne $crc) {
Log 1, "Wrong CRC in $hash->{PARTIAL}: $crc vs. ". KM271_crc($data);
KM271_SimpleWrite($hash, "15"); # NAK
KM271_SimpleWrite($hash, "02") if(@{$hash->{SENDBUFFER}}); # want to send
return;
}
KM271_SimpleWrite($hash, "10"); # ACK, Data received ok
$data =~ s/1010/10/g;
if($data !~ m/^(....)(.*)/) {
Log 1, "$name: Bogus message: $data";
return;
}
######################################
# Analyze the data
my ($fn, $arg) = ($1, $2);
my $msghash = $km271_rev{$fn};
my $all_events = KM271_attr($name, "all_km271_events") ;
my $tn = TimeNow();
#Log 1, "$data" if($fn ne "0400");
if($msghash) {
foreach my $off (keys %{$msghash}) {
my $key = $msghash->{$off};
my $val = hex(substr($arg, $off*2, 2));
my $ntfy = 1;
my @postprocessing = split(",", $km271_tr{$key});
shift @postprocessing;
while(@postprocessing) {
my ($f,$farg) = split(":", shift @postprocessing);
if($f eq "d") { $val /= $farg; }
elsif($f eq "p") { $val += $farg; }
elsif($f eq "ne") { $ntfy = $all_events; }
elsif($f eq "s") { $val = $val-256 if($val > 128); }
elsif($f eq "bf") { $val = KM271_setbits($val, $farg); }
elsif($f eq "a") { $val = $km271_arrays[$farg][$val]; }
elsif($f eq "mb") {
$val += KM271_GetReading($hash, $key."1") * 256;
$val += KM271_GetReading($hash, $key."2") * 65536 if($farg == 3);
}
}
KM271_SetReading($hash, $tn, $key, $val, $ntfy);
}
} elsif($fn eq "0400") {
KM271_SetReading($hash, $tn, "NoData", $arg, 0);
} elsif($all_events) {
KM271_SetReading($hash, $tn, "UNKNOWN_$fn", $data, 1);
} else { # Just ignore
return;
}
}
#####################################
sub
KM271_Ready($)
{
my ($hash) = @_;
# This is relevant for windows/USB only
my $po = $hash->{Dev};
my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags) = $po->status;
return ($InBytes>0);
}
########################
sub
KM271_SimpleWrite(@)
{
my ($hash, $msg) = @_;
Log 3, "KM271 SimpleWrite $msg" if(length($msg) != 2);
$hash->{Dev}->write(pack('H*',$msg)) if($hash->{DeviceName});
}
########################
sub
KM271_SimpleRead($)
{
my ($hash) = @_;
return $hash->{Dev}->input() if($hash->{Dev});
return undef;
}
########################
sub
KM271_CloseDev($)
{
my ($hash) = @_;
my $name = $hash->{NAME};
my $dev = $hash->{DeviceName};
return if(!$dev); # "none"
if($hash->{Dev}) {
$hash->{Dev}->close() ;
delete($hash->{Dev});
}
delete($selectlist{"$name.$dev"});
delete($readyfnlist{"$name.$dev"});
delete($hash->{FD});
delete($hash->{DeviceName});
}
########################
sub
KM271_OpenDev($)
{
my ($hash) = @_;
my $dev = $hash->{DeviceName};
my $name = $hash->{NAME};
my $po;
$hash->{PARTIAL} = "";
Log 3, "KM271 opening $name device $dev";
if ($^O=~/Win/) {
require Win32::SerialPort;
$po = new Win32::SerialPort ($dev);
} else {
require Device::SerialPort;
$po = new Device::SerialPort ($dev);
}
if(!$po) {
Log(3, "Can't open $dev: $!");
return "";
}
$hash->{Dev} = $po;
if( $^O =~ /Win/ ) {
$readyfnlist{"$name.$dev"} = $hash;
} else {
$hash->{FD} = $po->FILENO;
delete($readyfnlist{"$name.$dev"});
$selectlist{"$name.$dev"} = $hash;
}
$po->reset_error();
$po->baudrate(2400);
$po->databits(8);
$po->parity('none');
$po->stopbits(1);
$po->handshake('none');
$hash->{STATE} = "Initialized";
push @{$hash->{SENDBUFFER}}, "EE0000";
KM271_SimpleWrite($hash, "02"); # STX
Log 3, "$dev opened";
return undef;
}
sub
KM271_setbits($$)
{
my ($val, $arridx) = @_;
my @ret;
for(my $idx = 1; $idx <= 8; $idx++) {
push(@ret, $km271_bitarrays[$arridx][$idx]) if($val & (1<<($idx-1)));
}
return $km271_bitarrays[$arridx][0] if(!int(@ret));
return join(",", @ret);
}
sub
KM271_crc($)
{
my $in = shift;
my $x = 0;
foreach my $a (split("", pack('H*', $in))) {
$x ^= ord($a);
}
$x ^= 0x10;
$x ^= 0x03;
return sprintf("%02x", $x);
}
sub
KM271_attr($$)
{
my ($name, $attr) = @_;
return $attr{$name}{$attr} if($attr{$name} && $attr{$name}{$attr});
return "";
}
sub
KM271_GetReading($$)
{
my ($hash, $msg) = @_;
return $hash->{READINGS}{$msg}{VAL}
if($hash->{READINGS} && $hash->{READINGS}{$msg});
return 0;
}
sub
KM271_SetReading($$$$$)
{
my ($hash,$tn,$key,$val,$ntfy) = @_;
my $name = $hash->{NAME};
Log GetLogLevel($name,4), "$name: $key $val" if($key ne "NoData");
$hash->{READINGS}{$key}{TIME} = $tn;
$hash->{READINGS}{$key}{VAL} = $val;
DoTrigger($name, "$key: $val") if($ntfy);
}
1;

113
fhem/FHEM/00_LIRC.pm
View File

@ -1,113 +0,0 @@
##############################################
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
use Lirc::Client;
use IO::Select;
#####################################
# Note: we are a data provider _and_ a consumer at the same time
sub
LIRC_Initialize($)
{
my ($hash) = @_;
Log 1, "LIRC_Initialize";
# Provider
$hash->{ReadFn} = "LIRC_Read";
$hash->{ReadyFn} = "LIRC_Ready";
$hash->{Clients} = ":LIRC:";
# Consumer
$hash->{DefFn} = "LIRC_Define";
$hash->{UndefFn} = "LIRC_Undef";
}
#####################################
sub
LIRC_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
$hash->{STATE} = "Initialized";
$hash->{LircObj}->clean_up() if($hash->{LircObj});
delete $hash->{LircObj};
delete $hash->{FD};
my $name = $a[0];
my $config = $a[2];
Log 3, "LIRC opening $name device $config";
my $lirc = Lirc::Client->new({
prog => 'fhem',
rcfile => "$config",
debug => 0,
fake => 0,
});
return "Can't open $config: $!\n" if(!$lirc);
Log 3, "LIRC opened $name device $config";
my $select = IO::Select->new();
$select->add( $lirc->sock );
$hash->{LircObj} = $lirc;
$hash->{FD} = $lirc->{sock}; # is not working and sets timeout to undefined
$selectlist{"$name"} = $hash; #
$readyfnlist{"$name"} = $hash; # thats why we start polling
$hash->{SelectObj} = $select;
$hash->{DeviceName} = $name;
$hash->{STATE} = "Opened";
return undef;
}
#####################################
sub
LIRC_Undef($$)
{
my ($hash, $arg) = @_;
$hash->{LircObj}->clean_up() if($hash->{LircObj});
delete $hash->{LircObj};
delete $hash->{FD};
return undef;
}
#####################################
sub
LIRC_Read($)
{
my ($hash) = @_;
my $lirc= $hash->{LircObj};
my $select= $hash->{SelectObj};
if( my @ready = $select->can_read(0) ){
# an ir event has been received (if you are tracking other filehandles, you need to make sure it is lirc)
my @codes = $lirc->next_codes; # should not block
for my $code (@codes){
Log 3, "LIRC $code toggle";
DoTrigger($code, "toggle");
}
}
}
#####################################
sub
LIRC_Ready($)
{
my ($hash) = @_;
my $select= $hash->{SelectObj};
return $select->can_read(0);
}
1;

1043
fhem/FHEM/00_TUL.pm
View File

File diff suppressed because it is too large Load Diff

131
fhem/FHEM/09_BS.pm
View File

@ -1,131 +0,0 @@
#
#
# 09_BS.pm
# written by Dr. Boris Neubert 2009-06-20
# e-mail: omega at online dot de
#
##############################################
package main;
use strict;
use warnings;
#############################
sub
BS_Initialize($)
{
my ($hash) = @_;
$hash->{Match} = "^81..(04|0c)..0101a001a5cf";
$hash->{DefFn} = "BS_Define";
$hash->{UndefFn} = "BS_Undef";
$hash->{ParseFn} = "BS_Parse";
$hash->{AttrList} = "do_not_notify:1,0 showtime:0,1 ".
"ignore:1,0 model:BS loglevel:0,1,2,3,4,5,6";
}
#############################
sub
BS_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $u= "wrong syntax: define <name> BS <sensor> [[RExt] luxOffset]";
return $u if((int(@a)< 3) || (int(@a)>5));
my $name = $a[0];
my $sensor = $a[2];
if($sensor !~ /[123456789]/) {
return "erroneous sensor specification $sensor, use one of 1..9";
}
$sensor= "0$sensor";
my $RExt = 50000; # default is 50kOhm
$RExt= $a[3] if(int(@a)>=4);
my $luxOffset= 0; # default is no offset
$luxOffset= $a[4] if(int(@a)>=5);
$hash->{SENSOR}= "$sensor";
$hash->{RExt}= $RExt;
$hash->{luxOffset}= $luxOffset;
my $dev= "a5cf $sensor";
$hash->{DEF}= $dev;
$modules{BS}{defptr}{$dev} = $hash;
AssignIoPort($hash);
}
#############################
sub
BS_Undef($$)
{
my ($hash, $name) = @_;
delete($modules{BS}{defptr}{$hash->{DEF}});
return undef;
}
#############################
sub
BS_Parse($$)
{
my ($hash, $msg) = @_; # hash points to the FHZ, not to the BS
# Msg format:
# 01 23 45 67 8901 2345 6789 01 23 45 67
# 81 0c 04 .. 0101 a001 a5cf xx 00 zz zz
my $sensor= substr($msg, 20, 2);
my $dev= "a5cf $sensor";
my $def= $modules{BS}{defptr}{$dev};
if(!defined($def)) {
$sensor =~ s/^0//;
Log 3, "BS Unknown device $sensor, please define it";
return "UNDEFINED BS_$sensor BS $sensor";
}
my $name= $def->{NAME};
return "" if(IsIgnored($name));
my $t= TimeNow();
my $flags= hex(substr($msg, 24, 1)) & 0xdc;
my $value= hex(substr($msg, 25, 3)) & 0x3ff;
my $RExt= $def->{RExt};
my $luxOffset= $def->{luxOffset};
my $brightness= $value/10.24; # Vout in percent of reference voltage 1.1V
# brightness in lux= 100lux*(VOut/RExt/1.8muA)^2;
my $VOut= $value*1.1/1024.0;
my $temp= $VOut/$RExt/1.8E-6;
my $lux= 100.0*$temp*$temp;
$lux+= $luxOffset; # add lux offset
my $state= sprintf("brightness: %.2f lux: %.0f flags: %d",
$brightness, $lux, $flags);
$def->{CHANGED}[0] = $state;
$def->{STATE} = $state;
$def->{READINGS}{state}{TIME} = $t;
$def->{READINGS}{state}{VAL} = $state;
Log GetLogLevel($name, 4), "BS $name: $state";
$def->{READINGS}{brightness}{TIME} = $t;
$def->{READINGS}{brightness}{VAL} = $brightness;
$def->{READINGS}{lux}{TIME} = $t;
$def->{READINGS}{lux}{VAL} = $lux;
$def->{READINGS}{flags}{TIME} = $t;
$def->{READINGS}{flags}{VAL} = $flags;
return $name;
}
#############################
1;

240
fhem/FHEM/09_CUL_FHTTK.pm
View File

@ -1,240 +0,0 @@
#
# 09_CUL_FHTTK.pm
#
# A module for FHEM to handle ELV's FHT80 TF-type sensors
# written by Kai 'wusel' Siering, 2009-11-06 with help
# from previously written FHEM code as well as members
# of fhem-users at googlegroups.com! Thanks, guys!
#
# e-mail: wusel+source at uu punkt org
#
# This module reads, despite setting an IODev explicitely,
# from any (CUL-) source and drops any identical message
# arriving within 5 seconds. It does handle the automatic
# retransmission of FHT80 TF as well as concurrent recep-
# tion from multiple sources; in my system, it could happen
# that the CUL in the same room "overhears" a telegram from
# FHT80 TF (most likely due to other messages sent/received
# at the same time) but the one downstairs still picks it up.
# My implementation should be safe for the device in question,
# if you see problems, the "only on this IODev"-code is still
# in place but commented out.
#
#
# Note: The sensor in question is named "FHT80 TF",
# in it's (formerly current, now old) design it looks
# similar to "FS20 TFK" but operates differently.
#
# FHT80 TF is designed to serve as a sensor to FHT80 B,
# only the B receives TF's transmissions (after made
# known to each FHT80 B) normally. The B then, if in-
# structed that way, turns down the heating while any
# of the TFs known to it signal "Window open". The TF
# transmits about every 255 seconds a telegram stating
# whether or nor the (reed-) contact is open (which
# means Window or Door, relevant for heating, open)
# and whether the battery is still full enough.
#
# The FS20 TFK on the other hand just directly addresses
# another FS20 device on opening/closing of it's (reed-)
# contact.
#
# Finally, the HMS100 TFK is designed to notify a HMS-
# central about opened/closed contacts immediately,
# but you can't directly address FS20 devices ...
#
# So, to notify e. g. FHEM instantly about opening
# or closure of doors/windows, your best buy might be
# an HMS100 TFK (as of this writing EUR 29,95 @ ELV).
# You could use an FS20 TFK as well (EUR 34,95 @ ELV),
# that way you could directly have FS20 switches act
# on opened/closed doors or windows in parallel or
# even without FHEM. The FHT80 TF (as eQ-3 FHT 80 TF
# currently for EUR 14,95 available @ ELV) only sends
# out a status telegram every ca. 2,5 minutes, so it's
# ok for seeing where one might have left a window
# open before leaving the house but by no means suit-
# able for any alerting uses (unless a delay of said
# amount of time doesn't matter, of course ;)).
#
# $Id: 09_CUL_FHTTK.pm,v 1.6 2010-01-22 09:51:55 painseeker Exp $
##############################################
package main;
use strict;
use warnings;
my %fhttfk_codes = (
"02" => "Window:Closed",
"82" => "Window:Closed",
"01" => "Window:Open",
"81" => "Window:Open",
"0c" => "Sync:Syncing",
"91" => "Window:Open, Low Batt",
"11" => "Window:Open, Low Batt",
"92" => "Window:Closed, Low Batt",
"12" => "Window:Closed, Low Batt",
"0f" => "Test:Success");
# -wusel, 2009-11-09: Map retransmission codes to major (8x) ones (0x)
# As I'm somewhat lazy, I just list all codes from
# %fhttfk_codes and map them to their major one.
# (FIXME: it would be sufficient to have %fhttfk_codes
# only list these major, "translated" ones.)
my %fhttfk_translatedcodes = (
"01" => "01",
"11" => "11",
"12" => "12",
"02" => "02",
"0c" => "0c",
"0f" => "0f",
"81" => "01",
"82" => "02",
"91" => "11",
"92" => "12");
# -wusel, 2009-11-06
#
# Parse messages from FHT80TK, normally interpreted only by FHT80
#
# Format as follows: "TCCCCCCXX" with CCCCCC being the id of the
# sensor in hex, XX being the current status: 02/82 is Window
# closes, 01/81 is Window open, 0C is synchronization, ?? is the
# battery low warning. FIXME!
#############################
sub
CUL_FHTTK_Initialize($)
{
my ($hash) = @_;
$hash->{Match} = "^T........";
$hash->{DefFn} = "CUL_FHTTK_Define";
$hash->{UndefFn} = "CUL_FHTTK_Undef";
$hash->{ParseFn} = "CUL_FHTTK_Parse";
$hash->{AttrList} = "IODev do_not_notify:1,0 ignore:0,1 showtime:0,1 " .
"model:FHT80TF loglevel:0,1,2,3,4,5,6";
}
#############################
sub
CUL_FHTTK_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $u= "wrong syntax: define <name> CUL_FHTTK <sensor>";
return $u if((int(@a)< 3) || (int(@a)>3));
my $name = $a[0];
my $sensor = lc($a[2]);
if($sensor !~ /^[0-9a-f]{6}$/) {
return "wrong sensor specification $sensor, need a 6 digit hex number";
}
# $hash->{SENSOR}= "$sensor";
$hash->{CODE} = $sensor;
$modules{CUL_FHTTK}{defptr}{$sensor} = $hash;
# $defs{$hash}{READINGS}{PREV}{STATE}="00";
# $defs{$hash}{READINGS}{PREV}{TIMESTAMP} = localtime();
AssignIoPort($hash);
return undef;
}
#############################
sub
CUL_FHTTK_Undef($$)
{
my ($hash, $name) = @_;
delete($modules{CUL_FHTTK}{defptr}{$hash->{CODE}}) if($hash && $hash->{CODE});
return undef;
}
#############################
sub
CUL_FHTTK_Parse($$)
{
my ($hash, $msg) = @_;
my $sensor= lc(substr($msg, 1, 6));
my $def = $modules{CUL_FHTTK}{defptr}{$sensor};
if(!$def) {
Log 3, "FHTTK Unknown device $sensor, please define it";
return "UNDEFINED CUL_FHTTK_$sensor CUL_FHTTK $sensor";
}
my $self = $def->{NAME};
my $state = lc(substr($msg, 7, 2));
return "" if(IsIgnored($self));
if(!defined($fhttfk_translatedcodes{$state})) {
Log 3, sprintf("FHTTK $def Unknown state $state");
$defs{$self}{READINGS}{"Unknown"}{VAL} = $state;
$defs{$self}{READINGS}{"Unknown"}{TIME} = TimeNow();
return "";
}
$state=$fhttfk_translatedcodes{$state};
# PREVIOUS
# FIXME: Message regarded as similar if last char is identical;
# sure that's always the differentiator? -wusel, 2009-11-09
if(defined($defs{$self}{PREV}{TIMESTAMP})) {
if($defs{$self}{PREV}{TIMESTAMP} > time()-5) {
if(defined($defs{$self}{PREV}{STATE})) {
if($defs{$self}{PREV}{STATE} eq $state) {
Log GetLogLevel($def->{NAME},4), sprintf("FHTTK skipping state $state as last similar telegram was received less than 5 (%d) secs ago", $defs{$self}{PREV}{STATE}, time()-$defs{$self}{PREV}{TIMESTAMP});
return "";
}
}
}
}
$def->{PREVTIMESTAMP} = defined($defs{$self}{PREV}{TIMESTAMP})?$defs{$self}{PREV}{TIMESTAMP}:time();
$def->{PREVSTATE} = defined($def->{STATE})?$def->{STATE}:"Unknown";
$defs{$self}{PREV}{STATE}=$state;
#READINGS
my ($reading,$val) = split(/:/, $fhttfk_codes{$state});
$defs{$self}{READINGS}{$reading}{VAL} = $val;
$defs{$self}{READINGS}{$reading}{TIME} = TimeNow();
$defs{$self}{PREV}{TIMESTAMP} = time();
# -wusel, 2009-11-09: According to http://fhz4linux.info/tiki-index.php?page=FHT+protocol,
# FHT80TF usually transmitts between 60 and 240 seconds. (255-256 sec in
# my experience ...) If we got no fresh data for over 5 minutes (300 sec),
# flag this.
if($defs{$self}{PREV}{TIMESTAMP}+720 < time()) {
$defs{$self}{READINGS}{"Reliability"}{VAL} = "dead";
$defs{$self}{READINGS}{"Reliability"}{TIME} = TimeNow();
} elsif($defs{$self}{PREV}{TIMESTAMP}+600 < time()) {
$defs{$self}{READINGS}{"Reliability"}{VAL} = "low";
$defs{$self}{READINGS}{"Reliability"}{TIME} = TimeNow();
} elsif($defs{$self}{PREV}{TIMESTAMP}+300 < time()) {
$defs{$self}{READINGS}{"Reliability"}{VAL} = "medium";
$defs{$self}{READINGS}{"Reliability"}{TIME} = TimeNow();
} else {
$defs{$self}{READINGS}{"Reliability"}{VAL} = "ok";
$defs{$self}{READINGS}{"Reliability"}{TIME} = TimeNow();
}
# Flag the battery warning separately
if($state eq "11" || $state eq "12") {
$defs{$self}{READINGS}{"Battery"}{VAL} = "Low";
$defs{$self}{READINGS}{"Battery"}{TIME} = TimeNow();
} else {
$defs{$self}{READINGS}{"Battery"}{VAL} = "ok";
$defs{$self}{READINGS}{"Battery"}{TIME} = TimeNow();
}
#CHANGED
$defs{$self}{CHANGED}[0] = $reading . ": " . $val;
$def->{STATE} = $val;
$def->{OPEN} = lc($val) eq "open" ? 1 : 0;
Log GetLogLevel($def->{NAME},4), "FHTTK Device $self ($reading: $val)";
return $def->{NAME};
}
#############################
1;

177
fhem/FHEM/09_USF1000.pm
View File

@ -1,177 +0,0 @@
#
#
# 09_USF1000.pm
# written by Dr. Boris Neubert 2009-06-20
# e-mail: omega at online dot de
#
##############################################
package main;
use strict;
use warnings;
my $PI= 3.141592653589793238;
my $dev= "a5ce aa";
#############################
sub
USF1000_Initialize($)
{
my ($hash) = @_;
$hash->{Match} = "^81..(04|0c)..0101a001a5ceaa00....";
$hash->{DefFn} = "USF1000_Define";
$hash->{UndefFn} = "USF1000_Undef";
$hash->{ParseFn} = "USF1000_Parse";
$hash->{AttrList} = "IODev do_not_notify:1,0 ignore:0,1 showtime:0,1 " .
"model:usf1000s loglevel:0,1,2,3,4,5,6";
}
#############################
sub
USF1000_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $u= "wrong syntax: define <name> USF1000 geometry";
my $g= "wrong geometry for USF1000";
# geometry (units: meter)
# cub length width height offset cuboid 3+4
# cylv diameter height offset vertical cylinder 3+3
# the offset is measured from the TOP of the box!
return $u if(int(@a)< 6);
my $name = $a[0];
my $geometry = $a[2];
if($geometry eq "cub") {
# cuboid
return $g if(int(@a)< 7);
$hash->{GEOMETRY}= $geometry;
$hash->{LENGTH}= $a[3];
$hash->{WIDTH}= $a[4];
$hash->{HEIGHT}= $a[5];
$hash->{OFFSET}= $a[6];
$hash->{CAPACITY}= int($hash->{LENGTH}*$hash->{WIDTH}*$hash->{HEIGHT}*100.0+0.5)*10.0;
} elsif($geometry eq "cylv") {
# vertical cylinder
return $g if(int(@a)< 6);
$hash->{GEOMETRY}= $geometry;
$hash->{DIAMETER}= $a[3];
$hash->{HEIGHT}= $a[4];
$hash->{OFFSET}= $a[5];
$hash->{CAPACITY}= int($PI*$hash->{DIAMETER}*$hash->{DIAMETER}/4.0*$hash->{HEIGHT}*100.0+0.5)*10.0;
} else {
return $g;
}
$modules{USF1000}{defptr}{$dev} = $hash;
AssignIoPort($hash);
}
#############################
sub
USF1000_Undef($$)
{
my ($hash, $name) = @_;
delete($modules{USF1000}{defptr}{$dev});
return undef;
}
#############################
sub
USF1000_Parse($$)
{
my ($hash, $msg) = @_; # hash points to the FHZ, not to the USF1000
if(!defined($modules{USF1000}{defptr}{$dev})) {
Log 3, "USF1000 Unknown device, please define it";
return "UNDEFINED USF1000 USF1000 cylv 1 1 0.5";
}
my $def= $modules{USF1000}{defptr}{$dev};
my $name= $def->{NAME};
return "" if(IsIgnored($name));
my $t= TimeNow();
# Msg format:
# 01 23 45 67 8901 2345 6789 01 23 45 67
# 81 0c 04 .. 0101 a001 a5ce aa 00 cc xx
my $cc= substr($msg, 24, 2);
my $xx= substr($msg, 26, 2);
my $lowbattery= (hex($cc) & 0x40 ? 1 : 0);
my $testmode= (hex($cc) & 0x80 ? 1 : 0);
my $distance= hex($xx)/100.0; # in meters
my $valid= (($distance>0.00) && ($distance<2.55));
if($valid) {
my $wlevel = $def->{HEIGHT}-($distance-$def->{OFFSET}); # water level
my $geometry= $def->{GEOMETRY};
my $capacity= $def->{CAPACITY}; # capacity of tank (for distance= offset) in liters
my $volume; # current volume in tank in liters
my $flevel; # fill level in percent
if($geometry eq "cub") {
# cuboid
$volume = $def->{LENGTH}*$def->{WIDTH}*$wlevel*1000.0;
} elsif($geometry eq "cylv") {
# vertical cylinder
$volume = $PI*$def->{DIAMETER}*$def->{DIAMETER}/4.0*$wlevel*1000.0;
} else {
return 0;
}
$flevel = int($volume/$capacity*100.0+0.5);
$volume= int($volume/10.0+0.5)*10.0;
if($flevel>-5) {
# reflections may lead to false reading (distance too large)
# the meaningless results are suppressed
my $state= sprintf("v: %d V: %d", $flevel, $volume);
$def->{CHANGED}[0] = $state;
$def->{STATE} = $state;
$def->{READINGS}{state}{TIME} = $t;
$def->{READINGS}{state}{VAL} = $state;
Log GetLogLevel($name, 4), "USF1000 $name: $state";
$def->{READINGS}{distance}{TIME} = $t;
$def->{READINGS}{distance}{VAL} = $distance;
$def->{READINGS}{level}{TIME} = $t;
$def->{READINGS}{level}{VAL} = $flevel;
$def->{READINGS}{volume}{TIME} = $t;
$def->{READINGS}{volume}{VAL} = $volume;
}
}
my $warnings= ($lowbattery ? "Battery low" : "");
if($testmode) {
$warnings.= "; " if($warnings);
$warnings.= "Test mode";
}
$warnings= $warnings ? $warnings : "none";
$def->{READINGS}{"warnings"}{TIME} = $t;
$def->{READINGS}{"warnings"}{VAL} = $warnings;
return $name;
}
#############################
1;

1234
fhem/FHEM/10_CUL_HM.pm
View File

File diff suppressed because it is too large Load Diff

271
fhem/FHEM/10_EIB.pm
View File

@ -1,271 +0,0 @@
##############################################
package main;
use strict;
use warnings;
my %eib_c2b = (
"off" => "00",
"on" => "01",
"on-for-timer" => "01",
"on-till" => "01",
"value" => ""
);
my %codes = (
"00" => "off",
"01" => "on",
"" => "value",
);
my %readonly = (
"dummy" => 1,
);
my $eib_simple ="off on value on-for-timer on-till";
my %models = (
);
sub
EIB_Initialize($)
{
my ($hash) = @_;
$hash->{Match} = "^B.*";
$hash->{SetFn} = "EIB_Set";
$hash->{StateFn} = "EIB_SetState";
$hash->{DefFn} = "EIB_Define";
$hash->{UndefFn} = "EIB_Undef";
$hash->{ParseFn} = "EIB_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
EIB_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $u = "wrong syntax: define <name> EIB <group name>";
return $u if(int(@a) < 3);
return "Define $a[0]: wrong group name format: specify as 0-15/0-15/0-255"
if( ($a[2] !~ m/^[0-9]{1,2}\/[0-9]{1,2}\/[0-9]{1,3}$/i));
my $groupname = eib_name2hex($a[2]);
$hash->{GROUP} = lc($groupname);
my $code = "$groupname";
my $ncode = 1;
my $name = $a[0];
$hash->{CODE}{$ncode++} = $code;
$modules{EIB}{defptr}{$code}{$name} = $hash;
AssignIoPort($hash);
}
#############################
sub
EIB_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
EIB_SetState($$$$)
{
my ($hash, $tim, $vt, $val) = @_;
$val = $1 if($val =~ m/^(.*) \d+$/);
return "Undefined value $val" if(!defined($eib_c2b{$val}));
return undef;
}
###################################
sub
EIB_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 = $eib_c2b{$a[1]};
if(!defined($c)) {
return "Unknown argument $a[1], choose one of " .
join(" ", sort keys %eib_c2b);
}
my $v = join(" ", @a);
Log GetLogLevel($a[0],2), "EIB set $v";
(undef, $v) = split(" ", $v, 2); # Not interested in the name...
if($a[1] eq "value" && $na == 3) {
# complex value command.
# the additional argument is transfered alone.
$c = $a[2];
}
IOWrite($hash, "B", "w" . $hash->{GROUP} . $c);
###########################################
# 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] off";
CommandDefine(undef, $a[0] . "_timer at +$to set $a[0] off");
}
###########################################
# Delete any timer for on-till
if($modules{EIB}{till}{$a[0]}) {
CommandDelete(undef, $a[0] . "_till");
delete $modules{EIB}{till}{$a[0]};
}
###########################################
# Add a timer if on-till command has been chosen
if($a[1] =~ m/on-till/ && $na == 3) {
my ($err, $hr, $min, $sec, $fn) = GetTimeSpec($a[2]);
if($err) {
Log(2,"Error trying to parse timespec for $a[0] $a[1] $a[2] : $err");
}
else {
my @lt = localtime;
my $hms_till = sprintf("%02d:%02d:%02d", $hr, $min, $sec);
my $hms_now = sprintf("%02d:%02d:%02d", $lt[2], $lt[1], $lt[0]);
if($hms_now ge $hms_till) {
Log 4, "on-till: won't switch as now ($hms_now) is later than $hms_till";
}
else {
$modules{EIB}{till}{$a[0]} = $hms_till;
Log 4, "Follow: $hms_till set $a[0] off";
CommandDefine(undef, $a[0] . "_till at $hms_till set $a[0] off");
}
}
}
##########################
# Look for all devices with the same code, and set state, timestamp
my $code = "$hash->{GROUP}";
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
EIB_Parse($$)
{
my ($hash, $msg) = @_;
# Msg format:
# B(w/r/p)<group><value> i.e. Bw00000101
# we will also take reply telegrams into account,
# as they will be sent if the status is asked from bus
if($msg =~ m/^B(.{4})[w|p](.{4})(.*)$/)
{
# only interested in write / reply group messages
my $src = $1;
my $dev = $2;
my $val = $3;
my $v = $codes{$val};
$v = "$val" if(!defined($v));
my $def = $modules{EIB}{defptr}{"$dev"};
if($def) {
my @list;
foreach my $n (keys %{ $def }) {
my $lh = $def->{$n};
$n = $lh->{NAME}; # It may be renamed
return "" if(IsIgnored($n)); # Little strange.
$lh->{CHANGED}[0] = $v;
$lh->{STATE} = $v;
$lh->{READINGS}{state}{TIME} = TimeNow();
$lh->{READINGS}{state}{VAL} = $v;
Log GetLogLevel($n,2), "EIB $n $v";
push(@list, $n);
}
return @list;
} else {
my $dev_name = eib_hex2name($dev);
Log(3, "EIB Unknown device $dev ($dev_name), Value $val, please define it");
return "UNDEFINED EIB_$dev EIB $dev";
}
}
}
#############################
sub
eib_hex2name($)
{
my $v = shift;
my $p1 = hex(substr($v,0,1));
my $p2 = hex(substr($v,1,1));
my $p3 = hex(substr($v,2,2));
my $r = sprintf("%d/%d/%d", $p1,$p2,$p3);
return $r;
}
#############################
sub
eib_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%021%02x",$1,$2,$3);
}
return $r;
}
1;

426
fhem/FHEM/10_FS20.pm
View File

@ -1,426 +0,0 @@
##############################################
package main;
use strict;
use warnings;
my %codes = (
"00" => "off",
"01" => "dim06%",
"02" => "dim12%",
"03" => "dim18%",
"04" => "dim25%",
"05" => "dim31%",
"06" => "dim37%",
"07" => "dim43%",
"08" => "dim50%",
"09" => "dim56%",
"0a" => "dim62%",
"0b" => "dim68%",
"0c" => "dim75%",
"0d" => "dim81%",
"0e" => "dim87%",
"0f" => "dim93%",
"10" => "dim100%",
"11" => "on", # Set to previous dim value (before switching it off)
"12" => "toggle", # between off and previous dim val
"13" => "dimup",
"14" => "dimdown",
"15" => "dimupdown",
"16" => "timer",
"17" => "sendstate",
"18" => "off-for-timer",
"19" => "on-for-timer",
"1a" => "on-old-for-timer",
"1b" => "reset",
"1c" => "ramp-on-time", #time to reach the desired dim value on dimmers
"1d" => "ramp-off-time", #time to reach the off state on dimmers
"1e" => "on-old-for-timer-prev", # old val for timer, then go to prev. state
"1f" => "on-100-for-timer-prev", # 100% for timer, then go to previous state
);
my %readonly = (
"thermo-on" => 1,
"thermo-off" => 1,
);
use vars qw(%fs20_c2b); # Peter would like to access it from outside
my $fs20_simple ="off off-for-timer on on-for-timer on-till reset timer toggle";
my %models = (
fs20hgs => 'sender',
fs20ls => 'sender',
fs20pira => 'sender',
fs20piri => 'sender',
fs20s20 => 'sender',
fs20s16 => 'sender',
fs20s8 => 'sender',
fs20s4 => 'sender',
fs20s4a => 'sender',
fs20s4m => 'sender',
fs20s4u => 'sender',
fs20s4ub => 'sender',
fs20sd => 'sender',
fs20sn => 'sender',
fs20sr => 'sender',
fs20ss => 'sender',
fs20str => 'sender',
fs20tfk => 'sender',
fs20tk => 'sender',
fs20uts => 'sender',
fs20ze => 'sender',
fs20ms2 => 'simple',
fs20as1 => 'simple',
fs20as4 => 'simple',
fs20di => 'dimmer',
fs20di10 => 'dimmer',
fs20du => 'dimmer',
fs20rst => 'simple',
fs20rsu => 'simple',
fs20sa => 'simple',
fs20sig => 'simple',
fs20sm4 => 'simple',
fs20st => 'simple',
fs20su => 'simple',
fs20sv => 'simple',
fs20ue1 => 'simple',
fs20usr => 'simple',
);
sub hex2four($);
sub four2hex($$);
sub
FS20_Initialize($)
{
my ($hash) = @_;
foreach my $k (keys %codes) {
$fs20_c2b{$codes{$k}} = $k;
}
$fs20_c2b{"on-till"} = 99;
$hash->{Match} = "^81..(04|0c)..0101a001";
$hash->{SetFn} = "FS20_Set";
$hash->{StateFn} = "FS20_SetState";
$hash->{DefFn} = "FS20_Define";
$hash->{UndefFn} = "FS20_Undef";
$hash->{ParseFn} = "FS20_Parse";
$hash->{AttrList} = "IODev follow-on-for-timer:1,0 do_not_notify:1,0 ignore:0,1 dummy:1,0 showtime:1,0 model;fs20hgs,fs20hgs,fs20pira,fs20piri,fs20s20,fs20s8,fs20s4,fs20s4a,fs20s4m,fs20s4u,fs20s4ub,fs20sd,fs20sn,fs20sr,fs20ss,fs20str,fs20tfk,fs20tfk,fs20tk,fs20uts,fs20ze,fs20as1,fs20as4,fs20di,fs20du,fs20ls,fs20ms2,fs20rst,fs20sa,fs20sig,fs20st,fs20sv,fs20usr loglevel:0,1,2,3,4,5,6";
}
#####################################
sub
FS20_SetState($$$$)
{
my ($hash, $tim, $vt, $val) = @_;
$val = $1 if($val =~ m/^(.*) \d+$/);
return "Undefined value $val" if(!defined($fs20_c2b{$val}));
return undef;
}
#############################
sub
Do_On_Till($@)
{
my ($hash, @a) = @_;
return "Timespec (HH:MM[:SS]) needed for the on-till command" if(@a != 3);
my ($err, $hr, $min, $sec, $fn) = GetTimeSpec($a[2]);
return $err if($err);
my @lt = localtime;
my $hms_till = sprintf("%02d:%02d:%02d", $hr, $min, $sec);
my $hms_now = sprintf("%02d:%02d:%02d", $lt[2], $lt[1], $lt[0]);
if($hms_now ge $hms_till) {
Log 4, "on-till: won't switch as now ($hms_now) is later than $hms_till";
return "";
}
my @b = ($a[0], "on");
FS20_Set($hash, @b);
my $tname = $hash->{NAME} . "_till";
CommandDelete(undef, $tname) if($defs{$tname});
CommandDefine(undef, "$tname at $hms_till set $a[0] off");
}
###################################
sub
FS20_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 = $fs20_c2b{$a[1]};
if(!defined($c)) {
# Model specific set arguments
if(defined($attr{$a[0]}) && defined($attr{$a[0]}{"model"})) {
my $mt = $models{$attr{$a[0]}{"model"}};
return "Unknown argument $a[1], choose one of "
if($mt && $mt eq "sender");
return "Unknown argument $a[1], choose one of $fs20_simple"
if($mt && $mt eq "simple");
}
return "Unknown argument $a[1], choose one of " .
join(" ", sort keys %fs20_c2b);
}
return Do_On_Till($hash, @a) if($a[1] eq "on-till");
return "Bad time spec" if($na == 3 && $a[2] !~ m/^\d*\.?\d+$/);
my $v = join(" ", @a);
Log GetLogLevel($a[0],2), "FS20 set $v";
(undef, $v) = split(" ", $v, 2); # Not interested in the name...
my $val;
if($na == 3) { # Timed command.
$c = sprintf("%02X", (hex($c) | 0x20)); # Set the extension bit
########################
# Calculating the time.
LOOP: for(my $i = 0; $i <= 12; $i++) {
for(my $j = 0; $j <= 15; $j++) {
$val = (2**$i)*$j*0.25;
if($val >= $a[2]) {
if($val != $a[2]) {
$ret = "FS20 Setting timeout to $val from $a[2]";
Log GetLogLevel($a[0],2), $ret;
}
$c .= sprintf("%x%x", $i, $j);
last LOOP;
}
}
}
return "Specified timeout too large, max is 15360" if(length($c) == 2);
}
IOWrite($hash, "04", "010101" . $hash->{XMIT} . $hash->{BTN} . $c);
###########################################
# Set the state of a device to off if on-for-timer is called
if($modules{FS20}{ldata}{$a[0]}) {
CommandDelete(undef, $a[0] . "_timer");
delete $modules{FS20}{ldata}{$a[0]};
}
if($a[1] =~ m/for-timer/ && $na == 3 &&
defined($attr{$a[0]}) && defined($attr{$a[0]}{"follow-on-for-timer"})) {
my $to = sprintf("%02d:%02d:%02d", $val/3600, ($val%3600)/60, $val%60);
$modules{FS20}{ldata}{$a[0]} = $to;
Log 4, "Follow: +$to setstate $a[0] off";
CommandDefine(undef, $a[0] . "_timer at +$to setstate $a[0] off");
}
##########################
# Look for all devices with the same code, and set state, timestamp
my $code = "$hash->{XMIT} $hash->{BTN}";
my $tn = TimeNow();
foreach my $n (keys %{ $modules{FS20}{defptr}{$code} }) {
my $lh = $modules{FS20}{defptr}{$code}{$n};
$lh->{CHANGED}[0] = $v;
$lh->{STATE} = $v;
$lh->{READINGS}{state}{TIME} = $tn;
$lh->{READINGS}{state}{VAL} = $v;
}
return $ret;
}
#############################
sub
FS20_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $u = "wrong syntax: define <name> FS20 housecode " .
"addr [fg addr] [lm addr] [gm FF]";
return $u if(int(@a) < 4);
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) );
return "Define $a[0]: wrong btn 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 $btncode = $a[3];
$btncode = four2hex($btncode,2) if (length($btncode) == 4);
$hash->{XMIT} = lc($housecode);
$hash->{BTN} = lc($btncode);
my $code = "$housecode $btncode";
my $ncode = 1;
my $name = $a[0];
$hash->{CODE}{$ncode++} = $code;
$modules{FS20}{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;
$modules{FS20}{defptr}{$code}{$name} = $hash;
}
AssignIoPort($hash);
}
#############################
sub
FS20_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 %{ $modules{FS20}{defptr}{$c} }) {
delete($modules{FS20}{defptr}{$c}{$dname})
if($modules{FS20}{defptr}{$c}{$dname} == $hash);
}
}
return undef;
}
sub
FS20_Parse($$)
{
my ($hash, $msg) = @_;
# Msg format:
# 81 0b 04 f7 0101 a001 HHHH 01 00 11
my $dev = substr($msg, 16, 4);
my $btn = substr($msg, 20, 2);
my $cde = substr($msg, 24, 2);
my $dur = 0;
my $cx = hex($cde);
if($cx & 0x20) { # Timed command
$dur = hex(substr($msg, 26, 2));
my $i = ($dur & 0xf0) / 16;
my $j = ($dur & 0xf);
$dur = (2**$i)*$j*0.25;
$cde = sprintf("%02x", $cx & ~0x20);
}
my $v = $codes{$cde};
$v = "unknown_$cde" if(!defined($v));
$v .= " $dur" if($dur);
my $def = $modules{FS20}{defptr}{"$dev $btn"};
if($def) {
my @list;
foreach my $n (keys %{ $def }) {
my $lh = $def->{$n};
$n = $lh->{NAME}; # It may be renamed
return "" if(IsIgnored($n)); # Little strange.
$lh->{CHANGED}[0] = $v;
$lh->{STATE} = $v;
$lh->{READINGS}{state}{TIME} = TimeNow();
$lh->{READINGS}{state}{VAL} = $v;
Log GetLogLevel($n,2), "FS20 $n $v";
if($modules{FS20}{ldata}{$n}) {
CommandDelete(undef, $n . "_timer");
delete $modules{FS20}{ldata}{$n};
}
if($v =~ m/for-timer/ &&
defined($attr{$n}) &&
defined($attr{$n}{"follow-on-for-timer"})) {
my $to = sprintf("%02d:%02d:%02d", $dur/3600, ($dur%3600)/60, $dur%60);
Log 4, "Follow: +$to setstate $n off";
CommandDefine(undef, $n . "_timer at +$to setstate $n off");
$modules{FS20}{ldata}{$n} = $to;
}
push(@list, $n);
}
return @list;
} else {
# Special FHZ initialization parameter. In Multi-FHZ-Mode we receive
# it by the second FHZ
return "" if($dev eq "0001" && $btn eq "00" && $cde eq "00");
my $dev_four = hex2four($dev);
my $btn_four = hex2four($btn);
Log 3, "FS20 Unknown device $dev ($dev_four), " .
"Button $btn ($btn_four) Code $cde ($v), please define it";
return "UNDEFINED FS20_$dev$btn FS20 $dev $btn";
}
}
#############################
sub
hex2four($)
{
my $v = shift;
my $r = "";
foreach my $x (split("", $v)) {
$r .= sprintf("%d%d", (hex($x)/4)+1, (hex($x)%4)+1);
}
return $r;
}
#############################
sub
four2hex($$)
{
my ($v,$len) = @_;
my $r = 0;
foreach my $x (split("", $v)) {
$r = $r*4+($x-1);
}
return sprintf("%0*x", $len,$r);
}
1;

679
fhem/FHEM/11_FHT.pm
View File

@ -1,679 +0,0 @@
#############################################
package main;
use strict;
use warnings;
sub doSoftBuffer($);
sub softBufferTimer($);
sub getFhtMin($);
sub getFhtBuffer($);
my %codes = (
"00" => "actuator",
"01" => "actuator1",
"02" => "actuator2",
"03" => "actuator3",
"04" => "actuator4",
"05" => "actuator5",
"06" => "actuator6",
"07" => "actuator7",
"08" => "actuator8",
"14" => "mon-from1",
"15" => "mon-to1",
"16" => "mon-from2",
"17" => "mon-to2",
"18" => "tue-from1",
"19" => "tue-to1",
"1a" => "tue-from2",
"1b" => "tue-to2",
"1c" => "wed-from1",
"1d" => "wed-to1",
"1e" => "wed-from2",
"1f" => "wed-to2",
"20" => "thu-from1",
"21" => "thu-to1",
"22" => "thu-from2",
"23" => "thu-to2",
"24" => "fri-from1",
"25" => "fri-to1",
"26" => "fri-from2",
"27" => "fri-to2",
"28" => "sat-from1",
"29" => "sat-to1",
"2a" => "sat-from2",
"2b" => "sat-to2",
"2c" => "sun-from1",
"2d" => "sun-to1",
"2e" => "sun-from2",
"2f" => "sun-to2",
"3e" => "mode",
"3f" => "holiday1", # Not verified
"40" => "holiday2", # Not verified
"41" => "desired-temp",
"XX" => "measured-temp", # sum of next. two, never really sent
"42" => "measured-low",
"43" => "measured-high",
"44" => "warnings",
"45" => "manu-temp", # No clue what it does.
"4b" => "ack",
"53" => "can-xmit",
"54" => "can-rcv",
"60" => "year",
"61" => "month",
"62" => "day",
"63" => "hour",
"64" => "minute",
"65" => "report1",
"66" => "report2",
"69" => "ack2",
"7d" => "start-xmit",
"7e" => "end-xmit",
"82" => "day-temp",
"84" => "night-temp",
"85" => "lowtemp-offset", # Alarm-Temp.-Differenz
"8a" => "windowopen-temp",
);
my %cantset = (
"actuator" => 1,
"actuator1" => 1,
"actuator2" => 1,
"actuator3" => 1,
"actuator4" => 1,
"actuator5" => 1,
"actuator6" => 1,
"actuator7" => 1,
"actuator8" => 1,
"ack" => 1,
"ack2" => 1,
"battery" => 1,
"can-xmit" => 1,
"can-rcv" => 1,
"start-xmit" => 1,
"end-xmit" => 1,
"lowtemp" => 1,
"measured-temp" => 1,
"measured-high" => 1,
"measured-low" => 1,
"warnings" => 1,
"window" => 1,
"windowsensor" => 1,
);
# additional warnings
my %warnings = (
"battery" => 1,
"lowtemp" => 1,
"window" => 1,
"windowsensor" => 1,
);
my %priority = (
"desired-temp"=> 1,
"mode" => 2,
"report1" => 3,
"report2" => 3,
"holiday1" => 4,
"holiday2" => 5,
"day-temp" => 6,
"night-temp" => 7,
);
my %c2m = (0 => "auto", 1 => "manual", 2 => "holiday", 3 => "holiday_short");
my %m2c; # Reverse c2m
my %c2b; # command->button hash (reverse of codes)
my %c2bset; # command->button hash (settable values)
my $defmin = 0; # min fhtbuf free bytes before sending commands
my $retryafter = 240; # in seconds, only when fhtsoftbuffer is active
my $cmdcount = 0;
#####################################
sub
FHT_Initialize($)
{
my ($hash) = @_;
foreach my $k (keys %codes) {
my $v = $codes{$k};
$c2b{$v} = $k;
$c2bset{$v} = $k if(!$cantset{$v});
}
foreach my $k (keys %c2m) {
$m2c{$c2m{$k}} = $k;
}
# 810c0426 0909a001 1111 1600
# 810c04b3 0909a001 1111 44006900
# 810b0402 83098301 1111 41301d
# 81090421 c409c401 1111 00
# 810c0d20 0909a001 3232 7e006724 (NYI)
$hash->{Match} = "^81..(04|09|0d)..(0909a001|83098301|c409c401)..";
$hash->{SetFn} = "FHT_Set";
$hash->{StateFn} = "FHT_SetState";
$hash->{DefFn} = "FHT_Define";
$hash->{UndefFn} = "FHT_Undef";
$hash->{ParseFn} = "FHT_Parse";
$hash->{AttrList} = "IODev do_not_notify:0,1 model;fht80b dummy:0,1 " .
"showtime:0,1 loglevel:0,1,2,3,4,5,6 retrycount " .
"minfhtbuffer lazy tmpcorr ignore:0,1";
}
sub
FHT_Set($@)
{
my ($hash, @a) = @_;
my $ret = "";
return "\"set $a[0]\" needs at least two parameters" if(@a < 2);
my $name = shift(@a);
# Replace refreshvalues with report1 and report2, and time with hour/minute
for(my $i = 0; $i < @a; $i++) {
splice(@a,$i,1,("report1","255","report2","255"))
if($a[$i] eq "refreshvalues");
if($a[$i] eq "time") {
my @t = localtime;
splice(@a,$i,1,("hour",$t[2],"minute",$t[1]));
}
if($a[$i] eq "date") {
my @t = localtime;
splice(@a,$i,1,("year",$t[5]-100,"month",$t[4]+1,"day",$t[3]));
}
}
my $ncmd = 0;
my $arg = "020183" . $hash->{CODE};
my ($cmd, $allcmd, $val) = ("", "", "");
my $lazy= defined($attr{$name}) &&
defined($attr{$name}{"lazy"}) &&
($attr{$name}{"lazy"}>0);
my $readings= $hash->{READINGS};
while(@a) {
$cmd = shift(@a);
return "Unknown argument $cmd, choose one of " . join(" ",sort keys %c2bset)
if(!defined($c2b{$cmd}));
return "Readonly parameter $cmd"
if(defined($cantset{$cmd}));
return "\"set $name $cmd\" needs a parameter"
if(@a < 1);
$val = shift(@a);
$arg .= $c2b{$cmd};
if ($cmd =~ m/-temp/) {
return "Invalid temperature, use NN.N" if($val !~ m/^\d*\.?\d+$/);
return "Invalid temperature, must between 5.5 and 30.5"
if($val < 5.5 || $val > 30.5);
my $a = int($val*2);
$arg .= sprintf("%02x", $a);
$ret .= sprintf("Rounded temperature to %.1f", $a/2) if($a/2 != $val);
$val = sprintf("%.1f", $a/2);
} elsif($cmd =~ m/-from/ || $cmd =~ m/-to/) {
return "Invalid timeformat, use HH:MM"
if($val !~ m/^([0-2]\d):([0-5]\d)/);
my $a = ($1*6) + ($2/10);
$arg .= sprintf("%02x", $a);
my $nt = sprintf("%02d:%02d", $1, int($2/10)*10);
$ret .= "Rounded $cmd to $nt" if($nt ne $val);
$val = $nt;
} elsif($cmd eq "mode") {
return "Invalid mode, use one of " . join(" ", sort keys %m2c)
if(!defined($m2c{$val}));
$arg .= sprintf("%02x", $m2c{$val});
} elsif ($cmd eq "lowtemp-offset") {
return "Invalid lowtemperature-offset, must between 1 and 5"
if($val !~ m/^[1-5]$/);
$arg .= sprintf("%02x", $val);
$val = "$val.0";
} else { # Holiday1, Holiday2
return "Invalid argument, must be between 1 and 255"
if($val !~ m/^\d+$/ || $val < 0 || $val > 255);
$arg .= sprintf("%02x", $val) if(defined($val));
}
if($lazy &&
$cmd ne "report1" && $cmd ne "report2" && $cmd ne "refreshvalues" &&
defined($readings->{$cmd}) && $readings->{$cmd}{VAL} eq $val) {
$ret .= "Lazy mode ignores $cmd";
Log GetLogLevel($name,2), "Lazy mode ignores $cmd $val";
} else {
$ncmd++;
$allcmd .=" " if($allcmd);
$allcmd .= $cmd;
$allcmd .= " $val" if($val);
}
}
return "Too many commands specified, an FHT only supports up to 8"
if($ncmd > 8);
return $ret if(!$ncmd);
my $ioname = "";
$ioname = $hash->{IODev}->{NAME} if($hash->{IODev});
if($attr{$ioname} && $attr{$ioname}{fhtsoftbuffer}) {
my $io = $hash->{IODev};
my %h = (HASH => $hash, CMD => $allcmd, ARG => $arg);
my $prio = $priority{$cmd};
$prio = "9" if(!$prio);
my $key = $prio . ":" . gettimeofday() . ":" . $cmdcount++;
$io->{SOFTBUFFER}{$key} = \%h;
doSoftBuffer($io);
} else {
IOWrite($hash, "04", $arg);
Log GetLogLevel($name,2), "FHT set $name $allcmd";
}
return $ret;
}
#####################################
sub
FHT_SetState($$$$)
{
my ($hash, $tim, $vt, $val) = @_;
return "Ignoring FHZ state" if($vt =~ m/^FHZ:/);
$vt =~ s/^FHZ://;
return "Undefined type $vt" if(!defined($c2b{$vt}) && !defined($warnings{$vt}));
return undef;
}
#####################################
sub
FHT_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "wrong syntax: define <name> FHT 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]$/i);
$hash->{CODE} = $a[2];
AssignIoPort($hash);
# Check if the CULs id collides with our id.
if($hash->{IODev} && $hash->{IODev}{TYPE} eq "CUL") {
$hash->{IODev}{FHTID} =~ m/^(..)(..)$/;
my ($i1, $i2) = (hex($1), hex($2));
$a[2] =~ m/^(..)(..)$/;
my ($l1, $l2) = (hex($1), hex($2));
if($l2 == $i2 && $l1 >= $i1 && $l1 <= $i1+7) {
my $err = "$a[0]: CODE collides with the FHTID of the corresponding CUL";
Log 1, $err;
return $err;
}
}
$modules{FHT}{defptr}{$a[2]} = $hash;
$attr{$a[0]}{retrycount} = 3;
#Log GetLogLevel($a[0],2),"Asking the FHT device $a[0]/$a[2] to send its data";
#FHT_Set($hash, ($a[0], "report1", "255", "report2", "255"));
return undef;
}
#####################################
sub
FHT_Undef($$)
{
my ($hash, $name) = @_;
delete($modules{FHT}{defptr}{$hash->{CODE}}) if($hash && $hash->{CODE});
return undef;
}
#####################################
sub
FHT_Parse($$)
{
my ($hash, $msg) = @_;
$msg = lc($msg);
my $dev = substr($msg, 16, 4);
my $cde = substr($msg, 20, 2);
my $val = substr($msg, 26, 2) if(length($msg) > 26);
my $confirm = 0;
if(!defined($modules{FHT}{defptr}{$dev})) {
Log 3, "FHT Unknown device $dev, please define it";
return "UNDEFINED FHT_$dev FHT $dev";
}
my $def = $modules{FHT}{defptr}{$dev};
my $name = $def->{NAME};
return "" if(IsIgnored($name));
my $io = $def->{IODev};
my $ll4 = GetLogLevel($name,4);
# Short message
if(length($msg) < 26) {
Log $ll4,"FHT Short message. Device $name, Message: $msg";
return "";
}
if($io->{TYPE} eq "CUL") {
$confirm = 1;
} elsif(!$val || $cde eq "65" || $cde eq "66") {
# This is a confirmation message. We reformat it so that
# it looks like a real message, and let the rest parse it
Log $ll4, "FHT $name confirmation: $cde";
$val = substr($msg, 22, 2);
$confirm = 1;
}
$val = hex($val);
my $cmd = $codes{$cde};
if(!$cmd) {
Log $ll4, "FHT $name (Unknown: $cde => $val)";
$def->{CHANGED}[0] = "unknown_$cde: $val";
return $name;
}
my $tn = TimeNow();
# counter for notifies
my $nc = 0;
###########################
# Reformat the values so they are readable.
# The first four are confirmation messages, so they must be converted to
# the same format as the input (for the softbuffer)
if($cmd =~ m/-from/ || $cmd =~ m/-to/) {
$val = sprintf("%02d:%02d", $val/6, ($val%6)*10);
} elsif($cmd eq "mode") {
$val = $c2m{$val} if(defined($c2m{$val}));
} elsif($cmd =~ m/.*-temp/) {
$val = sprintf("%.1f", $val / 2)
} elsif($cmd eq "lowtemp-offset") {
$val = sprintf("%d.0", $val)
} elsif($cmd =~ m/^actuator/) {
my $sval = lc(substr($msg,24,2));
my $fv = sprintf("%d%%", int(100*$val/255+0.5));
if($sval =~ m/[ab]0/) { $val = $fv; } # sync in the summer
elsif($sval =~ m/.0/) { $val = "syncnow"; }
elsif($sval =~ m/.1/) { $val = "99%" } # FHT set to 30.5, FHT80B=="ON"
elsif($sval =~ m/.2/) { $val = "0%" } # FHT set to 5.5
elsif($sval =~ m/.6/) { $val = "$fv" }
elsif($sval =~ m/.8/) { $val = "offset: " . ($val>128?(128-$val):$val) }
elsif($sval =~ m/[23]a/) { $val = "lime-protection" }
elsif($sval =~ m/[ab]a/) { $val = $fv } # lime protection bug
elsif($sval =~ m/.c/) { $val = sprintf("synctime: %d", int($val/2)-1); }
elsif($sval =~ m/.e/) { $val = "test" }
elsif($sval =~ m/.f/) { $val = "pair" }
else { $val = "unknown_$sval: $fv" }
} elsif($cmd eq "measured-low") {
$def->{READINGS}{$cmd}{TIME} = $tn;
$def->{READINGS}{$cmd}{VAL} = $val;
return "";
} elsif($cmd eq "measured-high") {
$def->{READINGS}{$cmd}{TIME} = $tn;
$def->{READINGS}{$cmd}{VAL} = $val;
if(defined($def->{READINGS}{"measured-low"}) &&
defined($def->{READINGS}{"measured-low"}{VAL})) {
my $off = ($attr{$name} && $attr{$name}{tmpcorr}) ?
$attr{$name}{tmpcorr} : 0;
$val = $val*256 + $def->{READINGS}{"measured-low"}{VAL};
$val /= 10;
$val = sprintf("%.1f (Celsius)", $val+$off);
$cmd = "measured-temp";
} else {
return "";
}
} elsif($cmd eq "warnings") {
my $nVal;
# initialize values for additional warnings
my $valBattery;
my $valLowTemp;
my $valWindow;
my $valSensor;
my $nBattery;
my $nLowTemp;
my $nWindow;
my $nSensor;
# parse warnings
if($val & 1) {
$nVal = "Battery low";
$nBattery = "low";
}
if($val & 2) {
$nVal .= "; " if($nVal); $nVal .= "Temperature too low";
$nLowTemp = "warn";
}
if($val &32) {
$nVal .= "; " if($nVal); $nVal .= "Window open";
$nWindow = "open";
}
if($val &16) {
$nVal .= "; " if($nVal); $nVal .= "Fault on window sensor";
$nSensor = "fault";
}
# set default values or new values if they were changed
$valBattery = $nBattery? $nBattery : "ok";
$valLowTemp = $nLowTemp? $nLowTemp : "ok";
$valWindow = $nWindow? $nWindow : "closed";
$valSensor = $nSensor? $nSensor : "ok";
$val = $nVal? $nVal : "none";
# set additional warnings and trigger notify
$def->{READINGS}{'battery'}{TIME} = $tn;
$def->{READINGS}{'battery'}{VAL} = $valBattery;
$def->{CHANGED}[$nc] = "battery: $valBattery";
Log $ll4, "FHT $name battery: $valBattery";
$nc++;
$def->{READINGS}{'lowtemp'}{TIME} = $tn;
$def->{READINGS}{'lowtemp'}{VAL} = $valLowTemp;
$def->{CHANGED}[$nc] = "lowtemp: $valLowTemp";
Log $ll4, "FHT $name lowtemp: $valLowTemp";
$nc++;
$def->{READINGS}{'window'}{TIME} = $tn;
$def->{READINGS}{'window'}{VAL} = $valWindow;
$def->{CHANGED}[$nc] = "window: $valWindow";
Log $ll4, "FHT $name window: $valWindow";
$nc++;
$def->{READINGS}{'windowsensor'}{TIME} = $tn;
$def->{READINGS}{'windowsensor'}{VAL} = $valSensor;
$def->{CHANGED}[$nc] = "windowsensor: $valSensor";
Log $ll4, "FHT $name windowsensor: $valSensor";
$nc++;
}
if(substr($msg,24,1) eq "7") { # Do not store FHZ acks.
$cmd = "FHZ:$cmd";
} else {
$def->{READINGS}{$cmd}{TIME} = $tn;
$def->{READINGS}{$cmd}{VAL} = $val;
$def->{STATE} = "$cmd: $val" if($cmd eq "measured-temp");
}
$def->{CHANGED}[$nc] = "$cmd: $val";
Log $ll4, "FHT $name $cmd: $val";
################################
# Softbuffer: delete confirmed commands
if($confirm) {
my $found;
foreach my $key (sort keys %{$io->{SOFTBUFFER}}) {
my $h = $io->{SOFTBUFFER}{$key};
my $hcmd = $h->{CMD};
my $hname = $h->{HASH}->{NAME};
Log $ll4, "FHT softbuffer check: $hname / $hcmd";
if($hname eq $name && $hcmd =~ m/^$cmd $val/) {
$found = $key;
Log $ll4, "FHT softbuffer found";
last;
}
}
delete($io->{SOFTBUFFER}{$found}) if($found);
}
return $name;
}
# Check the softwarebuffer and send/resend commands
sub
doSoftBuffer($)
{
my ($io) = @_;
my $now = gettimeofday();
my $count = 0;
my $fhzbuflen = -999;
foreach my $key (keys %{ $io->{SOFTBUFFER} }) {
$count++;
my $h = $io->{SOFTBUFFER}{$key};
my $name = $h->{HASH}->{NAME};
if($h->{NSENT}) {
next if($now-$h->{SENDTIME} < $retryafter);
my $retry = $attr{$name}{retrycount};
if($h->{NSENT} > $retry) {
Log GetLogLevel($name,2), "$name set $h->{CMD}: ".
"no confirmation after $h->{NSENT} tries, giving up";
delete($io->{SOFTBUFFER}{$key});
next;
}
}
# Check if it is still in the CUL buffer.
if($io->{TYPE} eq "CUL") {
my $cul = CallFn($io->{NAME}, "GetFn", $io, (" ", "raw", "T02"));
my $arg = uc($h->{ARG});
$arg =~ s/^020183//;
$arg =~ s/(....)/,$1/g;
$arg =~ s/,(....),/$1:/;
$arg = uc($arg);
if($cul =~ m/$arg/) {
Log GetLogLevel($name,3), "fhtsoftbuffer: $name set $h->{CMD} ".
"is still in the culfw buffer, wont send it again";
$h->{SENDTIME} = $now;
$h->{NSENT}++;
next;
}
}
$fhzbuflen = getFhtBuffer($io) if($fhzbuflen == -999);
my $arglen = length($h->{ARG})/2 - 2; # Length in bytes
next if($fhzbuflen < $arglen || $fhzbuflen < getFhtMin($io));
IOWrite($h->{HASH}, "04", $h->{ARG});
Log GetLogLevel($name,2), "FHT set $name $h->{CMD}";
$fhzbuflen -= $arglen;
$h->{SENDTIME} = $now;
$h->{NSENT}++;
}
if($count && !$io->{SOFTBUFFERTIMER}) {
$io->{SOFTBUFFERTIMER} = 1;
InternalTimer(gettimeofday()+30, "softBufferTimer", $io, 0);
}
}
#####################################
# Wrapper for the InternalTimer
sub
softBufferTimer($)
{
my ($io) = @_;
delete($io->{SOFTBUFFERTIMER});
doSoftBuffer($io);
}
#####################################
sub
getFhtMin($)
{
my ($io) = @_;
my $ioname = $io->{NAME};
return $attr{$ioname}{minfhtbuffer}
if($attr{$ioname} && $attr{$ioname}{minfhtbuffer});
return $defmin;
}
#####################################
# get the FHZ hardwarebuffer without logentry as decimal value
sub
getFhtBuffer($)
{
my ($io) = @_;
my $count = 0;
return getFhtMin($io) if(IsDummy($io->{NAME}));
for(;;) {
return 0 if(!defined($io->{FD})); # Avoid crash if the CUL/FHZ is absent
my $msg = CallFn($io->{NAME}, "GetFn", $io, (" ", "fhtbuf"));
Log 5, "getFhtBuffer: $count $msg";
return hex($1) if($msg && $msg =~ m/=> ([0-9A-F]+)$/i);
return 0 if($count++ >= 5);
}
}
1;

107
fhem/FHEM/11_FHT8V.pm
View File

@ -1,107 +0,0 @@
#############################################
package main;
use strict;
use warnings;
sub
FHT8V_Initialize($)
{
my ($hash) = @_;
$hash->{DefFn} = "FHT8V_Define";
$hash->{SetFn} = "FHT8V_Set";
$hash->{GetFn} = "FHT8V_Get";
$hash->{AttrList} = "IODev dummy:1,0 ignore:1,0 loglevel:0,1,2,3,4,5,6";
}
#############################
sub
FHT8V_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $n = $a[0];
return "wrong syntax: define <name> FHT8V housecode [IODev]" if(@a < 3);
return "wrong housecode format: specify a 4 digit hex value "
if(($a[2] !~ m/^[a-f0-9]{4}$/i));
if(@a > 3) {
$hash->{IODev} = $defs{$a[3]};
} else {
AssignIoPort($hash);
}
return "$n: No IODev found" if(!$hash->{IODev});
return "$n: Wrong IODev, has no FHTID" if(!$hash->{IODev}->{FHTID});
#####################
# Check if the address corresponds to the CUL
my $ioaddr = hex($hash->{IODev}->{FHTID});
my $myaddr = hex($a[2]);
my ($io1, $io0) = (int($ioaddr/255), $ioaddr % 256);
my ($my1, $my0) = (int($myaddr/255), $myaddr % 256);
if($my1 < $io1 || $my1 > $io1+7 || $io0 != $my0) {
my $vals = "";
for(my $m = 0; $m <= 7; $m++) {
$vals .= sprintf(" %2x%2x", $io1+$m, $io0);
}
return sprintf("Wrong housecode: must be one of$vals");
}
$hash->{addr} = uc($a[2]);
$hash->{idx} = sprintf("%02X", $my1-$io1);
$hash->{STATE} = "defined";
return "";
}
sub
FHT8V_Set($@)
{
my ($hash, @a) = @_;
my $n = $hash->{NAME};
return "Need a parameter for set" if(@a < 2);
my $arg = $a[1];
if($arg eq "valve" ) {
return "Set valve needs a numeric parameter between 0 and 100"
if(@a != 3 || $a[2] !~ m/^\d+$/ || $a[2] < 0 || $a[2] > 100);
Log GetLogLevel($n,3), "FHT8V set $n $arg $a[2]";
$hash->{STATE} = sprintf("%d %%", $a[2]);
IOWrite($hash, "", sprintf("T%s0026%02X", $hash->{addr}, $a[2]*2.55));
} elsif ($arg eq "pair" ) {
Log GetLogLevel($n,3), "FHT8V set $n $arg";
IOWrite($hash, "", sprintf("T%s002f00", $hash->{addr}));
} else {
return "Unknown argument $a[1], choose one of valve pair"
}
return "";
}
sub
FHT8V_Get($@)
{
my ($hash, @a) = @_;
my $n = $hash->{NAME};
return "Need a parameter for get" if(@a < 2);
my $arg = $a[1];
if($arg eq "valve" ) {
my $io = $hash->{IODev};
my $msg = CallFn($io->{NAME}, "GetFn", $io, (" ", "raw", "T10"));
my $idx = $hash->{idx};
return int(hex($1)/2.55) if($msg =~ m/$idx:26(..)/);
return "N/A";
}
return "Unknown argument $a[1], choose one of valve"
}
1;

232
fhem/FHEM/12_HMS.pm
View File

@ -1,232 +0,0 @@
##############################################
package main;
use strict;
use warnings;
my %codes = (
"0" => "HMS100TF",
"1" => "HMS100T",
"2" => "HMS100WD",
"3" => "RM100-2",
"4" => "HMS100TFK", # Depending on the onboard jumper it is 4 or 5
"5" => "HMS100TFK",
"6" => "HMS100MG",
"8" => "HMS100CO",
"e" => "HMS100FIT",
);
#####################################
sub
HMS_Initialize($)
{
my ($hash) = @_;
# 810e047e0510a001473a000000120233 HMS100TF
# 810e04b90511a0018e63000001100000 HMS100T
# 810e04e80212a001ec46000001000000 HMS100WD
# 810e04d70213a001b16d000003000000 RM100-2
# 810e047f0214a001a81f000001000000 HMS100TFK
# 810e048f0295a0010155000001000000 HMS100TFK (jumper)
# 810e04330216a001b4c5000001000000 HMS100MG
# 810e04210218a00186e0000000000000 HMS100CO
# 810e0448029ea00132d5000000000000 FI-Trenner
$hash->{Match} = "^810e04....(1|5|9).a001";
$hash->{DefFn} = "HMS_Define";
$hash->{UndefFn} = "HMS_Undef";
$hash->{ParseFn} = "HMS_Parse";
$hash->{AttrList} = "IODev do_not_notify:0,1 showtime:0,1 model;hms100-t,hms100-tf,hms100-wd,hms100-mg,hms100-tfk,rm100-2,hms100-co,hms100-fit loglevel:0,1,2,3,4,5,6 ignore:0,1";
}
#####################################
sub
HMS_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "wrong syntax: define <name> HMS 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{HMS}{defptr}{$a[2]} = $hash;
AssignIoPort($hash);
return undef;
}
#####################################
sub
HMS_Undef($$)
{
my ($hash, $name) = @_;
delete($modules{HMS}{defptr}{$hash->{CODE}})
if(defined($hash->{CODE}) &&
defined($modules{HMS}{defptr}{$hash->{CODE}}));
return undef;
}
#####################################
sub
HMS_Parse($$)
{
my ($hash, $msg) = @_;
my $dev = substr($msg, 16, 4);
my $cde = substr($msg, 11, 1);
# 012345678901234567890123456789
# 810e047f0214a001a81f000001000000 HMS100TFK
my $val = substr($msg, 24, 8) if(length($msg) == 32);
my $type = "";
foreach my $c (keys %codes) {
if($cde =~ m/$c/) {
$type = $codes{$c};
last;
}
}
# As the HMS devices change their id on each battery change, we offer
# a wildcard too for each type: 100<device-code>,
my $odev = $dev;
if(!defined($modules{HMS}{defptr}{$dev})) {
Log 4, "HMS device $dev not defined, using the wildcard device 100$cde";
$dev = "100$cde";
}
if(!defined($modules{HMS}{defptr}{$dev})) {
Log 3, "Unknown HMS device $dev/$odev, please define it";
$type = "HMS" if(!$type);
$type =~ s/-//; # RM100-2, - is special in fhem names
return "UNDEFINED ${type}_$odev HMS $odev";
}
my $def = $modules{HMS}{defptr}{$dev};
my $name = $def->{NAME};
return "" if(IsIgnored($name));
my (@v, @txt);
# Used for HMS100TF & HMS100T
my $batstr1 = "ok";
my $status1 = hex(substr($val, 0, 1));
$batstr1 = "empty" if( $status1 & 2 );
$batstr1 = "replaced" if( $status1 & 4 );
# Used for the other devices
my $batstr2 = "ok";
my $status = hex(substr($val, 1, 1));
my $status2 = hex(substr($msg, 10, 1));
$batstr2 = "empty" if( $status2 & 4 );
$batstr2 = "replaced" if( $status2 & 8 );
if($type eq "HMS100TF") {
@txt = ( "temperature", "humidity", "battery");
# Codierung <s1><s0><t1><t0><f0><t2><f2><f1>
$v[0] = int(substr($val, 5, 1) . substr($val, 2, 2))/10;
$v[0] = -$v[0] if($status1 & 8);
$v[1] = int(substr($val, 6, 2) . substr($val, 4, 1))/10;
$v[2] = $batstr1;
$val = "T: $v[0] H: $v[1] Bat: $v[2]";
$v[0] = "$v[0] (Celsius)";
$v[1] = "$v[1] (%)";
} elsif ($type eq "HMS100T") {
@txt = ( "temperature", "battery");
$v[0] = int(substr($val, 5, 1) . substr($val, 2, 2))/10;
$v[0] = -$v[0] if($status1 & 8);
$v[1] = $batstr1;
$val = "T: $v[0] Bat: $v[1]";
$v[0] = "$v[0] (Celsius)";
} elsif ($type eq "HMS100WD") {
@txt = ( "water_detect", "battery");
$v[0] = ($status ? "on" : "off");
$v[1] = $batstr2;
$val = "Water Detect: $v[0]";
} elsif ($type eq "HMS100TFK") { # By Peter P.
@txt = ( "switch_detect", "battery");
$v[0] = ($status ? "on" : "off");
$v[1] = $batstr2;
$val = "Switch Detect: $v[0]";
} elsif($type eq "RM100-2") {
@txt = ( "smoke_detect", "battery");
$v[0] = ($status ? "on" : "off");
$v[1] = $batstr2;
$val = "smoke_detect: $v[0]";
} elsif ($type eq "HMS100MG") { # By Peter Stark
@txt = ( "gas_detect", "battery");
$v[0] = ($status ? "on" : "off");
$v[1] = $batstr2; # Battery conditions not yet verified
$val = "Gas Detect: $v[0]";
} elsif ($type eq "HMS100CO") { # By PAN
@txt = ( "gas_detect", "battery");
$v[0] = ($status ? "on" : "off");
$v[1] = $batstr2; # Battery conditions not yet verified
$val = "CO Detect: $v[0]";
} elsif ($type eq "HMS100FIT") { # By PAN
@txt = ( "fi_triggered", "battery");
$v[0] = ($status ? "on" : "off");
$v[1] = $batstr2; # Battery conditions not yet verified
$val = "FI triggered: $v[0]";
} else {
Log 3, "HMS Device $dev (Unknown type: $type)";
return "";
}
my $now = TimeNow();
Log GetLogLevel($name,4), "HMS Device $dev ($type: $val)";
my $max = int(@txt);
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;
$def->{CHANGED}[$max++] = "ExactId: $odev" if($odev ne $dev);
return $name;
}
1;

332
fhem/FHEM/13_KS300.pm
View File

@ -1,332 +0,0 @@
##############################################
package main;
use strict;
use warnings;
#####################################
sub
KS300_Initialize($)
{
my ($hash) = @_;
# Message is like
# 810d04f94027a00171212730000008
# 81 0d 04 f9 4027a00171 212730000008
$hash->{Match} = "^810d04..4027a001";
$hash->{DefFn} = "KS300_Define";
$hash->{UndefFn} = "KS300_Undef";
$hash->{ParseFn} = "KS300_Parse";
$hash->{AttrList} = "IODev do_not_notify:0,1 showtime:0,1 model:ks300 loglevel:0,1 rainadjustment:0,1 ignore:0,1";
}
#####################################
sub
KS300_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "wrong syntax: define <name> KS300 <code> " .
"[ml/raincounter] [wind-factor]" if(int(@a) < 3 || int(@a) > 5);
$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];
my $rainunit = ((int(@a) > 3) ? $a[3] : 255);
my $windunit = ((int(@a) > 4) ? $a[4] : 1.0);
$hash->{CODE} = $a[2];
$hash->{RAINUNIT} = $rainunit;
$hash->{WINDUNIT} = $windunit;
$modules{KS300}{defptr}{$a[2]} = $hash;
AssignIoPort($hash);
return undef;
}
#####################################
sub
KS300_Undef($$)
{
my ($hash, $name) = @_;
delete($modules{KS300}{defptr}{$hash->{CODE}});
return undef;
}
#####################################
sub
KS300_Parse($$)
{
my ($hash,$msg) = @_;
###############################
# 1 2
#0123456789012345 67890123456789
#
#810d04f94027a001 71212730000008
###############################
my @a = split("", $msg);
##########################
# I've seldom (1 out of 700) seen messages of length 10 and 11 with correct
# CRC, they seem to contain partial data (e.g. temp/wind/hum but not rain)
# They are suppressed as of now.
if(hex($a[3]) != 13) {
Log 4, "Strange KS300 message received, won't decode ($msg)";
return "";
}
if(int(keys %{ $modules{KS300}{defptr} })) {
my @arr = keys(%{ $modules{KS300}{defptr} }); # No code is known yet
my $dev = shift(@arr);
my $def = $modules{KS300}{defptr}{$dev};
my $haverain = 0;
my $name= $def->{NAME};
return "" if(IsIgnored($name));
my @v;
my @txt = ( "rain_raw", "rain", "wind", "humidity", "temperature",
"israining", "unknown1", "unknown2", "unknown3");
my @sfx = ( "(counter)", "(l/m2)", "(km/h)", "(%)", "(Celsius)",
"(yes/no)", "","","");
my %repchanged = ("rain"=>1, "wind"=>1, "humidity"=>1, "temperature"=>1,
"israining"=>1);
# counter for the change hash
my $n= 1; # 0 is STATE and will b explicitely set
# time
my $tm = TimeNow();
my $tsecs= time(); # number of non-leap seconds since January 1, 1970, UTC
# The next instr wont work for empty hashes, so we init it now
$def->{READINGS}{$txt[0]}{VAL} = 0 if(!$def->{READINGS});
my $r = $def->{READINGS};
# preset current $rain_raw
$v[0] = hex("$a[28]$a[27]$a[26]");
my $rain_raw= $v[0];
# get previous rain_raw
my $rain_raw_prev= $rain_raw;
if(defined($r->{rain_raw})) {
($rain_raw_prev, undef)= split(" ", $r->{rain_raw}{VAL}); # cut off "(counter)"
};
# unadjusted value as default
my $rain_raw_adj= $rain_raw;
# get previous rain_raw_adj
my $rain_raw_adj_prev= $rain_raw;
if(defined($r->{rain_raw_adj})) {
$rain_raw_adj_prev= $r->{rain_raw_adj}{VAL};
};
if(defined($attr{$name}) &&
defined($attr{$name}{"rainadjustment"}) &&
($attr{$name}{"rainadjustment"}>0)) {
# The rain values delivered by my KS300 randomly switch between two
# different values. The offset between the two values follows no
# identifiable principle. It is even unclear whether the problem is
# caused by KS300 or by FHZ1300. ELV denies any problem with the KS300.
# The problem is known to several people. For instance, see
# http://www.ipsymcon.de/forum/showthread.php?t=3303&highlight=ks300+regen&page=3
# The following code detects and automatically corrects these offsets.
my $rain_raw_ofs;
my $rain_raw_ofs_prev;
my $tsecs_prev;
# get previous offet
if(defined($r->{rain_raw_ofs})) {
$rain_raw_ofs_prev= $r->{rain_raw_ofs}{VAL};
} else{
$rain_raw_ofs_prev= 0;
}
# the current offset is the same, but this may change later
$rain_raw_ofs= $rain_raw_ofs_prev;
# get previous tsecs
if(defined($r->{tsecs})) {
$tsecs_prev= $r->{tsecs}{VAL};
} else{
$tsecs_prev= 0; # 1970-01-01
}
# detect error condition
# delta is negative or delta is too large
# see http://de.wikipedia.org/wiki/Niederschlagsintensit??t#Niederschlagsintensit.C3.A4t
# during a thunderstorm in middle europe, 50l/m^2 rain may fall per hour
# 50l/(m^2*h) correspond to 200 ticks/h
# Since KS300 sends every 2,5 minutes, a maximum delta of 8 ticks would
# be reasonable. The observed deltas are in most cases 1 or 2 orders
# of magnitude larger.
# The code also handles counter resets after battery replacement
my $rain_raw_delta= $rain_raw- $rain_raw_prev;
if($tsecs!= $tsecs_prev) { # avoids a rare but relevant condition
my $thours_delta= ($tsecs- $tsecs_prev)/3600.0; # in hours
my $rain_raw_per_hour= $rain_raw_delta/$thours_delta;
if(($rain_raw_delta<0) || ($rain_raw_per_hour> 200.0)) {
$rain_raw_ofs= $rain_raw_ofs_prev-$rain_raw_delta;
# If the switch in the tick count occurs simultaneously with an
# increase due to rain, the tick is lost. We therefore assume that
# offsets between -5 and 0 are indeed rain.
if(($rain_raw_ofs>=-5) && ($rain_raw_ofs<0)) { $rain_raw_ofs= 0; }
$r->{rain_raw_ofs}{TIME} = $tm;
$r->{rain_raw_ofs}{VAL} = $rain_raw_ofs;
$def->{CHANGED}[$n++] = "rain_raw_ofs: $rain_raw_ofs";
}
}
$rain_raw_adj= $rain_raw+ $rain_raw_ofs;
}
# remember tsecs
$r->{tsecs}{TIME} = $tm;
$r->{tsecs}{VAL} = "$tsecs";
# remember rain_raw_adj
$r->{rain_raw_adj}{TIME} = $tm;
$r->{rain_raw_adj}{VAL} = $rain_raw_adj;
# KS300 has a sensor which detects any drop of rain and immediately
# sends out the israining message. The sensors consists of two parallel
# strips of metal separated by a small gap. The rain bridges the gap
# and closes the contact. If the KS300 pole is not perfectly vertical the
# drop runs along only one side and the contact is not closed. To get the
# israining information anyway, the respective flag is also set when the
# a positive amount of rain is detected.
$haverain = 1 if($rain_raw_adj != $rain_raw_adj_prev);
$v[1] = sprintf("%0.1f", $rain_raw_adj * $def->{RAINUNIT} / 1000);
$v[2] = sprintf("%0.1f", ("$a[25]$a[24].$a[23]"+0) * $def->{WINDUNIT});
$v[3] = "$a[22]$a[21]" + 0;
$v[4] = "$a[20]$a[19].$a[18]" + 0; $v[4] = "-$v[4]" if($a[17] eq "7");
$v[4] = sprintf("%0.1f", $v[4]);
$v[5] = ((hex($a[17]) & 0x2) || $haverain) ? "yes" : "no";
$v[6] = $a[29];
$v[7] = $a[16];
$v[8] = $a[17];
# Negative temp
$v[4] = -$v[4] if($v[8] & 8);
Log GetLogLevel($def->{NAME},4), "KS300 $dev: $msg";
my $max = int(@v);
# For logging/summary
my $val = "T: $v[4] H: $v[3] W: $v[2] R: $v[1] IR: $v[5]";
Log GetLogLevel($def->{NAME},4), "KS300 $dev: $val";
$def->{STATE} = $val;
$def->{CHANGED}[0] = $val;
for(my $i = 0; $i < $max; $i++) {
$r->{$txt[$i]}{TIME} = $tm;
$val = "$v[$i] $sfx[$i]";
$r->{$txt[$i]}{VAL} = $val;
$def->{CHANGED}[$n++] = "$txt[$i]: $val"
if(defined($repchanged{$txt[$i]}));
}
###################################
# AVG computing
if(!$r->{cum_day}) {
$r->{cum_day}{VAL} = "$tm T: 0 H: 0 W: 0 R: $v[1]";
$r->{avg_day}{VAL} = "T: $v[4] H: $v[3] W: $v[2] R: $v[1]";
} else {
my @cv = split(" ", $r->{cum_day}{VAL});
my @cd = split("[ :-]", $r->{cum_day}{TIME});
my $csec = 3600*$cd[3] + 60*$cd[4] + $cd[5]; # Sec of last reading
my @d = split("[ :-]", $tm);
my $sec = 3600*$d[3] + 60*$d[4] + $d[5]; # Sec now
my @sd = split("[ :-]", "$cv[0] $cv[1]");
my $ssec = 3600*$sd[3] + 60*$sd[4] + $sd[5]; # Sec at start of day
my $difft = $sec - $csec;
$difft += 86400 if($d[2] != $cd[2]); # Sec since last reading
my $t = $cv[3] + $difft * $v[4];
my $h = $cv[5] + $difft * $v[3];
my $w = $cv[7] + $difft * $v[2];
my $e = $cv[9];
$r->{cum_day}{VAL} = "$cv[0] $cv[1] T: $t H: $h W: $w R: $e";
$difft = $sec - $ssec;
$difft += 86400 if($d[2] != $sd[2]); # Sec since last reading
$difft = 1 if(!$difft); # Don't want illegal division.
$t /= $difft; $h /= $difft; $w /= $difft; $e = $v[1] - $cv[9];
$r->{avg_day}{VAL} =
sprintf("T: %.1f H: %d W: %.1f R: %.1f", $t, $h, $w, $e);
if($d[2] != $sd[2]) { # Day changed, report it
$def->{CHANGED}[$n++] = "avg_day $r->{avg_day}{VAL}";
$r->{cum_day}{VAL} = "$tm T: 0 H: 0 W: 0 R: $v[1]";
if(!$r->{cum_month}) { # Check the month
$r->{cum_month}{VAL} = "1 $r->{avg_day}{VAL}";
$r->{avg_month}{VAL} = $r->{avg_day}{VAL};
} else {
my @cmv = split(" ", $r->{cum_month}{VAL});
$t += $cmv[2]; $w += $cmv[4]; $h += $cmv[6];
$cmv[0]++;
$r->{cum_month}{VAL} =
sprintf("%d T: %.1f H: %d W: %.1f R: %.1f",
$cmv[0], $t, $h, $w, $cmv[8]+$e);
$r->{avg_month}{VAL} =
sprintf("T: %.1f H: %d W: %.1f R: %.1f",
$t/$cmv[0], $h/$cmv[0], $w/$cmv[0], $cmv[8]+$e);
if($d[1] != $sd[1]) { # Month changed, report it
$def->{CHANGED}[$n++] = "avg_month $r->{avg_month}{VAL}";
$r->{cum_month}{VAL} = "0 T: 0 H: 0 W: 0 R: 0";
}
}
$r->{cum_month}{TIME} = $r->{avg_month}{TIME} = $tm;
}
}
$r->{cum_day}{TIME} = $r->{avg_day}{TIME} = $tm;
# AVG computing
###################################
return $name;
} else {
Log 4, "KS300 detected: $msg";
return "UNDEFINED KS300 KS300 1234";
}
}
1;

361
fhem/FHEM/14_CUL_WS.pm
View File

@ -1,361 +0,0 @@
# $Id: 14_CUL_WS.pm,v 1.30 2010-10-25 15:17:29 rudolfkoenig Exp $
#
##############################################
package main;
use strict;
use warnings;
# Supports following devices:
# KS300TH (this is redirected to the more sophisticated 14_KS300 by 00_CUL)
# S300TH
# WS2000/WS7000
#
#####################################
sub
CUL_WS_Initialize($)
{
my ($hash) = @_;
# Message is like
# K41350270
$hash->{Match} = "^K.....";
$hash->{DefFn} = "CUL_WS_Define";
$hash->{UndefFn} = "CUL_WS_Undef";
$hash->{AttrFn} = "CUL_WS_Attr";
$hash->{ParseFn} = "CUL_WS_Parse";
$hash->{AttrList} = "IODev do_not_notify:0,1 showtime:0,1 model:S300TH,KS300 loglevel ignore:0,1";
}
#####################################
sub
CUL_WS_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "wrong syntax: define <name> CUL_WS <code> [corr1...corr4]"
if(int(@a) < 3 || int(@a) > 7);
return "Define $a[0]: wrong CODE format: valid is 1-8"
if($a[2] !~ m/^[1-8]$/);
$hash->{CODE} = $a[2];
$hash->{corr1} = ((int(@a) > 3) ? $a[3] : 0);
$hash->{corr2} = ((int(@a) > 4) ? $a[4] : 0);
$hash->{corr3} = ((int(@a) > 5) ? $a[5] : 0);
$hash->{corr4} = ((int(@a) > 6) ? $a[6] : 0);
$modules{CUL_WS}{defptr}{$a[2]} = $hash;
AssignIoPort($hash);
return undef;
}
#####################################
sub
CUL_WS_Undef($$)
{
my ($hash, $name) = @_;
delete($modules{CUL_WS}{defptr}{$hash->{CODE}}) if($hash && $hash->{CODE});
return undef;
}
#####################################
sub
CUL_WS_Parse($$)
{
my ($hash,$msg) = @_;
my %tlist = ("0"=>"temp",
"1"=>"temp/hum",
"2"=>"rain",
"3"=>"wind",
"4"=>"temp/hum/press",
"5"=>"brightness",
"6"=>"pyro",
"7"=>"temp/hum");
# -wusel, 2010-01-24: *sigh* No READINGS set, bad for other modules. Trying to add
# setting READINGS as well as STATE ...
my $NotifyType;
my $NotifyHumidity;
my $NotifyTemperature;
my $NotifyRain;
my $NotifyIsRaining;
my $NotifyWind;
my $NotifyWindDir;
my $NotifyWindSwing;
my $NotifyBrightness;
my $NotifyPressure;
my %NotifyMappings = (
"T" => "temperature",
"H" => "humidity",
"R" => "rain",
"IR" => "is_raining",
"W" => "wind",
"WD" => "wind_direction",
"WS" => "wind_swing",
"B" => "brightness",
"P" => "pressure",
);
my @a = split("", $msg);
my $firstbyte = hex($a[1]);
my $cde = ($firstbyte&7) + 1;
my $type = $tlist{$a[2]} ? $tlist{$a[2]} : "unknown";
# There are only 8 S300 devices. In order to enable more, we try to look up
# the name in connection with the receiver's name ("CUL868.1", "CUL433.1")
# See attr <name> IODev XX
my $def = $modules{CUL_WS}{defptr}{$hash->{NAME} . "." . $cde};
$def = $modules{CUL_WS}{defptr}{$cde} if(!$def);
if(!$def) {
Log 1, "CUL_WS UNDEFINED $type sensor detected, code $cde";
return "UNDEFINED CUL_WS_$cde CUL_WS $cde";
}
my $tm=TimeNow();
$hash = $def;
my $name = $hash->{NAME};
return "" if(IsIgnored($name));
my $typbyte = hex($a[2]) & 7;
my $sfirstbyte = $firstbyte & 7;
my $val = "";
my $devtype = "unknown";
my $family = "unknown";
my ($sgn, $tmp, $rain, $hum, $prs, $wnd);
if($sfirstbyte == 7) {
if($typbyte == 0 && int(@a) > 6) { # temp
$sgn = ($firstbyte&8) ? -1 : 1;
$tmp = $sgn * ($a[6].$a[3].".".$a[4]) + $hash->{corr1};
$val = "T: $tmp";
$devtype = "Temp";
$NotifyType="T";
$NotifyTemperature=$tmp;
}
if($typbyte == 1 && int(@a) > 8) { # temp/hum
$sgn = ($firstbyte&8) ? -1 : 1;
$tmp = $sgn * ($a[6].$a[3].".".$a[4]) + $hash->{corr1};
$hum = ($a[7].$a[8].".".$a[5]) + $hash->{corr2};
$val = "T: $tmp H: $hum";
$devtype = "PS50";
$family = "WS300";
$NotifyType="T H";
$NotifyTemperature=$tmp;
$NotifyHumidity=$hum;
}
if($typbyte == 2 && int(@a) > 5) { # rain
#my $more = ($firstbyte&8) ? 0 : 1000;
my $c = $hash->{corr1} ? $hash->{corr1} : 1;
$rain = hex($a[5].$a[3].$a[4]) + $c;
$val = "R: $rain";
$devtype = "Rain";
$family = "WS7000";
$NotifyType="R";
$NotifyRain=$rain;
}
if($typbyte == 3 && int(@a) > 8) { # wind
my $hun = ($firstbyte&8) ? 100 : 0;
$wnd = ($a[6].$a[3].".".$a[4])+$hun;
my $dir = ((hex($a[7])&3).$a[8].$a[5])+0;
my $swing = (hex($a[7])&6) >> 2;
$val = "W: $wnd D: $dir A: $swing";
$devtype = "Wind";
$family = "WS7000";
$NotifyType="W WD WS";
$NotifyWind=$wnd;
$NotifyWindDir=$dir;
$NotifyWindSwing=$swing;
}
if($typbyte == 4 && int(@a) > 10) { # temp/hum/press
$sgn = ($firstbyte&8) ? -1 : 1;
$tmp = $sgn * ($a[6].$a[3].".".$a[4]) + $hash->{corr1};
$hum = ($a[7].$a[8].".".$a[5]) + $hash->{corr2};
$prs = ($a[9].$a[10])+ 900 + $hash->{corr3};
if($prs < 930) {
$prs = $prs + 100;
}
$val = "T: $tmp H: $hum P: $prs";
$devtype = "Indoor";
$family = "WS7000";
$NotifyType="T H P";
$NotifyTemperature=$tmp;
$NotifyHumidity=$hum;
$NotifyPressure=$prs;
}
if($typbyte == 5 && int(@a) > 5) { # brightness
my $fakt = 1;
my $rawfakt = ($a[5])+0;
if($rawfakt == 1) { $fakt = 10; }
if($rawfakt == 2) { $fakt = 100; }
if($rawfakt == 3) { $fakt = 1000; }
my $br = (hex($a[5].$a[4].$a[3])*$fakt) + $hash->{corr1};
$val = "B: $br";
$devtype = "Brightness";
$family = "WS7000";
$NotifyType="B";
$NotifyBrightness=$br;
}
if($typbyte == 6 && int(@a) > 0) { # Pyro: wurde nie gebaut
$devtype = "Pyro";
$family = "WS7000";
}
if($typbyte == 7 && int(@a) > 8) { # Temp/hum
$sgn = ($firstbyte&8) ? -1 : 1;
$tmp = $sgn * ($a[6].$a[3].".".$a[4]) + $hash->{corr1};
$hum = ($a[7].$a[8].".".$a[5]) + $hash->{corr2};
$val = "T: $tmp H: $hum";
$devtype = "Temp/Hum";
$family = "WS7000";
$NotifyType="T H";
$NotifyTemperature=$tmp;
$NotifyHumidity=$hum;
}
} else { # $firstbyte not 7
if(@a == 9 && int(@a) > 8) { # S300TH
# Sanity check
if (!($msg =~ /^K[0-9A-F]\d\d\d\d\d\d\d$/ )) {
Log GetLogLevel($name,1), "Error: S300TH CUL_WS Cannot decode $msg (sanitycheck). Malformed";
return "";
}
$sgn = ($firstbyte&8) ? -1 : 1;
$tmp = $sgn * ($a[6].$a[3].".".$a[4]) + $hash->{corr1};
$hum = ($a[7].$a[8].".".$a[5]) + $hash->{corr2};
$val = "T: $tmp H: $hum";
$devtype = "S300TH";
$family = "WS300";
$NotifyType="T H";
$NotifyTemperature=$tmp;
$NotifyHumidity=$hum;
} elsif(@a == 15 && int(@a) > 14) { # KS300/2
my $c = $hash->{corr4} ? $hash->{corr4} : 255;
$rain = sprintf("%0.1f", hex("$a[14]$a[11]$a[12]") * $c / 1000);
$wnd = sprintf("%0.1f", "$a[9]$a[10].$a[7]" + $hash->{corr3});
$hum = sprintf( "%02d", "$a[8]$a[5]" + $hash->{corr2});
$tmp = sprintf("%0.1f", ("$a[6]$a[3].$a[4]"+ $hash->{corr1}),
(($a[1] & 0xC) ? -1 : 1));
my $ir = ((hex($a[1]) & 2)) ? "yes" : "no";
$val = "T: $tmp H: $hum W: $wnd R: $rain IR: $ir";
$devtype = "KS300/2";
$family = "WS300";
$NotifyType="T H W R IR";
$NotifyTemperature=$tmp;
$NotifyHumidity=$hum;
$NotifyWind=$wnd;
$NotifyRain=$rain;
$NotifyIsRaining=$ir;
} elsif(int(@a) > 8) { # WS7000 Temp/Hum sensors
$sgn = ($firstbyte&8) ? -1 : 1;
$tmp = $sgn * ($a[6].$a[3].".".$a[4]) + $hash->{corr1};
$hum = ($a[7].$a[8].".".$a[5]) + $hash->{corr2};
$val = "T: $tmp H: $hum";
$devtype = "TH".$sfirstbyte;
$family = "WS7000";
$NotifyType="T H";
$NotifyTemperature=$tmp;
$NotifyHumidity=$hum;
}
}
if(!$val) {
Log GetLogLevel($name,1), "CUL_WS Cannot decode $msg";
return "";
}
Log GetLogLevel($name,4), "CUL_WS $devtype $name: $val";
# Sanity checks
if($NotifyTemperature && $hash->{READINGS}{temperature}{VAL}) {
my $tval = $hash->{READINGS}{strangetemp} ?
$hash->{READINGS}{strangetemp}{VAL} :
$hash->{READINGS}{temperature}{VAL};
my $diff = ($NotifyTemperature - $tval)+0;
if($diff < -15.0 || $diff > 15.0) {
Log 2, "$name: Temp difference ($diff) too large: $val, skipping it";
$hash->{READINGS}{strangetemp}{VAL} = $NotifyTemperature;
$hash->{READINGS}{strangetemp}{TIME} = $tm;
return "";
}
}
delete $hash->{READINGS}{strangetemp} if($hash->{READINGS});
if(defined($hum) && ($hum < 0 || $hum > 100)) {
Log 1, "BOGUS: $name reading: $val, skipping it";
return "";
}
$hash->{STATE} = $val; # List overview
$hash->{READINGS}{state}{TIME} = $tm; # For list
$hash->{READINGS}{state}{VAL} = $val;
$hash->{CHANGED}[0] = $val; # For notify
my $i=1;
my $j;
my @Notifies=split(" ", $NotifyType);
for($j=0; $j<int(@Notifies); $j++) {
my $val = "";
if($Notifies[$j] eq "T") { $val = $NotifyTemperature;
} elsif($Notifies[$j] eq "H") { $val = $NotifyHumidity;
} elsif($Notifies[$j] eq "R") { $val = $NotifyRain;
} elsif($Notifies[$j] eq "W") { $val = $NotifyWind;
} elsif($Notifies[$j] eq "WD") { $val = $NotifyWindDir;
} elsif($Notifies[$j] eq "WS") { $val = $NotifyWindSwing;
} elsif($Notifies[$j] eq "IR") { $val = $NotifyIsRaining;
} elsif($Notifies[$j] eq "B") { $val = $NotifyBrightness;
} elsif($Notifies[$j] eq "P") { $val = $NotifyPressure;
}
my $nm = $NotifyMappings{$Notifies[$j]};
$hash->{READINGS}{$nm}{TIME} = $tm;
$hash->{READINGS}{$nm}{VAL} = $val;
$hash->{CHANGED}[$i++] = "$nm: $val";
}
$hash->{READINGS}{DEVTYPE}{VAL}=$devtype;
$hash->{READINGS}{DEVTYPE}{TIME}=$tm;
$hash->{READINGS}{DEVFAMILY}{VAL}=$family;
$hash->{READINGS}{DEVFAMILY}{TIME}=$tm;
return $name;
}
sub
CUL_WS_Attr(@)
{
my @a = @_;
# Make possible to use the same code for different logical devices when they
# are received through different physical devices.
return if($a[0] ne "set" || $a[2] ne "IODev");
my $hash = $defs{$a[1]};
my $iohash = $defs{$a[3]};
my $cde = $hash->{CODE};
delete($modules{CUL_WS}{defptr}{$cde});
$modules{CUL_WS}{defptr}{$iohash->{NAME} . "." . $cde} = $hash;
return undef;
}
1;

245
fhem/FHEM/15_CUL_EM.pm
View File

@ -1,245 +0,0 @@
##############################################
package main;
use strict;
use warnings;
# Adjust TOTAL to you meter:
# {$defs{emwz}{READINGS}{basis}{VAL}=<meter>/<corr2>-<total_cnt> }
#####################################
sub
CUL_EM_Initialize($)
{
my ($hash) = @_;
# Message is like
# K41350270
$hash->{Match} = "^E0.................\$";
$hash->{DefFn} = "CUL_EM_Define";
$hash->{UndefFn} = "CUL_EM_Undef";
$hash->{ParseFn} = "CUL_EM_Parse";
$hash->{AttrList} = "IODev do_not_notify:0,1 showtime:0,1 " .
"model:EMEM,EMWZ,EMGZ loglevel ignore:0,1";
}
#####################################
sub
CUL_EM_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "wrong syntax: define <name> CUL_EM <code> ".
"[corr1 corr2 CostPerUnit BasicFeePerMonth]"
if(int(@a) < 3 || int(@a) > 7);
return "Define $a[0]: wrong CODE format: valid is 1-12"
if($a[2] !~ m/^\d+$/ || $a[2] < 1 || $a[2] > 12);
$hash->{CODE} = $a[2];
if($a[2] >= 1 && $a[2] <= 4) { # EMWZ: nRotation in 5 minutes
my $c = (int(@a) > 3 ? $a[3] : 150);
$hash->{corr1} = (12/$c); # peak/current
$c = (int(@a) > 4 ? $a[4] : 1800);
$hash->{corr2} = (12/$c); # total
} elsif($a[2] >= 5 && $a[2] <= 8) { # EMEM
# corr1 is the correction factor for power
$hash->{corr1} = (int(@a) > 3 ? $a[3] : 0.01);
# corr2 is the correction factor for energy
$hash->{corr2} = (int(@a) > 4 ? $a[4] : 0.001);
} elsif($a[2] >= 9 && $a[2] <= 12) { # EMGZ: 0.01
$hash->{corr1} = (int(@a) > 3 ? $a[3] : 0.01);
$hash->{corr2} = (int(@a) > 4 ? $a[4] : 0.01);
} else {
$hash->{corr1} = 1;
$hash->{corr2} = 1;
}
$hash->{CostPerUnit} = (int(@a) > 5 ? $a[5] : 0);
$hash->{BasicFeePerMonth} = (int(@a) > 6 ? $a[6] : 0);
$modules{CUL_EM}{defptr}{$a[2]} = $hash;
AssignIoPort($hash);
return undef;
}
#####################################
sub
CUL_EM_Undef($$)
{
my ($hash, $name) = @_;
delete($modules{CUL_EM}{defptr}{$hash->{CODE}});
return undef;
}
#####################################
sub
CUL_EM_Parse($$)
{
my ($hash,$msg) = @_;
# 0123456789012345678
# E01012471B80100B80B -> Type 01, Code 01, Cnt 10
my @a = split("", $msg);
my $tpe = ($a[1].$a[2])+0;
my $cde = hex($a[3].$a[4]);
# seqno = number of received datagram in sequence, runs from 2 to 255
# total_cnt= total (cumulated) value in ticks as read from the device
# basis_cnt= correction to total (cumulated) value in ticks to account for
# counter wraparounds
# total = total (cumulated) value in device units
# current = current value (average over latest 5 minutes) in device units
# peak = maximum value in device units
my $seqno = hex($a[5].$a[6]);
my $total_cnt = hex($a[ 9].$a[10].$a[ 7].$a[ 8]);
my $current_cnt = hex($a[13].$a[14].$a[11].$a[12]);
my $peak_cnt = hex($a[17].$a[18].$a[15].$a[16]);
# these are the raw readings from the device
my $val = sprintf("CNT: %d CUM: %d 5MIN: %d TOP: %d",
$seqno, $total_cnt, $current_cnt, $peak_cnt);
if($modules{CUL_EM}{defptr}{$cde}) {
my $def = $modules{CUL_EM}{defptr}{$cde};
$hash = $def;
my $n = $hash->{NAME};
return "" if(IsIgnored($n));
my $tn = TimeNow(); # current time
my $c= 0; # count changes
my %readings;
Log GetLogLevel($n,5), "CUL_EM $n: $val";
$readings{RAW} = $val;
#
# calculate readings
#
# initialize total_cnt_last
my $total_cnt_last = 0;
if(defined($hash->{READINGS}{total_cnt})) {
$total_cnt_last= $hash->{READINGS}{total_cnt}{VAL};
}
# initialize basis_cnt_last
my $basis_cnt = 0;
if(defined($hash->{READINGS}{basis})) {
$basis_cnt = $hash->{READINGS}{basis}{VAL};
}
# correct counter wraparound
if($total_cnt< $total_cnt_last) {
$basis_cnt += 65536;
$readings{basis} = $basis_cnt;
}
#
# translate into device units
#
my $corr1 = $hash->{corr1}; # EMEM power correction factor
my $corr2 = $hash->{corr2}; # EMEM energy correction factor
my $total = ($basis_cnt+$total_cnt)*$corr2;
my $current = $current_cnt*$corr1;
my $peak = $peak_cnt*$corr1;
$val = sprintf("CNT: %d CUM: %0.3f 5MIN: %0.3f TOP: %0.3f",
$seqno, $total, $current, $peak);
$hash->{STATE} = $val;
$hash->{CHANGED}[$c++] = "$val";
$readings{total_cnt} = $total_cnt;
$readings{current_cnt} = $current_cnt;
$readings{peak_cnt} = $peak_cnt;
$readings{seqno} = $seqno;
$readings{total} = $total;
$readings{current} = $current;
$readings{peak} = $peak;
###################################
# Start CUMULATE day and month
Log GetLogLevel($n,4), "CUL_EM $n: $val";
my $tsecs_prev;
#----- get previous tsecs
if(defined($hash->{READINGS}{tsecs})) {
$tsecs_prev= $hash->{READINGS}{tsecs}{VAL};
} else {
$tsecs_prev= 0; # 1970-01-01
}
#----- save actual tsecs
my $tsecs= time(); # number of non-leap seconds since January 1, 1970, UTC
$readings{tsecs} = $tsecs;
#----- get cost parameter
my $cost = $hash->{CostPerUnit};
my $basicfee = $hash->{BasicFeePerMonth};
#----- check whether day or month was changed
if(!defined($hash->{READINGS}{cum_day})) {
#----- init cum_day if it is not set
$val = sprintf("CUM_DAY: %0.3f CUM: %0.3f COST: %0.2f", 0,$total,0);
$readings{cum_day} = $val;
} else {
if( (localtime($tsecs_prev))[3] != (localtime($tsecs))[3] ) {
#----- day has changed (#3)
my @cmv = split(" ", $hash->{READINGS}{cum_day}{VAL});
$val = sprintf("CUM_DAY: %0.3f CUM: %0.3f COST: %0.2f",
$total-$cmv[3], $total, ($total-$cmv[3])*$cost);
$readings{cum_day} = $val;
Log GetLogLevel($n,3), "CUL_EM $n: $val";
if( (localtime($tsecs_prev))[4] != (localtime($tsecs))[4] ) {
#----- month has changed (#4)
if(!defined($hash->{READINGS}{cum_month})) {
# init cum_month if not set
$val = sprintf("CUM_MONTH: %0.3f CUM: %0.3f COST: %0.2f",
0, $total, 0);
$readings{cum_month} = $val;
} else {
@cmv = split(" ", $hash->{READINGS}{cum_month}{VAL});
$val = sprintf("CUM_MONTH: %0.3f CUM: %0.3f COST: %0.2f",
$total-$cmv[3], $total,($total-$cmv[3])*$cost+$basicfee);
$readings{cum_month} = $val;
Log GetLogLevel($n,3), "CUL_EM $n: $val";
}
}
}
}
# End CUMULATE day and month
###################################
foreach my $k (keys %readings) {
$hash->{READINGS}{$k}{TIME}= $tn;
$hash->{READINGS}{$k}{VAL} = $readings{$k};
$hash->{CHANGED}[$c++] = "$k: $readings{$k}";
}
return $hash->{NAME};
} else {
Log 1, "CUL_EM detected, Code $cde $val";
return "UNDEFINED CUL_EM_$cde CUL_EM $cde";
}
}
1;

127
fhem/FHEM/16_CUL_RFR.pm
View File

@ -1,127 +0,0 @@
##############################################
package main;
use strict;
use warnings;
#####################################
sub
CUL_RFR_Initialize($)
{
my ($hash) = @_;
# Message is like
# K41350270
$hash->{Match} = "^[0-9A-F]{4}U.";
$hash->{DefFn} = "CUL_RFR_Define";
$hash->{UndefFn} = "CUL_RFR_Undef";
$hash->{ParseFn} = "CUL_RFR_Parse";
$hash->{AttrList} = "IODev do_not_notify:0,1 model:CUL,CUN,CUR " .
"loglevel:0,1,2,3,4,5,6 ignore:0,1 addvaltrigger";
$hash->{WriteFn} = "CUL_RFR_Write";
$hash->{GetFn} = "CUL_Get";
$hash->{SetFn} = "CUL_Set";
$hash->{noRawInform} = 1; # Our message was already sent as raw.
}
#####################################
sub
CUL_RFR_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "wrong syntax: define <name> CUL_RFR <id> <routerid>"
if(int(@a) != 4 ||
$a[2] !~ m/[0-9A-F]{2}/i ||
$a[3] !~ m/[0-9A-F]{2}/i);
$hash->{ID} = $a[2];
$hash->{ROUTERID} = $a[3];
$modules{CUL_RFR}{defptr}{"$a[2]$a[3]"} = $hash;
AssignIoPort($hash);
return undef;
}
#####################################
sub
CUL_RFR_Write($$)
{
my ($hash,$fn,$msg) = @_;
($fn, $msg) = CUL_WriteTranslate($hash, $fn, $msg);
return if(!defined($fn));
$msg = $hash->{ID} . $hash->{ROUTERID} . $fn . $msg;
IOWrite($hash, "u", $msg);
}
#####################################
sub
CUL_RFR_Undef($$)
{
my ($hash, $name) = @_;
delete($modules{CUL_RFR}{defptr}{$hash->{ID} . $hash->{ROUTERID}});
return undef;
}
#####################################
sub
CUL_RFR_Parse($$)
{
my ($iohash,$msg) = @_;
# 0123456789012345678
# E01012471B80100B80B -> Type 01, Code 01, Cnt 10
$msg =~ m/^([0-9AF]{2})([0-9AF]{2})U(.*)/;
my ($rid, $id, $smsg) = ($1,$2,$3);
my $cde = "${id}${rid}";
if(!$modules{CUL_RFR}{defptr}{$cde}) {
Log 1, "CUL_RFR detected, Id $id, Router $rid, MSG $smsg";
return "UNDEFINED CUL_RFR_$id CUL_RFR $id $rid";
}
my $hash = $modules{CUL_RFR}{defptr}{$cde};
my $name = $hash->{NAME};
return "" if(IsIgnored($name));
if($smsg =~ m/^T/) { $hash->{NR_TMSG}++ }
elsif($smsg =~ m/^F/) { $hash->{NR_FMSG}++ }
elsif($smsg =~ m/^E/) { $hash->{NR_EMSG}++ }
elsif($smsg =~ m/^K/) { $hash->{NR_KMSG}++ }
else { $hash->{NR_RMSG}++ }
$hash->{Clients} = $iohash->{Clients};
$hash->{MatchList} = $iohash->{MatchList};
foreach my $m (split(";", $smsg)) {
CUL_Parse($hash, $iohash, $hash->{NAME}, $m, "X21");
}
return "";
}
sub
CUL_RFR_DelPrefix($)
{
my ($msg) = @_;
while($msg =~ m/^\d{4}U/) {
(undef, $msg) = split("U", $msg, 2);
}
$msg =~ s/;([\r\n]*)$/$1/;
return $msg;
}
sub
CUL_RFR_AddPrefix($$)
{
my ($hash, $msg) = @_;
while($hash->{TYPE} eq "CUL_RFR") {
# Prefix $msg with RRBBU and return the corresponding CUL hash
$msg = "u" . $hash->{ID} . $hash->{ROUTERID} . $msg;
$hash = $hash->{IODev};
}
return ($hash, $msg);
}
1;

263
fhem/FHEM/17_SIS_PMS.pm
View File

@ -1,263 +0,0 @@
################################################################
#
# Copyright notice
#
# (c) 2009 Copyright: Kai 'wusel' Siering (wusel+fhem at uu dot org)
# All rights reserved
#
# This code 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.
#
# This copyright notice MUST APPEAR in all copies of the script!
###############################################
###########################
# 17_SIS_PMS.pm
# Module for FHEM
#
# Contributed by Kai 'wusel' Siering <wusel+fhem@uu.org> in 2010
# Based in part on work for FHEM by other authors ...
# $Id: 17_SIS_PMS.pm,v 1.3 2010-01-22 09:59:14 painseeker Exp $
###########################
package main;
use strict;
use warnings;
my $SIS_PMS_cmds ="off on on-till off-till toggle";
sub
SIS_PMS_Initialize($)
{
my ($hash) = @_;
$hash->{Match} = "^socket ..:..:..:..:.. . state o.*";
$hash->{SetFn} = "SIS_PMS_Set";
# $hash->{StateFn} = "SIS_PMS_SetState";
$hash->{DefFn} = "SIS_PMS_Define";
$hash->{UndefFn} = "SIS_PMS_Undef";
$hash->{ParseFn} = "SIS_PMS_Parse";
}
#############################
sub
SIS_PMS_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $u = "wrong syntax: define <name> SIS_PMS <serial> <socket>";
return $u if(int(@a) < 4);
my $serial = $a[2];
my $socketnr = $a[3];
my $name = $a[0];
my $serialnocolon=$serial;
$serialnocolon =~ s/:/_/g;
$modules{SIS_PMS}{defptr}{$name} = $hash;
$hash->{SERIAL} = $serial;
$hash->{SOCKET} = $socketnr;
$hash->{NAME} = $name;
$modules{SIS_PMS}{defptr}{$serialnocolon . $socketnr} = $hash;
$hash->{PREV}{STATE} = "undefined";
AssignIoPort($hash);
}
#############################
sub
SIS_PMS_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 %{ $modules{SIS_PMS}{defptr}{$c} }) {
# delete($modules{SIS_PMS}{defptr}{$c}{$dname})
# if($modules{SIS_PMS}{defptr}{$c}{$dname} == $hash);
# }
# }
return undef;
}
#############################
sub
SIS_PMS_Parse($$)
{
my ($hash, $msg) = @_;
my $serial;
my $socknr;
my $sockst;
my $dummy;
my $serialnocolon;
# Msg format:
# ^socket ..:..:..:..:.. . state o.*";
($dummy, $serial, $socknr, $dummy, $sockst) = split(' ', $msg);
$serialnocolon=$serial;
$serialnocolon =~ s/:/_/g;
my $def = $modules{SIS_PMS}{defptr}{$serialnocolon . $socknr};
if($def) {
Log 5, "SIS_PMS: Found device as " . $def->{NAME};
if($def->{STATE} ne $sockst) {
$def->{READINGS}{PREVSTATE}{TIME} = TimeNow();
$def->{READINGS}{PREVSTATE}{VAL} = $def->{STATE};
Log 3, "SIS_PMS " . $def->{NAME} ." state changed from " . $def->{STATE} . " to $sockst";
$def->{PREV}{STATE} = $def->{STATE};
$def->{CHANGED}[0] = $sockst;
DoTrigger($def->{NAME}, undef);
}
$def->{STATE} = $sockst;
$def->{READINGS}{STATE}{TIME} = TimeNow();
$def->{READINGS}{STATE}{VAL} = $sockst;
Log 5, "SIS_PMS " . $def->{NAME} ." state $sockst";
return $def->{NAME};
} else {
my $devname=$serial;
$devname =~ s/:/_/g;
Log 3, "SIS_PMS Unknown device $serial $socknr, please define it";
return "UNDEFINED SIS_PMS_$devname.$socknr SIS_PMS $serial $socknr";
}
}
#############################
sub
SIS_PMS_Do_On_Till($@)
{
my ($hash, @a) = @_;
return "Timespec (HH:MM[:SS]) needed for the on-till command" if(@a != 3);
my ($err, $hr, $min, $sec, $fn) = GetTimeSpec($a[2]);
return $err if($err);
my @lt = localtime;
my $hms_till = sprintf("%02d:%02d:%02d", $hr, $min, $sec);
my $hms_now = sprintf("%02d:%02d:%02d", $lt[2], $lt[1], $lt[0]);
if($hms_now ge $hms_till) {
Log 4, "on-till: won't switch as now ($hms_now) is later than $hms_till";
return "";
}
my @b = ($a[0], "on");
SIS_PMS_Set($hash, @b);
my $tname = $hash->{NAME} . "_till";
CommandDelete(undef, $tname) if($defs{$tname});
CommandDefine(undef, "$tname at $hms_till set $a[0] off");
}
#############################
sub
SIS_PMS_Do_Off_Till($@)
{
my ($hash, @a) = @_;
return "Timespec (HH:MM[:SS]) needed for the off-till command" if(@a != 3);
my ($err, $hr, $min, $sec, $fn) = GetTimeSpec($a[2]);
return $err if($err);
my @lt = localtime;
my $hms_till = sprintf("%02d:%02d:%02d", $hr, $min, $sec);
my $hms_now = sprintf("%02d:%02d:%02d", $lt[2], $lt[1], $lt[0]);
if($hms_now ge $hms_till) {
Log 4, "off-till: won't switch as now ($hms_now) is later than $hms_till";
return "";
}
my @b = ($a[0], "off");
SIS_PMS_Set($hash, @b);
my $tname = $hash->{NAME} . "_till";
CommandDelete(undef, $tname) if($defs{$tname});
CommandDefine(undef, "$tname at $hms_till set $a[0] on");
}
###################################
sub
SIS_PMS_Set($@)
{
my ($hash, @a) = @_;
my $ret = undef;
my $na = int(@a);
my $what = lc($a[1]);
return "no set value specified" if($na < 2 || $na > 3);
my @cmds=split(" ", $SIS_PMS_cmds);
my $ncmds=int(@cmds);
my $i;
my $known_cmd=0;
for($i=0; $i<$ncmds; $i++) {
if($cmds[$i] eq $what) {
$known_cmd++;
}
}
if($known_cmd==0) {
return "Unknown argument $what, choose one of $SIS_PMS_cmds";
}
return SIS_PMS_Do_On_Till($hash, @a) if($a[1] eq "on-till");
return SIS_PMS_Do_Off_Till($hash, @a) if($a[1] eq "off-till");
my $prevstate=$hash->{STATE};
my $currstate=$what;
if($what eq "toggle") {
if($prevstate eq "on") {
$currstate="off";
} elsif($prevstate eq "off") {
$currstate="on";
}
}
if($prevstate ne $currstate) {
$hash->{READINGS}{PREVSTATE}{TIME} = TimeNow();
$hash->{READINGS}{PREVSTATE}{VAL} = $prevstate;
Log 3, "SIS_PMS " . $hash->{NAME} ." state changed from $prevstate to $currstate";
$hash->{PREV}{STATE} = $prevstate;
$hash->{CHANGED}[0] = $currstate;
$hash->{STATE} = $currstate;
$hash->{READINGS}{STATE}{TIME} = TimeNow();
$hash->{READINGS}{STATE}{VAL} = $currstate;
# DoTrigger($hash->{NAME}, undef);
}
my $msg;
$msg=sprintf("%s %s %s", $hash->{SERIAL}, $hash->{SOCKET}, $what);
IOWrite($hash, $what, $msg);
return $ret;
}
1;

61
fhem/FHEM/18_CUL_HOERMANN.pm
View File

@ -1,61 +0,0 @@
##############################################
package main;
use strict;
use warnings;
sub
CUL_HOERMANN_Initialize($)
{
my ($hash) = @_;
$hash->{Match} = "^R..........";
$hash->{DefFn} = "CUL_HOERMANN_Define";
$hash->{ParseFn} = "CUL_HOERMANN_Parse";
$hash->{AttrList} = "IODev do_not_notify:1,0 ignore:0,1 " .
"showtime:1,0 loglevel:0,1,2,3,4,5,6";
}
#############################
sub
CUL_HOERMANN_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $u = "wrong syntax: define <name> CUL_HOERMANN housecode " .
"addr [fg addr] [lm addr] [gm FF]";
return "wrong syntax: define <name> CUL_HOERMANN 10-digit-hex-code"
if(int(@a) != 3 || $a[2] !~ m/^[a-f0-9]{10}$/i);
$modules{CUL_HOERMANN}{defptr}{$a[2]} = $hash;
$hash->{STATE} = "Defined";
return undef;
}
sub
CUL_HOERMANN_Parse($$)
{
my ($hash, $msg) = @_;
# Msg format: R0123456789
my $cde = substr($msg, 1, 10);
my $def = $modules{CUL_HOERMANN}{defptr}{$cde};
if($def) {
my $name = $def->{NAME};
$def->{CHANGED}[0] = "toggle";
$def->{READINGS}{state}{TIME} = TimeNow();
$def->{READINGS}{state}{VAL} = "toggle";
Log GetLogLevel($name,4), "CUL_HOERMANN $name toggle";
return $name;
} else {
Log 3, "CUL_HOERMANN Unknown device $cde, please define it";
return "UNDEFINED CUL_HOERMANN_$cde CUL_HOERMANN $cde";
}
}
1;

219
fhem/FHEM/20_OWFS.pm
View File

@ -1,219 +0,0 @@
################################################################
#
# 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 Time::HiRes qw(gettimeofday);
use OW;
my %models = (
"DS1420" => "",
"DS9097" => "",
);
my %fc = (
"1:DS9420" => "01",
"2:DS1420" => "81",
"3:DS1820" => "10",
);
my %gets = (
"address" => "",
"alias" => "",
"crc8" => "",
"family" => "",
"id" => "",
"locator" => "",
"present" => "",
# "r_address" => "",
# "r_id" => "",
# "r_locator" => "",
"type" => "",
);
##############################################
sub
OWFS_Initialize($)
{
my ($hash) = @_;
# Provider
$hash->{WriteFn} = "OWFS_Write";
$hash->{Clients} = ":OWTEMP:";
# Normal devices
$hash->{DefFn} = "OWFS_Define";
$hash->{UndefFn} = "OWFS_Undef";
$hash->{GetFn} = "OWFS_Get";
#$hash->{SetFn} = "OWFS_Set";
$hash->{AttrList} = "IODev do_not_notify:1,0 dummy:1,0 temp-scale:C,F,K,R ".
"showtime:1,0 loglevel:0,1,2,3,4,5,6"; }
#####################################
sub
OWFS_Get($$)
{
my ($hash,@a) = @_;
return "argument is missing @a" if (@a != 2);
return "Passive Adapter defined. No Get function implemented."
if(!defined($hash->{OW_ID}));
return "Unknown argument $a[1], choose one of " . join(",", sort keys %gets)
if(!defined($gets{$a[1]}));
my $ret = OWFS_GetData($hash,$a[1]);
return "$a[0] $a[1] => $ret";
}
#####################################
sub
OWFS_GetData($$)
{
my ($hash,$query) = @_;
my $name = $hash->{NAME};
my $path = $hash->{OW_PATH};
my $ret = undef;
$ret = OW::get("/uncached/$path/$query");
if ($ret) {
# strip spaces
$ret =~ s/^\s+//g;
Log 4, "OWFS $name $query $ret";
$hash->{READINGS}{$query}{VAL} = $ret;
$hash->{READINGS}{$query}{TIME} = TimeNow();
return $ret;
} else {
return undef;
}
}
#####################################
sub
OWFS_DoInit($)
{
my ($hash) = @_;
my $name = $hash->{NAME};
my $path;
my $ret;
if (defined($hash->{OWFS_ID})) {
$path = $hash->{OW_FAMILY}.".".$hash->{OWFS_ID};
foreach my $q (sort keys %gets) {
$ret = OWFS_GetData($hash,$q);
}
}
$hash->{STATE} = "Initialized" if (!$hash->{STATE});
return undef;
}
#####################################
sub
OWFS_Define($$)
{
my ($hash, $def) = @_;
# define <name> OWFS <owserver:port> <model> <id>
# define foo OWFS 127.0.0.1:4304 DS1420 93302D000000
my @a = split("[ \t][ \t]*", $def);
return "wrong syntax: define <name> OWFS <owserver:port> <model> [<id>]"
if (@a < 2 && int(@a) > 5);
my $name = $a[0];
my $dev = $a[2];
# return "wrong device format: use ip:port"
# if ($device !~ m/^(.+):(0-9)+$/);
my $model = $a[3];
return "Define $name: wrong model: specify one of " . join ",", sort keys %models
if (!grep { $_ eq $model } keys %models);
if (@a > 4) {
my $id = $a[4];
return "Define $name: wrong ID format: specify a 12 digit value"
if (uc($id) !~ m/^[0-9|A-F]{12}$/);
$hash->{FamilyCode} = \%fc;
my $fc = $hash->{FamilyCode};
if (defined ($fc)) {
foreach my $c (sort keys %{$fc}) {
if ($c =~ m/$model/) {
$hash->{OW_FAMILY} = $fc->{$c};
}
}
}
delete ($hash->{FamilyCode});
$hash->{OW_ID} = $id;
$hash->{OW_PATH} = $hash->{OW_FAMILY}.".".$hash->{OW_ID};
}
$hash->{STATE} = "Defined";
# default temperature-scale: C
# C: Celsius, F: Fahrenheit, K: Kelvin, R: Rankine
$attr{$name}{"temp-scale"} = "C";
if ($dev eq "none") {
$attr{$name}{dummy} = 1;
Log 1, "OWFS device is none, commands will be echoed only";
return undef;
}
Log 3, "OWFS opening OWFS device $dev";
my $po;
$po = OW::init($dev);
return "Can't connect to $dev: $!" if(!$po);
Log 3, "OWFS opened $dev for $name";
$hash->{DeviceName} = $dev;
$hash->{STATE}="";
my $ret = OWFS_DoInit($hash);
return undef;
}
#####################################
sub
OWFS_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};
}
}
return undef;
}
1;

531
fhem/FHEM/20_X10.pm
View File

@ -1,531 +0,0 @@
################################################################
#
# Copyright notice
#
# (c) 2008 Dr. Boris Neubert (omega@online.de)
#
# 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.
# 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!
#
################################################################
#
# Internals introduced in this module:
# MODEL distinguish between different X10 device types
# BRIGHT brightness level of dimmer devices in units of microdims (0..210)
#
# Readings introduced in this module:
# state function and argument of last command
# onoff inherited from switch interface (0= on, 1= off)
# dimmer inherited from dimmer interface (0= dark, 100= bright)
#
# Setters introduced in this module:
# on inherited from switch interface
# off inherited from switch interface
# dimmer inherited from dimmer interface (0= dark, 100= bright)
# dimdown inherited from dimmer interface
# dimup inherited from dimmer interface
#
package main;
use strict;
use warnings;
my %functions = ( ALL_UNITS_OFF => "all_units_off",
ALL_LIGHTS_ON => "all_lights_on",
ON => "on",
OFF => "off",
DIM => "dimdown",
BRIGHT => "dimup",
ALL_LIGHTS_OFF => "all_lights_off",
EXTENDED_CODE => "",
HAIL_REQUEST => "",
HAIL_ACK => "",
PRESET_DIM1 => "",
PRESET_DIM2 => "",
EXTENDED_DATA_TRANSFER => "",
STATUS_ON => "",
STATUS_OFF => "",
STATUS_REQUEST => "",
);
my %snoitcnuf; # the reverse of the above
my %functions_rewrite = ( "all_units_off" => "off",
"all_lights_on" => "on",
"all_lights_off" => "off",
);
my %functions_snd = qw( ON 0010
OFF 0011
DIM 0100
BRIGHT 0101 );
my %housecodes_snd = qw(A 0110 B 1110 C 0010 D 1010
E 0001 F 1001 G 0101 H 1101
I 0111 J 1111 K 0011 K 1011
M 0000 N 1000 O 0100 P 1100);
my %unitcodes_snd = qw( 1 0110 2 1110 3 0010 4 1010
5 0001 6 1001 7 0101 8 1101
9 0111 10 1111 11 0011 12 1011
13 0000 14 1000 15 0100 16 1100);
my %functions_set = ( "on" => 0,
"off" => 0,
"dimup" => 1,
"dimdown" => 1,
"dimto" => 1,
"on-till" => 1,
"on-for-timer" => 1,
);
my %models = (
lm12 => 'dimmer',
lm15 => 'switch',
am12 => 'switch',
tm13 => 'switch',
);
my @lampmodules = ('lm12','lm15'); # lamp modules
sub
X10_Initialize($)
{
my ($hash) = @_;
foreach my $k (keys %functions) {
$snoitcnuf{$functions{$k}}= $k;
}
$hash->{Match} = "^X10:[A-P];";
$hash->{SetFn} = "X10_Set";
$hash->{StateFn} = "X10_SetState";
$hash->{DefFn} = "X10_Define";
$hash->{UndefFn} = "X10_Undef";
$hash->{ParseFn} = "X10_Parse";
$hash->{AttrList} = "IODev do_not_notify:1,0 " .
"dummy:1,0 showtime:1,0 model:lm12,lm15,am12,tm13 " .
"loglevel:0,1,2,3,4,5,6";
}
#####################################
sub
X10_SetState($$$$)
{
my ($hash, $tim, $vt, $val) = @_;
return undef;
}
#############################
sub
X10_StateMachine($$$$)
{
my($hash, $time, $function, $argument)= @_;
# the following changes between (onoff,bright) states were
# experimentally observed for a Busch Timac Ferndimmer 2265
# bright and argument are measured in brightness steps
# from 0 (0%) to 210 (100%).
# for convenience, we connect the off state with a 210 bright state
#
# initial on off dimup d dimdown d
# -------------------------------------------------------------------------
# (on,x) -> (on,x) (off,210) (on,x+d) (on,x-d)
# (off,210) -> (on,210) (off,210) (on,210) (on,210-d)
my $onoff;
my $bright;
if(defined($hash->{ONOFF})) {
$onoff= $hash->{ONOFF};
} else {
$onoff= 0; }
if(defined($hash->{BRIGHT})) {
$bright= $hash->{BRIGHT};
} else {
$bright= 0; }
#Log 1, $hash->{NAME} . " initial state ($onoff,$bright)";
if($onoff) {
# initial state (on,bright)
if($function eq "on") {
} elsif($function eq "off") {
$onoff= 0; $bright= 210;
} elsif($function eq "dimup") {
$bright+= $argument;
if($bright> 210) { $bright= 210 };
} elsif($function eq "dimdown") {
$bright-= $argument;
if($bright< 0) { $bright= 0 };
}
} else {
# initial state (off,bright)
if($function eq "on") {
$onoff= 1; $bright= 210;
} elsif($function eq "off") {
$onoff= 0; $bright= 210;
} elsif($function eq "dimup") {
$onoff= 1; $bright= 210;
} elsif($function eq "dimdown") {
$onoff= 1;
$bright= 210-$argument;
if($bright< 0) { $bright= 0 };
}
}
#Log 1, $hash->{NAME} . " final state ($onoff,$bright)";
$hash->{ONOFF}= $onoff;
$hash->{BRIGHT}= $bright;
$hash->{READINGS}{onoff}{TIME}= $time;
$hash->{READINGS}{onoff}{VAL}= $onoff;
$hash->{READINGS}{dimmer}{TIME}= $time;
$hash->{READINGS}{dimmer}{VAL}= int(1000.0*$bright/210.0+0.5)/10.0;
}
#############################
sub
X10_LevelToDims($)
{
# 22= 100%
my ($level)= @_;
my $dim= int(22*$level/100.0+0.5);
return $dim;
}
#############################
sub
X10_Do_On_Till($@)
{
my ($hash, @a) = @_;
return "Timespec (HH:MM[:SS]) needed for the on-till command" if(@a != 3);
my ($err, $hr, $min, $sec, $fn) = GetTimeSpec($a[2]);
return $err if($err);
my @lt = localtime;
my $hms_till = sprintf("%02d:%02d:%02d", $hr, $min, $sec);
my $hms_now = sprintf("%02d:%02d:%02d", $lt[2], $lt[1], $lt[0]);
if($hms_now ge $hms_till) {
Log 4, "on-till: won't switch as now ($hms_now) is later than $hms_till";
return "";
}
if($modules{X10}{ldata}{$a[0]}) {
CommandDelete(undef, $a[0] . "_timer");
delete $modules{FS20}{ldata}{$a[0]};
}
$modules{X10}{ldata}{$a[0]} = "$hms_till";
my @b = ($a[0], "on");
X10_Set($hash, @b);
CommandDefine(undef, $hash->{NAME} . "_timer at $hms_till set $a[0] off");
}
#############################
sub
X10_Do_On_For_Timer($@)
{
my ($hash, @a) = @_;
return "Timespec (HH:MM[:SS]) needed for the on-for-timer command" if(@a != 3);
my ($err, $hr, $min, $sec, $fn) = GetTimeSpec($a[2]);
return $err if($err);
my $hms_for_timer = sprintf("+%02d:%02d:%02d", $hr, $min, $sec);
if($modules{X10}{ldata}{$a[0]}) {
CommandDelete(undef, $a[0] . "_timer");
delete $modules{FS20}{ldata}{$a[0]};
}
$modules{X10}{ldata}{$a[0]} = "$hms_for_timer";
my @b = ($a[0], "on");
X10_Set($hash, @b);
CommandDefine(undef, $hash->{NAME} . "_timer at $hms_for_timer set $a[0] off");
}
###################################
sub
X11_Write($$$)
{
my ($hash, $function, $dim)= @_;
my $name = $hash->{NAME};
my $housecode= $hash->{HOUSE};
my $unitcode = $hash->{UNIT};
my $x10func = $snoitcnuf{$function};
undef $function; # do not use after this point
my $prefix= "X10 device $name:";
Log 5, "$prefix sending X10:$housecode;$unitcode;$x10func $dim";
my ($hc_b, $hu_b, $hf_b);
my ($hc, $hu, $hf);
# Header:Code, Address
$hc_b = "00000100"; # 0x04
$hc = pack("B8", $hc_b);
$hu_b = $housecodes_snd{$housecode} . $unitcodes_snd{$unitcode};
$hu = pack("B8", $hu_b);
IOWrite($hash, $hc, $hu);
# Header:Code, Function
$hc_b = substr(unpack('B8', pack('C', $dim)), 3) . # dim, 0..22
"110"; # always 110
$hc = pack("B8", $hc_b);
$hf_b = $housecodes_snd{$housecode} . $functions_snd{$x10func};
$hf = pack("B8", $hf_b);
IOWrite($hash, $hc, $hf);
}
###################################
sub
X10_Set($@)
{
my ($hash, @a) = @_;
my $ret = undef;
my $na = int(@a);
# initialization and sanity checks
return "no set value specified" if($na < 2);
my $name= $hash->{NAME};
my $function= $a[1];
my $nrparams= $functions_set{$function};
return "Unknown argument $function, choose one of " .
join(",", sort keys %functions_set) if(!defined($nrparams));
return "Wrong number of parameters" if($na != 2+$nrparams);
# special for on-till
return X10_Do_On_Till($hash, @a) if($function eq "on-till");
# special for on-for-timer
return X10_Do_On_For_Timer($hash, @a) if($function eq "on-for-timer");
# argument evaluation
my $model= $hash->{MODEL};
my $dim= 0;
if($function =~ m/^dim/) {
return "Cannot dim $name (model $model)" if($models{$model} ne "dimmer");
my $arg= $a[2];
return "Wrong argument $arg, use 0..100" if($arg !~ m/^[0-9]{1,3}$/);
return "Wrong argument $arg, use 0..100" if($arg>100);
if($function eq "dimto") {
# translate dimmer command to dimup/dimdown command
my $bright= 210;
if(defined($hash->{BRIGHT})) { $bright= $hash->{BRIGHT} };
$arg= $arg-100.0*$bright/210.0;
if($arg> 0) {
$function= "dimup";
$dim= X10_LevelToDims($arg);
} else {
$function= "dimdown";
$dim= X10_LevelToDims(-$arg);
}
} else {
$dim= X10_LevelToDims($arg);
}
# the meaning of $dim= 0, 1 is unclear
# if we encounter the need for dimming by such a small amount, we
# ignore it
if($dim< 2) { return "Dim amount too small" };
};
# send command to CM11
X11_Write($hash, $function, $dim) if(!IsDummy($a[0]));
my $v = join(" ", @a);
Log GetLogLevel($a[0],2), "X10 set $v";
(undef, $v) = split(" ", $v, 2); # Not interested in the name...
my $tn = TimeNow();
$hash->{CHANGED}[0] = $v;
$hash->{STATE} = $v;
$hash->{READINGS}{state}{TIME} = $tn;
$hash->{READINGS}{state}{VAL} = $v;
X10_StateMachine($hash, $tn, $function, int(210.0*$dim/22.0+0.5));
return undef;
}
#############################
sub
X10_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "wrong syntax: define <name> X10 model housecode unitcode"
if(int(@a)!= 5);
my $model= $a[2];
return "Define $a[0]: wrong model: specify one of " .
join ",", sort keys %models
if(!grep { $_ eq $model} keys %models);
my $housecode = $a[3];
return "Define $a[0]: wrong housecode format: specify a value ".
"from A to P"
if($housecode !~ m/^[A-P]$/i);
my $unitcode = $a[4];
return "Define $a[0]: wrong unitcode format: specify a value " .
"from 1 to 16"
if( ($unitcode<1) || ($unitcode>16) );
$hash->{MODEL} = $model;
$hash->{HOUSE} = $housecode;
$hash->{UNIT} = $unitcode;
if($models{$model} eq "switch") {
$hash->{INTERFACES}= "switch"
}
elsif($models{$model} eq "dimmer") {
$hash->{INTERFACES}= "dimmer"
};
if(defined($modules{X10}{defptr}{$housecode}{$unitcode})) {
return "Error: duplicate X10 device $housecode $unitcode definition " .
$hash->{NAME} . " (previous: " .
$modules{X10}{defptr}{$housecode}{$unitcode}->{NAME} .")";
}
$modules{X10}{defptr}{$housecode}{$unitcode}= $hash;
AssignIoPort($hash);
}
#############################
sub
X10_Undef($$)
{
my ($hash, $name) = @_;
if( defined($hash->{HOUSE}) && defined($hash->{UNIT}) ) {
delete($modules{X10}{defptr}{$hash->{HOUSE}}{$hash->{UNIT}});
}
return undef;
}
#############################
sub
X10_Parse($$)
{
my ($hash, $msg) = @_;
# message example: X10:N;1 12;OFF
(undef, $msg)= split /:/, $msg, 2; # strip off "X10"
my ($housecode,$unitcodes,$command)= split /;/, $msg, 4;
my @list; # list of selected devices
#
# command evaluation
#
my ($x10func,$arg)= split / /, $command, 2;
my $function= $functions{$x10func}; # translate, eg BRIGHT -> dimup
undef $x10func; # do not use after this point
# the following code sequence converts an all on/off command into
# a sequence of simple on/off commands for all defined devices
my $all_lights= ($function=~ m/^all_lights_/);
my $all_units= ($function=~ m/^all_units_/);
if($all_lights || $all_units) {
$function= $functions_rewrite{$function}; # translate, all_lights_on -> on
$unitcodes= "";
foreach my $unitcode (keys %{ $modules{X10}{defptr}{$housecode} } ) {
my $h= $modules{X10}{defptr}{$housecode}{$unitcode};
my $islampmodule= grep { $_ eq $h->{MODEL} } @lampmodules;
if($all_units || $islampmodule ) {
$unitcodes.= " " if($unitcodes ne "");
$unitcodes.= $h->{UNIT};
}
}
# no units for that housecode
if($unitcodes eq "") {
Log 3, "X10 No units with housecode $housecode, command $command, " .
"please define one";
push(@list,
"UNDEFINED X10_$housecode X10 lm15 $housecode ?");
return @list;
}
}
# apply to each unit in turn
my @unitcodes= split / /, $unitcodes;
if(!int(@unitcodes)) {
# command without unitcodes, this happens when a single on/off is sent
# but no unit was previously selected
Log 3, "X10 No unit selected for housecode $housecode, command $command";
push(@list,
"UNDEFINED X10_$housecode X10 lm15 $housecode ?");
return @list;
}
# function rewriting
my $value= $function;
return @list if($value eq ""); # function not evaluated
# function determined, add argument
if( defined($arg) ) {
# received dims from 0..210
my $dim= $arg;
$value = "$value $dim" ;
}
my $unknown_unitcodes= '';
my $tn= TimeNow();
foreach my $unitcode (@unitcodes) {
my $h= $modules{X10}{defptr}{$housecode}{$unitcode};
if($h) {
my $name= $h->{NAME};
$h->{CHANGED}[0] = $value;
$h->{STATE} = $value;
$h->{READINGS}{state}{TIME} = $tn;
$h->{READINGS}{state}{VAL} = $value;
X10_StateMachine($h, $tn, $function, $arg);
Log GetLogLevel($name,2), "X10 $name $value";
push(@list, $name);
} else {
Log 3, "X10 Unknown device $housecode $unitcode, command $command, " .
"please define it";
push(@list,
"UNDEFINED X10_$housecode X10 lm15 $housecode $unitcode");
}
}
return @list;
}
1;

490
fhem/FHEM/21_OWTEMP.pm
View File

@ -1,490 +0,0 @@
################################################################
#
# 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 "") {
foreach my $r (sort keys %updates) {
$ret = "";
$ret = OW::get("/uncached/".$hash->{OW_PATH}."/".$r);
if(!defined($ret)) {
#
$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]}));
# define vars
my $key = $a[1];
my $value = $a[2];
my $ret;
# 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;

159
fhem/FHEM/22_ALL3076.pm
View File

@ -1,159 +0,0 @@
################################################################
#
# Copyright notice
#
# (c) 2010 Sacha Gloor (sacha@imp.ch)
#
# 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.
# 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!
#
################################################################
##############################################
package main;
use strict;
use warnings;
use Data::Dumper;
use LWP::UserAgent;
use HTTP::Request;
sub
ALL3076_Initialize($)
{
my ($hash) = @_;
$hash->{SetFn} = "ALL3076_Set";
$hash->{DefFn} = "ALL3076_Define";
$hash->{AttrList} = "loglevel:0,1,2,3,4,5,6";
}
###################################
sub
ALL3076_Set($@)
{
my ($hash, @a) = @_;
return "no set value specified" if(int(@a) != 2);
return "Unknown argument $a[1], choose one of on off toggle dimdown dimup dim10% dim20% dim30% dim40% dim50% dim60% dim70% dim80% dim90% dim100%" if($a[1] eq "?");
my $v = $a[1];
my $v2 = "";
my $err_log="";
if(defined $a[2]) { $v2=$a[2]; }
if($v eq "toggle")
{
if(defined $hash->{READINGS}{state}{VAL})
{
if($hash->{READINGS}{state}{VAL} eq "off")
{
$v="on";
}
else
{
$v="off";
}
}
else
{
$v="off";
}
}
Log GetLogLevel($a[0],2), "ALL3076 set @a";
$err_log=ALL3076_execute($hash->{DEF},$v,$v2);
if($err_log ne "")
{
Log GetLogLevel($a[0],2), "ALL3076 ".$err_log;
}
$hash->{CHANGED}[0] = $v.$v2;
$hash->{STATE} = $v.$v2;
$hash->{READINGS}{state}{TIME} = TimeNow();
$hash->{READINGS}{state}{VAL} = $v.$v2;
return undef;
}
###################################
sub
ALL3076_execute($@)
{
my ($target,$cmd,$cmd2) = @_;
my $URL='';
my $log='';
if($cmd eq "on")
{
$URL="http://".$target."/r?r=0&s=1";
}
elsif($cmd eq "off")
{
$URL="http://".$target."/r?r=0&s=0";
}
elsif($cmd eq "dimdown")
{
# We switch it on first
$log.=ALL3076_execute($target,"on");
$URL="http://".$target."/r?d=0";
}
elsif($cmd eq "dimup")
{
# We switch it on first
$log.=ALL3076_execute($target,"on");
$URL="http://".$target."/r?d=1";
}
elsif(substr($cmd,0,3) eq "dim")
{
# We switch it on first
$log.=ALL3076_execute($target,"on");
my $proz=substr($cmd,3,length($cmd)-4);
my $proz_v=sprintf("%d",$proz*255/100);
$URL="http://".$target."/r?d=".$proz_v;
}
elsif($cmd eq "on-old-for-timer")
{
sleep(1); # Todo
}
else
{
return($log);
}
# print "URL: $URL\n";
my $agent = LWP::UserAgent->new(env_proxy => 1,keep_alive => 1, timeout => 30);
my $header = HTTP::Request->new(GET => $URL);
my $request = HTTP::Request->new('GET', $URL, $header);
my $response = $agent->request($request);
$log.= "Can't get $URL -- ".$response->status_line
unless $response->is_success;
return($log);
}
sub
ALL3076_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "Wrong syntax: use define <name> ALL3076 <ip-address>" if(int(@a) != 3);
return undef;
}
1;

231
fhem/FHEM/23_ALL4027.pm
View File

@ -1,231 +0,0 @@
################################################################
#
# Copyright notice
#
# (c) 2010 Sacha Gloor (sacha@imp.ch)
#
# 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.
# 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!
#
################################################################
##############################################
package main;
use strict;
use warnings;
use Data::Dumper;
use LWP::UserAgent;
use HTTP::Request;
sub
ALL4027_Initialize($)
{
my ($hash) = @_;
$hash->{SetFn} = "ALL4027_Set";
$hash->{DefFn} = "ALL4027_Define";
$hash->{AttrList} = "loglevel:0,1,2,3,4,5,6";
}
###################################
sub
ALL4027_Set($@)
{
my ($hash, @a) = @_;
return "no set value specified" if(int(@a) < 2);
return "Unknown argument $a[1], choose one of on off toggle on-for-timer" if($a[1] eq "?");
my $v = $a[1];
my $v2= "";
if(defined($a[2])) { $v2=$a[2]; }
if($v eq "toggle")
{
if(defined $hash->{READINGS}{state}{VAL})
{
if($hash->{READINGS}{state}{VAL} eq "off")
{
$v="on";
}
else
{
$v="off";
}
}
else
{
$v="off";
}
}
elsif($v eq "on-for-timer")
{
InternalTimer(gettimeofday()+$v2, "ALL4027_on_timeout",$hash, 0);
# on-for-timer is now a on.
$v="on";
}
ALL4027_execute($hash->{DEF},$v);
Log GetLogLevel($a[0],2), "ALL4027 set @a";
$hash->{CHANGED}[0] = $v;
$hash->{STATE} = $v;
$hash->{READINGS}{state}{TIME} = TimeNow();
$hash->{READINGS}{state}{VAL} = $v;
DoTrigger($hash->{NAME}, undef);
return undef;
}
sub
ALL4027_on_timeout($)
{
my ($hash) = @_;
my @a;
$a[0]=$hash->{NAME};
$a[1]="off";
ALL4027_Set($hash,@a);
return undef;
}
###################################
sub
ALL4027_execute($@)
{
my ($target,$cmd) = @_;
my $URL='';
my @a = split("[ \t][ \t]*", $target);
if($cmd eq "on")
{
$URL="http://".$a[0]."/t8?s=".$a[1]."&n=0&bt=".$a[2]."&z=0&tm=0";
}
elsif($cmd eq "off")
{
$URL="http://".$a[0]."/t8?s=".$a[1]."&n=0&bt=".$a[2]."&z=1&tm=0";
}
else
{
return undef;
}
# print "URL: $URL\n";
my $agent = LWP::UserAgent->new(env_proxy => 1,keep_alive => 1, timeout => 3);
my $header = HTTP::Request->new(GET => $URL);
my $request = HTTP::Request->new('GET', $URL, $header);
my $response = $agent->request($request);
return undef;
}
sub
ALL4027_Define($$)
{
my ($hash, $def) = @_;
my $name=$hash->{NAME};
my @a = split("[ \t][ \t]*", $def);
my $host = $a[2];
my $host_port = $a[3];
my $relay_nr = $a[4];
my $delay=$a[5];
$attr{$name}{delay}=$delay if $delay;
return "Wrong syntax: use define <name> ALL4027 <ip-address> <port-nr> <relay-nr> <pool-delay>" if(int(@a) != 6);
$hash->{Host} = $host;
$hash->{Host_Port} = $host_port;
$hash->{Relay_Nr} = $relay_nr;
InternalTimer(gettimeofday()+$delay, "ALL4027_GetStatus", $hash, 0);
return undef;
}
#####################################
sub
ALL4027_GetStatus($)
{
my ($hash) = @_;
my $err_log='';
my $line;
my $name = $hash->{NAME};
my $host = $hash->{Host};
my $delay=$attr{$name}{delay}||300;
InternalTimer(gettimeofday()+$delay, "ALL4027_GetStatus", $hash, 0);
if(!defined($hash->{Host_Port})) { return(""); }
my $host_port = $hash->{Host_Port};
my $relay_nr = $hash->{Relay_Nr};
my $URL="http://".$host."/t8?s=".$host_port;
my $agent = LWP::UserAgent->new(env_proxy => 1,keep_alive => 1, timeout => 3);
my $header = HTTP::Request->new(GET => $URL);
my $request = HTTP::Request->new('GET', $URL, $header);
my $response = $agent->request($request);
$err_log.= "Can't get $URL -- ".$response->status_line
unless $response->is_success;
if($err_log ne "")
{
Log GetLogLevel($name,2), "ALL4027 ".$err_log;
return("");
}
my $body = $response->content;
my @lines=split(/\n/,$body);
my $bitvalue=2**$relay_nr;
my $state="???";
foreach $line (@lines)
{
if(substr($line,0,16) eq "<BR>Dezimalwert:")
{
$line =~ s/<BR>//g;
my($tmp,$a)=split(/ /,$line);
my $value=$a;
my $result=$value&$bitvalue;
if($result == 0) { $state="on"; }
else { $state="off"; }
}
}
if($state ne "???")
{
if($state ne $hash->{STATE})
{
Log 4, "ALL4027_GetStatus: $host_port $relay_nr ".$hash->{STATE}." -> ".$state;
$hash->{STATE} = $state;
$hash->{CHANGED}[0] = $state;
$hash->{READINGS}{state}{TIME} = TimeNow();
$hash->{READINGS}{state}{VAL} = $state;
DoTrigger($name, undef) if($init_done);
}
}
}
1;

162
fhem/FHEM/23_WEBIO.pm
View File

@ -1,162 +0,0 @@
################################################################
#
# Copyright notice
#
# (c) 2010 Sacha Gloor (sacha@imp.ch)
#
# 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.
# 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!
#
################################################################
##############################################
package main;
use strict;
use warnings;
use Data::Dumper;
use LWP::UserAgent;
use HTTP::Request;
sub
WEBIO_Initialize($)
{
my ($hash) = @_;
$hash->{SetFn} = "WEBIO_Set";
$hash->{DefFn} = "WEBIO_Define";
$hash->{AttrList} = "loglevel:0,1,2,3,4,5,6";
}
###################################
sub
WEBIO_Set($@)
{
my ($hash, @a) = @_;
return "no set value specified" if(int(@a) != 2);
return "Unknown argument $a[1], choose one of 0 1 2 3 4 5 6 7 8 9 10" if($a[1] eq "?");
my $v = $a[1];
my $sensor="volt";
WEBIO_execute($hash->{DEF},$v);
Log GetLogLevel($a[0],2), "WEBIO set @a";
$hash->{CHANGED}[0] = "Volt:";
$hash->{STATE} = "V: ".$v;
$hash->{READINGS}{$sensor}{TIME} = TimeNow();
$hash->{READINGS}{$sensor}{VAL} = $v." (Volt)";
return undef;
}
###################################
sub
WEBIO_execute($@)
{
my ($target,$cmd) = @_;
my $URL='';
my @a = split("[ \t][ \t]*", $target);
$URL="http://".$a[0]."/outputaccess".$a[1]."?PW=&State=".$cmd."&";
my $agent = LWP::UserAgent->new(env_proxy => 1,keep_alive => 1, timeout => 1);
my $header = HTTP::Request->new(GET => $URL);
my $request = HTTP::Request->new('GET', $URL, $header);
my $response = $agent->request($request);
return undef;
}
sub
WEBIO_Define($$)
{
my ($hash, $def) = @_;
my $name=$hash->{NAME};
my @a = split("[ \t][ \t]*", $def);
my $host = $a[2];
my $host_port = $a[3];
my $delay=$a[4];
$attr{$name}{delay}=$delay if $delay;
return "Wrong syntax: use define <name> WEBIO <ip-address> <port-nr> <poll-delay>" if(int(@a) != 5);
$hash->{Host} = $host;
$hash->{Host_Port} = $host_port;
InternalTimer(gettimeofday()+$delay, "WEBIO_GetStatus", $hash, 0);
return undef;
}
#####################################
sub
WEBIO_GetStatus($)
{
my ($hash) = @_;
my $err_log='';
my $line;
my $name = $hash->{NAME};
my $host = $hash->{Host};
my $delay=$attr{$name}{delay}||300;
InternalTimer(gettimeofday()+$delay, "WEBIO_GetStatus", $hash, 0);
if(!defined($hash->{Host_Port})) { return(""); }
my $host_port = $hash->{Host_Port};
my $URL="http://".$host."/Single".$host_port;
my $agent = LWP::UserAgent->new(env_proxy => 1,keep_alive => 1, timeout => 3);
my $header = HTTP::Request->new(GET => $URL);
my $request = HTTP::Request->new('GET', $URL, $header);
my $response = $agent->request($request);
$err_log.= "Can't get $URL -- ".$response->status_line
unless $response->is_success;
if($err_log ne "")
{
Log GetLogLevel($name,2), "WEBIO ".$err_log;
return("");
}
my $body = $response->content;
# print $body."\n";
my @values=split(/;/,$body);
my $last=$values[$#values];
my @v=split(/ /,$last);
my $state=$v[0];
$state=~s/,/./g;
my $sensor="volt";
Log 4, "WEBIO_GetStatus: $host_port ".$hash->{STATE}." -> ".$state;
$hash->{STATE} = "V: ".$state;
$hash->{CHANGED}[0] = $state;
$hash->{READINGS}{$sensor}{TIME} = TimeNow();
$hash->{READINGS}{$sensor}{VAL} = $state." (Volt)";
DoTrigger($name, undef) if($init_done);
}
1;

120
fhem/FHEM/23_WEBTHERM.pm
View File

@ -1,120 +0,0 @@
################################################################
#
# Copyright notice
#
# (c) 2010 Sacha Gloor (sacha@imp.ch)
#
# 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.
# 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!
#
################################################################
##############################################
package main;
use strict;
use warnings;
use Data::Dumper;
use LWP::UserAgent;
use HTTP::Request;
sub
WEBTHERM_Initialize($)
{
my ($hash) = @_;
$hash->{DefFn} = "WEBTHERM_Define";
$hash->{AttrList} = "loglevel:0,1,2,3,4,5,6";
}
sub
WEBTHERM_Define($$)
{
my ($hash, $def) = @_;
my $name=$hash->{NAME};
my @a = split("[ \t][ \t]*", $def);
my $host = $a[2];
my $host_port = $a[3];
my $delay=$a[4];
$attr{$name}{delay}=$delay if $delay;
return "Wrong syntax: use define <name> WEBTHERM <ip-address> <port-nr> <poll-delay>" if(int(@a) != 5);
$hash->{Host} = $host;
$hash->{Host_Port} = $host_port;
InternalTimer(gettimeofday()+$delay, "WEBTHERM_GetStatus", $hash, 0);
return undef;
}
#####################################
sub
WEBTHERM_GetStatus($)
{
my ($hash) = @_;
my $err_log='';
my $line;
my $name = $hash->{NAME};
my $host = $hash->{Host};
my $delay=$attr{$name}{delay}||300;
InternalTimer(gettimeofday()+$delay, "WEBTHERM_GetStatus", $hash, 0);
if(!defined($hash->{Host_Port})) { return(""); }
my $host_port = $hash->{Host_Port};
my $URL="http://".$host."/Single".$host_port;
my $agent = LWP::UserAgent->new(env_proxy => 1,keep_alive => 1, timeout => 3);
my $header = HTTP::Request->new(GET => $URL);
my $request = HTTP::Request->new('GET', $URL, $header);
my $response = $agent->request($request);
$err_log.= "Can't get $URL -- ".$response->status_line
unless $response->is_success;
if($err_log ne "")
{
Log GetLogLevel($name,2), "WEBTHERM ".$err_log;
return("");
}
my $body = $response->content;
my $text='';
# print $body."\n";
my @values=split(/;/,$body);
my $last=$values[$#values];
my $state=$last;
$state=~s/,/./g;
$state=substr($state,0,-2);
my $sensor="temperature";
Log 4, "WEBTHERM_GetStatus: $name $host_port ".$hash->{STATE}." -> ".$state;
$text="Temperature: ".$state;
$hash->{STATE} = "T: ".$state;
$hash->{CHANGED}[0] = $text;
$hash->{READINGS}{$sensor}{TIME} = TimeNow();
$hash->{READINGS}{$sensor}{VAL} = $state." (Celsius)";
DoTrigger($name, undef) if($init_done);
}
1;

561
fhem/FHEM/40_RFXCOM.pm
View File

@ -1,561 +0,0 @@
#################################################################################
# 40_RFXCOM.pm
# Modul for FHEM
#
# Tested with USB-RFXCOM-Receiver (433.92MHz, USB, order code 80002)
# (see http://www.rfxcom.com/).
# To use this module, you need to define an RFXCOM receiver:
# define RFXCOM RFXCOM /dev/ttyUSB0
#
# The module also has code to access LAN based RFXCOM receivers like 81003 and 83003.
# This was tested by me with the help of the RFXCOM people (Thanks to Bert!) and works
# for the basic functions. However a disconnect of the TCP connection is currectly
# not detected.
#
# To use it define the IP-Adresss and the Port:
# define RFXCOM RFXCOM 192.168.169.111:10001
# optionally you may issue not to initialize the device (useful if you share an RFXCOM device with other programs)
# define RFXCOM RFXCOM 192.168.169.111:10001 noinit
#
# The RFXCOM receivers supports lots of protocols that may be implemented for FHEM
# writing the appropriate FHEM modules.
# Special thanks to RFXCOM, http://www.rfxcom.com/, for their help.
# I own an USB-RFXCOM-Receiver (433.92MHz, USB, order code 80002) and highly recommend it.
#
# The module 41_OREGON.pm implements the decoding of the Oregon Scientific weather sensors.
# It is derived from xPL Perl (http://www.xpl-perl.org.uk/). I suggest to look there
# if you want to implement other protocols.
#
# Willi Herzig, 2010
#
# 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.
#
#################################################################################
# derived from 00_CUL.pm
#
###########################
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
my $last_rmsg = "abcd";
my $last_time = 1;
sub RFXCOM_Clear($);
sub RFXCOM_Read($);
sub RFXCOM_SimpleWrite(@);
sub RFXCOM_SimpleRead($);
sub RFXCOM_Ready($);
sub RFXCOM_Parse($$$$);
sub RFXCOM_OpenDev($$);
sub RFXCOM_CloseDev($);
sub RFXCOM_Disconnected($);
sub
RFXCOM_Initialize($)
{
my ($hash) = @_;
# Provider
$hash->{ReadFn} = "RFXCOM_Read";
$hash->{Clients} =
":RFXMETER:OREGON:RFXX10REC:RFXELSE:";
my %mc = (
"1:RFXMETER" => "^0.*",
"2:OREGON" => "^[\x38-\x78].*",
"3:RFXX10REC" => "^(\\ |\\)).*", # 0x20 or 0x29
"4:RFXELSE" => "^.*",
);
$hash->{MatchList} = \%mc;
$hash->{ReadyFn} = "RFXCOM_Ready";
# Normal devices
$hash->{DefFn} = "RFXCOM_Define";
$hash->{UndefFn} = "RFXCOM_Undef";
$hash->{GetFn} = "RFXCOM_Get";
$hash->{SetFn} = "RFXCOM_Set";
$hash->{StateFn} = "RFXCOM_SetState";
$hash->{AttrList}= "do_not_notify:1,0 do_not_init:1:0 loglevel:0,1,2,3,4,5,6";
$hash->{ShutdownFn} = "RFXCOM_Shutdown";
}
#####################################
sub
RFXCOM_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "wrong syntax: define <name> RFXCOM devicename [noinit]"
if(@a != 3 && @a != 4);
RFXCOM_CloseDev($hash);
my $name = $a[0];
my $dev = $a[2];
my $opt = $a[3] if(@a == 4);;
if($dev eq "none") {
Log 1, "RFXCOM: $name device is none, commands will be echoed only";
$attr{$name}{dummy} = 1;
return undef;
}
if(defined($opt)) {
if($opt eq "noinit") {
Log 1, "RFXCOM: $name no init is done";
$attr{$name}{do_not_init} = 1;
} else {
return "wrong syntax: define <name> RFXCOM devicename [noinit]"
}
}
$hash->{DeviceName} = $dev;
my $ret = RFXCOM_OpenDev($hash, 0);
return $ret;
}
#####################################
sub
RFXCOM_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};
}
}
RFXCOM_CloseDev($hash);
return undef;
}
#####################################
sub
RFXCOM_Shutdown($)
{
my ($hash) = @_;
return undef;
}
#####################################
sub
RFXCOM_Set($@)
{
my ($hash, @a) = @_;
my $msg;
my $name=$a[0];
my $reading= $a[1];
$msg="$name => No Set function ($reading) implemented";
Log 1,$msg;
return $msg;
}
#####################################
sub
RFXCOM_Get($@)
{
my ($hash, @a) = @_;
my $msg;
my $name=$a[0];
my $reading= $a[1];
$msg="$name => No Get function ($reading) implemented";
Log 1,$msg;
return $msg;
}
#####################################
sub
RFXCOM_SetState($$$$)
{
my ($hash, $tim, $vt, $val) = @_;
return undef;
}
sub
RFXCOM_Clear($)
{
my $hash = shift;
my $buf;
# clear buffer:
if($hash->{USBDev}) {
while ($hash->{USBDev}->lookfor()) {
$buf = RFXCOM_SimpleRead($hash);
}
}
if($hash->{TCPDev}) {
# TODO
# while ($hash->{USBDev}->lookfor()) {
# $buf = RFXCOM_SimpleRead($hash);
# }
return $buf;
}
}
#####################################
sub
RFXCOM_DoInit($)
{
my $hash = shift;
my $name = $hash->{NAME};
my $err;
my $msg = undef;
my $buf;
my $char = undef ;
RFXCOM_Clear($hash);
if(defined($attr{$name}) && defined($attr{$name}{"do_not_init"})) {
Log 1, "RFXCOM: defined with noinit. Do not send init string to device.";
$hash->{STATE} = "Initialized" if(!$hash->{STATE});
# Reset the counter
delete($hash->{XMIT_TIME});
delete($hash->{NR_CMD_LAST_H});
return undef;
}
#
# Init
my $init = pack('H*', 'F02C');
RFXCOM_SimpleWrite($hash, $init);
sleep(1);
$buf = RFXCOM_SimpleRead($hash);
if (defined($buf)) { $char = ord($buf); }
if (! $buf) {
return "RFXCOM: Initialization Error $name: no char read";
} elsif ($char ne 0x2c) {
my $hexline = unpack('H*', $buf);
Log 1, "RFXCOM: Initialization Error hexline='$hexline'";
return "RFXCOM: Initialization Error %name expected char=0x2c, but char=$char received.";
} else {
Log 1, "RFXCOM: Init OK";
$hash->{STATE} = "Initialized" if(!$hash->{STATE});
}
#
# Reset the counter
delete($hash->{XMIT_TIME});
delete($hash->{NR_CMD_LAST_H});
return undef;
}
#####################################
# called from the global loop, when the select for hash->{FD} reports data
sub
RFXCOM_Read($)
{
my ($hash) = @_;
my $name = $hash->{NAME};
my $char;
my $mybuf = RFXCOM_SimpleRead($hash);
if(!defined($mybuf) || length($mybuf) == 0) {
RFXCOM_Disconnected($hash);
return "";
}
my $rfxcom_data = $hash->{PARTIAL};
#Log 5, "RFXCOM/RAW: $rfxcom_data/$mybuf";
$rfxcom_data .= $mybuf;
#my $hexline = unpack('H*', $rfxcom_data);
#Log 1, "RFXCOM: RFXCOM_Read '$hexline'";
# first char as byte represents number of bits of the message
my $bits = ord($rfxcom_data);
my $num_bytes = $bits >> 3; if (($bits & 0x7) != 0) { $num_bytes++; }
while(length($rfxcom_data) > $num_bytes) {
# the buffer contains at least the number of bytes we need
my $rmsg;
$rmsg = substr($rfxcom_data, 0, $num_bytes+1);
#my $hexline = unpack('H*', $rmsg);
#Log 1, "RFXCOM_Read rmsg '$hexline'";
$rfxcom_data = substr($rfxcom_data, $num_bytes+1);;
#$hexline = unpack('H*', $rfxcom_data);
#Log 1, "RFXCOM_Read rfxcom_data '$hexline'";
#
RFXCOM_Parse($hash, $hash, $name, $rmsg);
}
#Log 1, "RFXCOM_Read END";
$hash->{PARTIAL} = $rfxcom_data;
}
sub
RFXCOM_Parse($$$$)
{
my ($hash, $iohash, $name, $rmsg) = @_;
my $hexline = unpack('H*', $rmsg);
Log 5, "RFXCOM_Parse1 '$hexline'";
my %addvals;
# Parse only if message is different within 2 seconds
# (some Oregon sensors always sends the message twice, X10 security sensors even sends the message five times)
if (("$last_rmsg" ne "$rmsg") || (time() - $last_time) > 1) {
Log 5, "RFXCOM_Dispatch '$hexline'";
#Log 1, "RFXCOM_Dispatch '$hexline'";
Dispatch($hash, $rmsg, \%addvals);
$hash->{"${name}_MSGCNT"}++;
$hash->{"${name}_TIME"} = TimeNow();
$hash->{RAWMSG} = $rmsg;
} else {
#Log 1, "RFXCOM_Dispatch '$hexline' dup";
#Log 1, "<-duplicate->";
}
$last_rmsg = $rmsg;
$last_time = time();
#$hexline = unpack('H*', $rmsg);
#Log 1, "RFXCOM_Parse2 '$hexline'";
}
#####################################
sub
RFXCOM_Ready($)
{
my ($hash) = @_;
return RFXCOM_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;
return ($InBytes>0);
}
########################
sub
RFXCOM_SimpleWrite(@)
{
my ($hash, $msg) = @_;
return if(!$hash);
$hash->{USBDev}->write($msg) if($hash->{USBDev});
syswrite($hash->{TCPDev}, $msg) if($hash->{TCPDev});
#my $hexline = unpack('H*', $msg);
#Log 1, "RFXCOM_SimpleWrite '$hexline'";
select(undef, undef, undef, 0.001);
}
########################
sub
RFXCOM_SimpleRead($)
{
my ($hash) = @_;
my $buf;
if($hash->{USBDev}) {
$buf = $hash->{USBDev}->read(1) ;
#my $hexline = unpack('H*', $buf);
#Log 1, "RFXCOM: RFXCOM_SimpleRead1 '$hexline'";
if (!defined($buf) || length($buf) == 0) {
#sleep(1);
$buf = $hash->{USBDev}->read(1) ;
}
return $buf;
}
if($hash->{TCPDev}) {
my $buf;
if(!defined(sysread($hash->{TCPDev}, $buf, 1))) {
RFXCOM_Disconnected($hash);
return undef;
}
return $buf;
}
return undef;
}
########################
sub
RFXCOM_CloseDev($)
{
my ($hash) = @_;
my $name = $hash->{NAME};
my $dev = $hash->{DeviceName};
return if(!$dev);
Log 1, "RFXCOM: closing $dev";
if($hash->{TCPDev}) {
$hash->{TCPDev}->close();
delete($hash->{TCPDev});
} elsif($hash->{USBDev}) {
$hash->{USBDev}->close() ;
delete($hash->{USBDev});
}
delete($selectlist{"$name.$dev"});
delete($readyfnlist{"$name.$dev"});
delete($hash->{FD});
}
########################
sub
RFXCOM_OpenDev($$)
{
my ($hash, $reopen) = @_;
my $dev = $hash->{DeviceName};
my $name = $hash->{NAME};
my $po;
$hash->{PARTIAL} = "";
Log 3, "RFXCOM opening $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, "RFXCOM: Can't connect to $dev: $!") if(!$reopen);
$readyfnlist{"$name.$dev"} = $hash;
$hash->{STATE} = "disconnected";
$hash->{NEXT_OPEN} = time()+60;
RFXCOM_Disconnected($hash);
return "";
}
$hash->{TCPDev} = $conn;
$hash->{FD} = $conn->fileno();
delete($readyfnlist{"$name.$dev"});
$selectlist{"$name.$dev"} = $hash;
} else { # USB Device
if ($^O=~/Win/) {
require Win32::SerialPort;
$po = new Win32::SerialPort ($dev);
} else {
#Log(1, "RFXCOM: new Device");
require Device::SerialPort;
$po = new Device::SerialPort ($dev);
}
if(!$po) {
return undef if($reopen);
Log(3, "RFXCOM: 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;
}
#$po->reset_error || Log 1, "RFXCOM reset_error";
$po->databits(8) || Log 1, "RFXCOM could not set databits";
$po->baudrate(4800) || Log 1, "RFXCOM could not set baudrate";
$po->parity('none') || Log 1, "RFXCOM could not set parity";
$po->stopbits(1) || Log 1, "RFXCOM could not set stopbits";
$po->handshake('none') || Log 1, "RFXCOM could not set handshake";
$po->datatype('raw') || Log 1, "RFXCOM could not set datatype";
#$po->lookclear || Log 1, "RFXCOM could not set lookclear";
$po->write_settings || Log 1, "RFXCOM could not write_settings $dev";
$hash->{po} = $po;
$hash->{socket} = 0;
Log 1, "RFXCOM: RFXCOM_OpenDev $dev done";
}
if($reopen) {
Log 1, "RFXCOM: $dev reappeared ($name)";
} else {
Log 3, "RFXCOM: device opened";
}
$hash->{STATE}=""; # Allow InitDev to set the state
my $ret = RFXCOM_DoInit($hash);
if($ret) {
# try again
Log 1, "RFXCOM: Cannot init $dev, at first try. Trying again.";
my $ret = RFXCOM_DoInit($hash);
if($ret) {
RFXCOM_CloseDev($hash);
Log 1, "RFXCOM: Cannot init $dev, ignoring it";
return "RFXCOM: Error Init string.";
}
}
DoTrigger($name, "CONNECTED") if($reopen);
return $ret;
}
sub
RFXCOM_Disconnected($)
{
my $hash = shift;
my $dev = $hash->{DeviceName};
my $name = $hash->{NAME};
return if(!defined($hash->{FD})); # Already deleted or RFR
Log 1, "RFXCOM: $dev disconnected, waiting to reappear";
RFXCOM_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;

943
fhem/FHEM/41_OREGON.pm
View File

@ -1,943 +0,0 @@
#################################################################################
# 41_OREGON.pm
# Module for FHEM to decode Oregon sensor messages
#
# derived from 18_CUL-HOERMANN.pm
#
# This code is derived from http://www.xpl-perl.org.uk/.
# Thanks a lot to Mark Hindess who wrote xPL.
#
# Special thanks to RFXCOM, http://www.rfxcom.com/, for their
# help. I own an USB-RFXCOM-Receiver (433.92MHz, USB, order code 80002)
# and highly recommend it.
#
# Willi Herzig, 2010
#
# 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.
#
##################################
#
# Most of the subs are copied and modified from xpl-perl
# from the following two files:
# xpl-perl/lib/xPL/Utils.pm:
# xpl-perl/lib/xPL/RF/Oregon.pm:
#
#SEE ALSO
# Project website: http://www.xpl-perl.org.uk/
# AUTHOR: Mark Hindess, soft-xpl-perl@temporalanomaly.com
#
#Copyright (C) 2007, 2009 by Mark Hindess
#
#This library is free software; you can redistribute it and/or modify
#it under the same terms as Perl itself, either Perl version 5.8.7 or,
#at your option, any later version of Perl 5 you may have available.
#
# values for "set global verbose"
# 4: log unknown protocols
# 5: log decoding hexlines for debugging
#
package main;
use strict;
use warnings;
my $time_old = 0;
sub
OREGON_Initialize($)
{
my ($hash) = @_;
$hash->{Match} = "^[\x38-\x78].*";
#$hash->{Match} = "^[^\x30]";
$hash->{DefFn} = "OREGON_Define";
$hash->{UndefFn} = "OREGON_Undef";
$hash->{ParseFn} = "OREGON_Parse";
$hash->{AttrList} = "IODev do_not_notify:1,0 loglevel:0,1,2,3,4,5,6";
}
#####################################
sub
OREGON_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $a = int(@a);
#print "a0 = $a[0]";
return "wrong syntax: define <name> OREGON code" if(int(@a) != 3);
my $name = $a[0];
my $code = $a[2];
$hash->{CODE} = $code;
#$modules{OREGON}{defptr}{$name} = $hash;
$modules{OREGON}{defptr}{$code} = $hash;
AssignIoPort($hash);
return undef;
}
#####################################
sub
OREGON_Undef($$)
{
my ($hash, $name) = @_;
delete($modules{OREGON}{defptr}{$name});
return undef;
}
#########################################
# From xpl-perl/lib/xPL/Util.pm:
sub hi_nibble {
($_[0]&0xf0)>>4;
}
sub lo_nibble {
$_[0]&0xf;
}
sub nibble_sum {
my $c = $_[0];
my $s = 0;
foreach (0..$_[0]-1) {
$s += hi_nibble($_[1]->[$_]);
$s += lo_nibble($_[1]->[$_]);
}
$s += hi_nibble($_[1]->[$_[0]]) if (int($_[0]) != $_[0]);
return $s;
}
# --------------------------------------------
# From xpl-perl/lib/xPL/RF/Oregon.pm:
# This function creates a simple key from a device type and message
# length (in bits). It is used to as the index for the parts table.
sub type_length_key {
($_[0] << 8) + $_[1]
}
# --------------------------------------------
# types from xpl-perl/lib/xPL/RF/Oregon.pm
# Changes: Use pointers to subs for method to allow strict use
my %types =
(
# THGR810
type_length_key(0xfa28, 80) =>
{
part => 'THGR810', checksum => \&checksum2, method => \&common_temphydro,
},
# WTGR800 Temp hydro
type_length_key(0xfab8, 80) =>
{
part => 'WTGR800_T', checksum => \&checksum2, method => \&alt_temphydro,
},
# WTGR800 Anenometer
type_length_key(0x1a99, 88) =>
{
part => 'WTGR800_A', checksum => \&checksum4, method => \&wtgr800_anemometer,
},
#
type_length_key(0x1a89, 88) =>
{
part => 'WGR800', checksum => \&checksum4, method => \&wtgr800_anemometer,
},
type_length_key(0xda78, 72) =>
{
part => 'UVN800', checksun => \&checksum7, method => \&uvn800,
},
type_length_key(0xea7c, 120) =>
{
part => 'UV138', checksum => \&checksum1, method => \&uv138,
},
type_length_key(0xea4c, 80) =>
{
part => 'THWR288A', checksum => \&checksum1, method => \&common_temp,
},
#
type_length_key(0xea4c, 68) =>
{
part => 'THN132N', checksum => \&checksum1, method => \&common_temp,
},
#
type_length_key(0x9aec, 104) =>
{
part => 'RTGR328N', checksum => \&checksum3, method => \&rtgr328n_datetime,
},
#
type_length_key(0x9aea, 104) =>
{
part => 'RTGR328N', checksum => \&checksum3, method => \&rtgr328n_datetime,
},
# THGN122N,THGR122NX,THGR228N,THGR268
type_length_key(0x1a2d, 80) =>
{
part => 'THGR228N', checksum => \&checksum2, method => \&common_temphydro,
},
# THGR918
type_length_key(0x1a3d, 80) =>
{
part => 'THGR918', checksum => \&checksum2, method => \&common_temphydro,
},
# BTHR918
type_length_key(0x5a5d, 88) =>
{
part => 'BTHR918', checksum => \&checksum5, method => \&common_temphydrobaro,
},
# BTHR918N, BTHR968
type_length_key(0x5a6d, 96) =>
{
part => 'BTHR918N', checksum => \&checksum5, method => \&alt_temphydrobaro,
},
#
type_length_key(0x3a0d, 80) =>
{
part => 'WGR918', checksum => \&checksum4, method => \&wgr918_anemometer,
},
#
type_length_key(0x3a0d, 88) =>
{
part => 'WGR918', checksum => \&checksum4, method => \&wgr918_anemometer,
},
# RGR126, RGR682, RGR918:
type_length_key(0x2a1d, 84) =>
{
part => 'RGR918', checksum => \&checksum6plus, method => \&common_rain,
},
#
type_length_key(0x0a4d, 80) =>
{
part => 'THR128', checksum => \&checksum2, method => \&common_temp,
},
# THGR328N
type_length_key(0xca2c, 80) =>
{
part => 'THGR328N', checksum => \&checksum2, method => \&common_temphydro,
},
#
type_length_key(0xca2c, 120) =>
{
part => 'THGR328N', checksum => \&checksum2, method => \&common_temphydro,
},
# masked
type_length_key(0x0acc, 80) =>
{
part => 'RTGR328N', checksum => \&checksum2, method => \&common_temphydro,
},
# PCR800. Commented out until fully tested.
type_length_key(0x2a19, 92) =>
{
part => 'PCR800', checksum => \&checksum8, method => \&rain_PCR800,
},
);
# --------------------------------------------
#my $DOT = q{.};
# Important: change it to _, because FHEM uses regexp
my $DOT = q{_};
my @OREGON_winddir_name=("N","NNE","NE","ENE","E","ESE","SE","SSE","S","SSW","SW","WSW","W","WNW","NW","NNW");
# --------------------------------------------
# The following functions are changed:
# - some parameter like "parent" and others are removed
# - @res array return the values directly (no usage of xPL::Message)
sub temperature {
my ($bytes, $dev, $res) = @_;
my $temp =
(($bytes->[6]&0x8) ? -1 : 1) *
(hi_nibble($bytes->[5])*10 + lo_nibble($bytes->[5]) +
hi_nibble($bytes->[4])/10);
push @$res, {
device => $dev,
type => 'temp',
current => $temp,
units => 'Grad Celsius'
}
}
sub humidity {
my ($bytes, $dev, $res) = @_;
my $hum = lo_nibble($bytes->[7])*10 + hi_nibble($bytes->[6]);
my $hum_str = ['normal', 'comfortable', 'dry', 'wet']->[$bytes->[7]>>6];
push @$res, {
device => $dev,
type => 'humidity',
current => $hum,
string => $hum_str,
units => '%'
}
}
sub pressure {
my ($bytes, $dev, $res, $forecast_nibble, $offset) = @_;
$offset = 795 unless ($offset);
my $hpa = $bytes->[8]+$offset;
my $forecast = { 0xc => 'sunny',
0x6 => 'partly',
0x2 => 'cloudy',
0x3 => 'rain',
}->{$forecast_nibble} || 'unknown';
push @$res, {
device => $dev,
type => 'pressure',
current => $hpa,
units => 'hPa',
forecast => $forecast,
}
}
sub simple_battery {
my ($bytes, $dev, $res) = @_;
my $battery_low = $bytes->[4]&0x4;
my $bat = $battery_low ? 10 : 90;
push @$res, {
device => $dev,
type => 'battery',
current => $bat,
units => '%',
}
}
sub percentage_battery {
my ($bytes, $dev, $res) = @_;
my $bat = 100-10*lo_nibble($bytes->[4]);
push @$res, {
device => $dev,
type => 'battery',
current => $bat,
units => '%',
}
}
my @uv_str =
(
qw/low low low/, # 0 - 2
qw/medium medium medium/, # 3 - 5
qw/high high/, # 6 - 7
'very high', 'very high', 'very high', # 8 - 10
);
sub uv_string {
$uv_str[$_[0]] || 'dangerous';
}
sub uv {
my ($bytes, $dev, $res) = @_;
my $uv = lo_nibble($bytes->[5])*10 + hi_nibble($bytes->[4]);
my $risk = uv_string($uv);
push @$res, {
device => $dev,
type => 'uv',
current => $uv,
risk => $risk,
}
}
sub uv2 {
my ($bytes, $dev, $res) = @_;
my $uv = hi_nibble($bytes->[4]);
my $risk = uv_string($uv);
push @$res, {
device => $dev,
type => 'uv',
current => $uv,
risk => $risk,
}
}
# --------------------------------------------------------
sub uv138 {
my $type = shift;
my $bytes = shift;
my $device = sprintf "%02x", $bytes->[3];
my $dev_str = $type.$DOT.$device;
my @res = ();
uv($bytes, $dev_str, \@res);
simple_battery($bytes, $dev_str, \@res);
return @res;
}
sub uvn800 {
my $type = shift;
my $bytes = shift;
my $device = sprintf "%02x", $bytes->[3];
my $dev_str = $type.$DOT.$device;
my @res = ();
uv2($bytes, $dev_str, \@res);
percentage_battery($bytes, $dev_str, \@res);
return @res;
}
sub wgr918_anemometer {
my $type = shift;
my $bytes = shift;
my $device = sprintf "%02x", $bytes->[3];
my $dev_str = $type.$DOT.$device;
my @res = ();
my $dir = sprintf("%02x",$bytes->[5])*10 + hi_nibble($bytes->[4]);
my $dirname = $OREGON_winddir_name[$dir/22.5];
my $speed = lo_nibble($bytes->[7]) * 10 + sprintf("%02x",$bytes->[6])/10;
my $avspeed = sprintf("%02x",$bytes->[8]) + hi_nibble($bytes->[7]) / 10;
push @res, {
device => $dev_str,
type => 'speed',
current => $speed,
average => $avspeed,
units => 'mps',
} , {
device => $dev_str,
type => 'direction',
current => $dir,
string => $dirname,
units => 'degrees',
}
;
percentage_battery($bytes, $dev_str, \@res);
return @res;
}
# -----------------------------
sub wtgr800_anemometer {
my $type = shift;
my $bytes = shift;
my $device = sprintf "%02x", $bytes->[3];
my $dev_str = $type.$DOT.$device;
my @res = ();
my $dir = hi_nibble($bytes->[4]) % 16;
my $dirname = $OREGON_winddir_name[$dir];
$dir = $dir * 22.5;
my $speed = lo_nibble($bytes->[7]) * 10 + sprintf("%02x",$bytes->[6])/10;
my $avspeed = sprintf("%02x",$bytes->[8]) + hi_nibble($bytes->[7]) / 10;
push @res, {
device => $dev_str,
type => 'speed',
current => $speed,
average => $avspeed,
units => 'mps',
} , {
device => $dev_str,
type => 'direction',
current => $dir,
string => $dirname,
units => 'degrees',
}
;
percentage_battery($bytes, $dev_str, \@res);
return @res;
}
# -----------------------------
sub alt_temphydro {
my $type = shift;
my $bytes = shift;
#
my $hex_line = "";
for (my $i=0;$i<=9;$i++) {
$hex_line .= sprintf("%02x",$bytes->[$i]);
}
my $device = sprintf "%02x", $bytes->[3];
my $dev_str = $type.$DOT.$device;
my @res = ();
temperature($bytes, $dev_str, \@res);
humidity($bytes, $dev_str, \@res);
percentage_battery($bytes, $dev_str, \@res);
# hexline debugging
#push @res, {
# device => $dev_str,
# type => 'hexline',
# current => $hex_line,
# units => 'hex',
# };
return @res;
}
# -----------------------------
sub alt_temphydrobaro {
my $type = shift;
my $bytes = shift;
my @res = ();
my $device = sprintf "%02x", $bytes->[3];
my $dev_str = $type.$DOT.$device;
temperature($bytes, $dev_str, \@res);
humidity($bytes, $dev_str, \@res);
pressure($bytes, $dev_str, \@res, hi_nibble($bytes->[9]), 856);
percentage_battery($bytes, $dev_str, \@res);
return @res;
}
# -----------------------------
sub rtgr328n_datetime {
my $type = shift;
my $bytes = shift;
my $device = sprintf "%02x", $bytes->[3];
my $dev_str = $type.$DOT.$device;
my $time =
(
lo_nibble($bytes->[7]).hi_nibble($bytes->[6]).
lo_nibble($bytes->[6]).hi_nibble($bytes->[5]).
lo_nibble($bytes->[5]).hi_nibble($bytes->[4])
);
my $day =
[ 'Mon', 'Tue', 'Wed',
'Thu', 'Fri', 'Sat', 'Sun' ]->[($bytes->[9]&0x7)-1];
my $date =
2000+(lo_nibble($bytes->[10]).hi_nibble($bytes->[9])).
sprintf("%02d",hi_nibble($bytes->[8])).
lo_nibble($bytes->[8]).hi_nibble($bytes->[7]);
#print STDERR "datetime: $date $time $day\n";
my @res = ();
push @res, {
datetime => $date.$time,
'date' => $date,
'time' => $time,
day => $day.'day',
device => $dev_str,
};
return @res;
}
# -----------------------------
sub common_temp {
my $type = shift;
my $bytes = shift;
my $device = sprintf "%02x", $bytes->[3];
my $dev_str = $type.$DOT.$device;
my @res = ();
temperature($bytes, $dev_str, \@res);
simple_battery($bytes, $dev_str, \@res);
return @res;
}
# -----------------------------
sub common_temphydro {
my $type = shift;
my $bytes = shift;
my $device = sprintf "%02x", $bytes->[3];
my $dev_str = $type.$DOT.$device;
my @res = ();
temperature($bytes, $dev_str, \@res);
humidity($bytes, $dev_str, \@res);
simple_battery($bytes, $dev_str, \@res);
return @res;
}
# -----------------------------
sub common_temphydrobaro {
my $type = shift;
my $bytes = shift;
my $device = sprintf "%02x", $bytes->[3];
my $dev_str = $type.$DOT.$device;
my @res = ();
temperature($bytes, $dev_str, \@res);
humidity($bytes, $dev_str, \@res);
pressure($bytes, $dev_str, \@res, lo_nibble($bytes->[9]));
simple_battery($bytes, $dev_str, \@res);
return @res;
}
# -----------------------------
sub common_rain {
my $type = shift;
my $bytes = shift;
my $device = sprintf "%02x", $bytes->[3];
my $dev_str = $type.$DOT.$device;
my @res = ();
my $rain = sprintf("%02x",$bytes->[5])*10 + hi_nibble($bytes->[4]);
my $train = lo_nibble($bytes->[8])*1000 +
sprintf("%02x", $bytes->[7])*10 + hi_nibble($bytes->[6]);
my $flip = lo_nibble($bytes->[6]);
#print STDERR "$dev_str rain = $rain, total = $train, flip = $flip\n";
push @res, {
device => $dev_str,
type => 'rain',
current => $rain,
units => 'mm/h',
} ;
push @res, {
device => $dev_str,
type => 'train',
current => $train,
units => 'mm',
};
push @res, {
device => $dev_str,
type => 'flip',
current => $flip,
units => 'flips',
};
simple_battery($bytes, $dev_str, \@res);
return @res;
}
# -----------------------------
# under development............
sub rain_PCR800 {
my $type = shift;
my $bytes = shift;
#
my $hexline = "";
for (my $i=0;$i<=10;$i++) {
$hexline .= sprintf("%02x",$bytes->[$i]);
}
my $device = sprintf "%02x", $bytes->[3];
my $dev_str = $type.$DOT.$device;
my @res = ();
my $rain = lo_nibble($bytes->[6])*10 + sprintf("%02x",$bytes->[5])/10 + hi_nibble($bytes->[4])/100;
$rain *= 25.4; # convert from inch to mm
my $train = lo_nibble($bytes->[9])*100 + sprintf("%02x",$bytes->[8]) +
sprintf("%02x",$bytes->[7])/100 + hi_nibble($bytes->[6])/1000;
$train *= 25.4; # convert from inch to mm
push @res, {
device => $dev_str,
type => 'rain',
current => $rain,
units => 'mm/h',
} ;
push @res, {
device => $dev_str,
type => 'train',
current => $train,
units => 'mm',
};
# hexline debugging
#push @res, {
# device => $dev_str,
# type => 'hexline',
# current => $hexline,
# units => 'hex',
# };
simple_battery($bytes, $dev_str, \@res);
return @res;
}
# -----------------------------
# CHECKSUM METHODS
sub checksum1 {
my $c = hi_nibble($_[0]->[6]) + (lo_nibble($_[0]->[7]) << 4);
my $s = ( ( nibble_sum(6, $_[0]) + lo_nibble($_[0]->[6]) - 0xa) & 0xff);
$s == $c;
}
sub checksum2 {
$_[0]->[8] == ((nibble_sum(8,$_[0]) - 0xa) & 0xff);
}
sub checksum3 {
$_[0]->[11] == ((nibble_sum(11,$_[0]) - 0xa) & 0xff);
}
sub checksum4 {
$_[0]->[9] == ((nibble_sum(9,$_[0]) - 0xa) & 0xff);
}
sub checksum5 {
$_[0]->[10] == ((nibble_sum(10,$_[0]) - 0xa) & 0xff);
}
sub checksum6 {
hi_nibble($_[0]->[8]) + (lo_nibble($_[0]->[9]) << 4) ==
((nibble_sum(8,$_[0]) - 0xa) & 0xff);
}
sub checksum6plus {
my $c = hi_nibble($_[0]->[8]) + (lo_nibble($_[0]->[9]) << 4);
my $s = (((nibble_sum(8,$_[0]) + (($_[0]->[8] & 0x0f) - 0x00)) - 0xa) & 0xff);
$s == $c;
}
sub checksum7 {
$_[0]->[7] == ((nibble_sum(7,$_[0]) - 0xa) & 0xff);
}
sub checksum8 {
my $c = hi_nibble($_[0]->[9]) + (lo_nibble($_[0]->[10]) << 4);
my $s = ( ( nibble_sum(9, $_[0]) - 0xa) & 0xff);
$s == $c;
}
sub raw {
$_[0]->{raw} or $_[0]->{raw} = pack 'H*', $_[0]->{hex};
}
# -----------------------------
sub
OREGON_Parse($$)
{
my ($hash, $msg) = @_;
my $time = time();
my $hexline = unpack('H*', $msg);
if ($time_old ==0) {
Log 5, "OREGON: decoding delay=0 hex=$hexline";
} else {
my $time_diff = $time - $time_old ;
Log 5, "OREGON: decoding delay=$time_diff hex=$hexline";
}
$time_old = $time;
# convert string to array of bytes. Skip length byte
my @rfxcom_data_array = ();
foreach (split(//, substr($msg,1))) {
push (@rfxcom_data_array, ord($_) );
}
my $bits = ord($msg);
my $num_bytes = $bits >> 3; if (($bits & 0x7) != 0) { $num_bytes++; }
my $type1 = $rfxcom_data_array[0];
my $type2 = $rfxcom_data_array[1];
my $type = ($type1 << 8) + $type2;
my $sensor_id = unpack('H*', chr $type1) . unpack('H*', chr $type2);
#Log 1, "OREGON: sensor_id=$sensor_id";
my $key = type_length_key($type, $bits);
my $rec = $types{$key} || $types{$key&0xfffff};
unless ($rec) {
#Log 3, "OREGON: ERROR: Unknown sensor_id=$sensor_id bits=$bits message='$hexline'.";
Log 4, "OREGON: ERROR: Unknown sensor_id=$sensor_id bits=$bits message='$hexline'.";
return "OREGON: ERROR: Unknown sensor_id=$sensor_id bits=$bits.\n";
}
# test checksum as defines in %types:
my $checksum = $rec->{checksum};
if ($checksum && !$checksum->(\@rfxcom_data_array) ) {
Log 3, "OREGON: ERROR: checksum error sensor_id=$sensor_id (bits=$bits)";
return "OREGON: ERROR: checksum error sensor_id=$sensor_id (bits=$bits)";
}
my $method = $rec->{method};
unless ($method) {
Log 4, "OREGON: Possible message from Oregon part '$rec->{part}'";
Log 4, "OREGON: sensor_id=$sensor_id (bits=$bits)";
return;
}
my @res;
if (! defined(&$method)) {
Log 4, "OREGON: Error: Unknown function=$method. Please define it in file $0";
Log 4, "OREGON: sensor_id=$sensor_id (bits=$bits)\n";
return "OREGON: Error: Unknown function=$method. Please define it in file $0";
} else {
@res = $method->($rec->{part}, \@rfxcom_data_array);
}
# get device name from first entry
my $device_name = $res[0]->{device};
#Log 1, "device_name=$device_name";
my $def = $modules{OREGON}{defptr}{"$device_name"};
if(!$def) {
Log 3, "OREGON: Unknown device $device_name, please define it";
return "UNDEFINED $device_name OREGON $device_name";
}
# Use $def->{NAME}, because the device may be renamed:
my $name = $def->{NAME};
#Log 1, "name=$new_name";
my $n = 0;
my $tm = TimeNow();
my $i;
my $val = "";
my $sensor = "";
foreach $i (@res){
#print "!> i=".$i."\n";
#printf "%s\t",$i->{device};
if ($i->{type} eq "temp") {
#printf "Temperatur %2.1f %s ; ",$i->{current},$i->{units};
$val .= "T: ".$i->{current}." ";
$sensor = "temperature";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $i->{current};
$def->{CHANGED}[$n++] = $sensor . ": " . $i->{current};
}
elsif ($i->{type} eq "humidity") {
#printf "Luftfeuchtigkeit %d%s, %s ;",$i->{current},$i->{units},$i->{string};
$val .= "H: ".$i->{current}." ";
$sensor = "humidity";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $i->{current};
$def->{CHANGED}[$n++] = $sensor . ": " . $i->{current};;
}
elsif ($i->{type} eq "battery") {
#printf "Batterie %d%s; ",$i->{current},$i->{units};
# do not add it due to problems with hms.gplot
#$val .= "Bat: ".$i->{current}." ";
$sensor = "battery";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $i->{current};
$def->{CHANGED}[$n++] = $sensor . ": " . $i->{current};;
}
elsif ($i->{type} eq "pressure") {
#printf "Luftdruck %d %s, Vorhersage=%s ; ",$i->{current},$i->{units},$i->{forecast};
# do not add it due to problems with hms.gplot
#$val .= "P: ".$i->{current}." ";
$sensor = "pressure";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $i->{current};
$def->{CHANGED}[$n++] = $sensor . ": " . $i->{current};;
$sensor = "forecast";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $i->{forecast};
$def->{CHANGED}[$n++] = $sensor . ": " . $i->{forecast};;
}
elsif ($i->{type} eq "speed") {
$val .= "W: ".$i->{current}." ";
$val .= "WA: ".$i->{average}." ";
$sensor = "wind_speed";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $i->{current};
$def->{CHANGED}[$n++] = $sensor . ": " . $i->{current};;
$sensor = "wind_avspeed";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $i->{average};
$def->{CHANGED}[$n++] = $sensor . ": " . $i->{average};;
}
elsif ($i->{type} eq "direction") {
$val .= "WD: ".$i->{current}." ";
$val .= "WDN: ".$i->{string}." ";
$sensor = "wind_dir";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $i->{current} . " " . $i->{string};
$def->{CHANGED}[$n++] = $sensor . ": " . $i->{current} . " " . $i->{string};;
}
elsif ($i->{type} eq "rain") {
$val .= "RR: ".$i->{current}." ";
$sensor = "rain_rate";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $i->{current};
$def->{CHANGED}[$n++] = $sensor . ": " . $i->{current};;
}
elsif ($i->{type} eq "train") {
$val .= "TR: ".$i->{current}." ";
$sensor = "rain_total";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $i->{current};
$def->{CHANGED}[$n++] = $sensor . ": " . $i->{current};;
}
elsif ($i->{type} eq "flip") {
#$val .= "F: ".$i->{current}." ";
$sensor = "rain_flip";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $i->{current};
$def->{CHANGED}[$n++] = $sensor . ": " . $i->{current};;
}
elsif ($i->{type} eq "uv") {
$val .= "UV: ".$i->{current}." ";
$val .= "UVR: ".$i->{risk}." ";
$sensor = "uv_val";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $i->{current};
$def->{CHANGED}[$n++] = $sensor . ": " . $i->{current};;
$sensor = "uv_risk";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $i->{risk};
$def->{CHANGED}[$n++] = $sensor . ": " . $i->{risk};;
}
elsif ($i->{type} eq "hexline") {
$sensor = "hexline";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $i->{current};
$def->{CHANGED}[$n++] = $sensor . ": " . $i->{current};;
}
else {
print "\nOREGON: Unknown: ";
print "Type: ".$i->{type}.", ";
print "Value: ".$i->{current}."\n";
}
}
if ("$val" ne "") {
# remove heading and trailing space chars from $val
$val =~ s/^\s+|\s+$//g;
$def->{STATE} = $val;
$def->{TIME} = $tm;
$def->{CHANGED}[$n++] = $val;
}
#
#$def->{READINGS}{state}{TIME} = $tm;
#$def->{READINGS}{state}{VAL} = $val;
#$def->{CHANGED}[$n++] = "state: ".$val;
DoTrigger($name, undef);
return $val;
}
1;

229
fhem/FHEM/42_RFXMETER.pm
View File

@ -1,229 +0,0 @@
#################################################################################
# 42_RFXMETER.pm
# Modul for FHEM to decode RFXMETER messages
#
# This code is derived from http://www.xpl-perl.org.uk/.
# Thanks a lot to Mark Hindess who wrote xPL.
#
# Special thanks to RFXCOM, http://www.rfxcom.com/, for their
# help. I own an USB-RFXCOM-Receiver (433.92MHz, USB, order code 80002)
# and highly recommend it.
#
# Willi Herzig, 2010
#
# 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.
#
##################################
#
# values for "set global verbose"
# 4: log unknown protocols
# 5: log decoding hexlines for debugging
#
package main;
use strict;
use warnings;
use Switch;
my $time_old = 0;
sub
RFXMETER_Initialize($)
{
my ($hash) = @_;
$hash->{Match} = "^0.*";
$hash->{DefFn} = "RFXMETER_Define";
$hash->{UndefFn} = "RFXMETER_Undef";
$hash->{ParseFn} = "RFXMETER_Parse";
$hash->{AttrList} = "IODev do_not_notify:1,0 loglevel:0,1,2,3,4,5,6";
}
#####################################
sub
RFXMETER_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $a = int(@a);
#print "a0 = $a[0]";
#return "wrong syntax: define <name> RFXMETER code " if(int(@a) != 3);
return "wrong syntax: define <name> RFXMETER code [<scalefactor>] [<unitname>]"
if(int(@a) < 3 || int(@a) > 5);
my $name = $a[0];
my $code = $a[2];
$hash->{scalefactor} = ((int(@a) > 3) ? $a[3] : 0.001);
$hash->{unitname} = ((int(@a) > 4) ? $a[4] : "kwh");
$hash->{CODE} = $code;
#$modules{RFXMETER}{defptr}{$name} = $hash;
$modules{RFXMETER}{defptr}{$code} = $hash;
AssignIoPort($hash);
return undef;
}
#####################################
sub
RFXMETER_Undef($$)
{
my ($hash, $name) = @_;
delete($modules{RFXMETER}{defptr}{$name});
return undef;
}
#my $DOT = q{.};
# Important: change it to _, because FHEM uses regexp
my $DOT = q{_};
sub parse_RFXmeter {
my $bytes = shift;
#($bytes->[0] == ($bytes->[1]^0xf0)) or return;
if ( ($bytes->[0] + ($bytes->[1]^0xf)) != 0xff) {
#Log 1, "RFXMETER: check1 failed";
return;
}
#my $device = sprintf "%02x%02x", $bytes->[0], $bytes->[1];
my $device = sprintf "%02x", $bytes->[0];
Log 4, "RFXMETER: device=$device";
my $type = hi_nibble($bytes->[5]);
#Log 1, "RFXMETER: type=$type";
my $check = lo_nibble($bytes->[5]);
#Log 1, "RFXMETER: check=$check";
my $nibble_sum = nibble_sum(5.5, $bytes);
my $parity = 0xf^($nibble_sum&0xf);
unless ($parity == $check) {
#warn "RFXMeter parity error $parity != $check\n";
return "";
}
my $time =
{ 0x01 => '30s',
0x02 => '1m',
0x04 => '5m',
0x08 => '10m',
0x10 => '15m',
0x20 => '30m',
0x40 => '45m',
0x80 => '60m',
};
my $type_str =
[
'normal data packet',
'new interval time set',
'calibrate value',
'new address set',
'counter value reset to zero',
'set 1st digit of counter value integer part',
'set 2nd digit of counter value integer part',
'set 3rd digit of counter value integer part',
'set 4th digit of counter value integer part',
'set 5th digit of counter value integer part',
'set 6th digit of counter value integer part',
'counter value set',
'set interval mode within 5 seconds',
'calibration mode within 5 seconds',
'set address mode within 5 seconds',
'identification packet',
]->[$type];
unless ($type == 0) {
warn "Unsupported rfxmeter message $type_str\n";
return "";
}
#my $kwh = ( ($bytes->[4]<<16) + ($bytes->[2]<<8) + ($bytes->[3]) ) / 100;
#Log 1, "RFXMETER: kwh=$kwh";
my $current = ($bytes->[4]<<16) + ($bytes->[2]<<8) + ($bytes->[3]) ;
Log 4, "RFXMETER: current=$current";
my $device_name = "RFXMeter".$DOT.$device;
Log 4, "device_name=$device_name";
#my $def = $modules{RFXMETER}{defptr}{"$device_name"};
my $def = $modules{RFXMETER}{defptr}{"$device"};
if(!$def) {
Log 3, "RFXMETER: Unknown device $device_name, please define it";
return "UNDEFINED $device_name RFXMETER $device";
}
# Use $def->{NAME}, because the device may be renamed:
my $name = $def->{NAME};
#Log 1, "name=$new_name";
my $n = 0;
my $tm = TimeNow();
my $val = "";
my $hash = $def;
if (defined($hash->{scalefactor})) {
$current = $current * $hash->{scalefactor};
#Log 1, "scalefactor=$hash->{scalefactor}, current=$current";
}
my $unitname = "kwh";
if (defined($hash->{unitname})) {
$unitname = $hash->{unitname};
#Log 1, "unitname=$hash->{unitname}, current=$current";
}
my $sensor = "meter";
$val .= "CNT: " . $current;
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current . " " . $unitname;
$def->{CHANGED}[$n++] = $sensor . ": " . $current . " " . $unitname;
$def->{STATE} = $val;
$def->{TIME} = $tm;
$def->{CHANGED}[$n++] = $val;
DoTrigger($name, undef);
return "";
}
sub
RFXMETER_Parse($$)
{
my ($hash, $msg) = @_;
my $time = time();
my $hexline = unpack('H*', $msg);
if ($time_old ==0) {
Log 5, "RFXMETER: decoding delay=0 hex=$hexline";
} else {
my $time_diff = $time - $time_old ;
Log 5, "RFXMETER: decoding delay=$time_diff hex=$hexline";
}
$time_old = $time;
# convert string to array of bytes. Skip length byte
my @rfxcom_data_array = ();
foreach (split(//, substr($msg,1))) {
push (@rfxcom_data_array, ord($_) );
}
my $bits = ord($msg);
my $num_bytes = $bits >> 3; if (($bits & 0x7) != 0) { $num_bytes++; }
Log 4, "RFXMETER: bits=$bits num_bytes=$num_bytes hex=$hexline";
my @res = "";
if ($bits == 48) {
@res = parse_RFXmeter(\@rfxcom_data_array);
#parse_RFXmeter(\@rfxcom_data_array);
} else {
# this should never happen as this module parses only RFXmeter messages
my $hexline = unpack('H*', $msg);
Log 1, "RFXMETER: error unknown hex=$hexline";
}
return @res;
}
1;

564
fhem/FHEM/43_RFXX10REC.pm
View File

@ -1,564 +0,0 @@
#################################################################################
# 43_RFXX10REC.pm
# Modul for FHEM for
# - X10 security messages for
# - ds10a: X10 Door / Window Sensor or compatible devices
# - ss10a: X10 motion sensor
# - sd90: Marmitek smoke detector
# - kr18: X10 remote control
# - X10 light messages for
# - ms14a: motion sensor
# - x10: generic X10 sensor
#
# 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.
#
##################################
#
# Special thanks to RFXCOM, http://www.rfxcom.com/, for their
# help. I own an USB-RFXCOM-Receiver (433.92MHz, USB, order code 80002)
# and highly recommend it.
#
##################################
#
# Some code from X10security code is derived from http://www.xpl-perl.org.uk/.
# xpl-perl/lib/xPL/RF/X10Security.pm:
# Thanks a lot to Mark Hindess who wrote xPL.
#
#SEE ALSO
# Project website: http://www.xpl-perl.org.uk/
# AUTHOR: Mark Hindess, soft-xpl-perl@temporalanomaly.com
#
#Copyright (C) 2007, 2009 by Mark Hindess
#
#This library is free software; you can redistribute it and/or modify
#it under the same terms as Perl itself, either Perl version 5.8.7 or,
#at your option, any later version of Perl 5 you may have available.
#
##################################
#
# values for "set global verbose"
# 4: log unknown protocols
# 5: log decoding hexlines for debugging
#
package main;
use strict;
use warnings;
use Switch;
# Debug this module? YES = 1, NO = 0
my $RFXX10REC_debug = 0;
my $time_old = 0;
my $RFXX10REC_type_default = "ds10a";
my $RFXX10REC_X10_type_default = "x10";
my $DOT = q{_};
sub
RFXX10REC_Initialize($)
{
my ($hash) = @_;
#$hash->{Match} = "^\\).*"; # 0x29
$hash->{Match} = "^(\\ |\\)).*"; # 0x20 or 0x29
$hash->{DefFn} = "RFXX10REC_Define";
$hash->{UndefFn} = "RFXX10REC_Undef";
$hash->{ParseFn} = "RFXX10REC_Parse";
$hash->{AttrList} = "IODev do_not_notify:1,0 loglevel:0,1,2,3,4,5,6";
#Log 1, "RFXX10REC: Initialize";
}
#####################################
sub
RFXX10REC_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $a = int(@a);
if(int(@a) != 5 && int(@a) != 7) {
Log 1,"RFXX10REC wrong syntax '@a'. \nCorrect syntax is 'define <name> RFXX10REC <type> <deviceid> <devicelog> [<deviceid2> <devicelog2>]'";
return "wrong syntax: define <name> RFXX10REC <type> <deviceid> <devicelog> [<deviceid2> <devicelog2>]";
}
my $name = $a[0];
my $type = lc($a[2]);
my $deviceid = $a[3];
my $devicelog = $a[4];
my $device_name = "RFXX10REC".$DOT.$deviceid;
if ($type ne "ds10a" && $type ne "sd90" && $type ne "x10" && $type ne "ms10a" && $type ne "ms14a" && $type ne "kr18") {
Log 1,"RFX10SEC define: wrong type: $type";
return "RFX10SEC: wrong type: $type";
}
$hash->{RFXX10REC_deviceid} = $deviceid;
$hash->{RFXX10REC_devicelog} = $devicelog;
$hash->{RFXX10REC_type} = $type;
#$hash->{RFXX10REC_CODE} = $deviceid;
$modules{RFXX10REC}{defptr}{$device_name} = $hash;
if (int(@a) == 7) {
# there is a second deviceid:
#
my $deviceid2 = $a[5];
my $devicelog2 = $a[6];
my $device_name2 = "RFXX10REC".$DOT.$deviceid2;
$hash->{RFXX10REC_deviceid2} = $deviceid2;
$hash->{RFXX10REC_devicelog2} = $devicelog2;
#$hash->{RFXX10REC_CODE2} = $deviceid2;
$modules{RFXX10REC}{defptr2}{$device_name2} = $hash;
}
AssignIoPort($hash);
return undef;
}
#####################################
sub
RFXX10REC_Undef($$)
{
my ($hash, $name) = @_;
delete($modules{RFXX10REC}{defptr}{$name});
return undef;
}
#####################################
sub RFXX10REC_parse_X10 {
my $bytes = shift;
# checksum test
(($bytes->[0]^0xff) == $bytes->[1] && ($bytes->[2]^0xff) == $bytes->[3])
or return "";
#RFXX10REC_reverse_bits($bytes);
my %x10_devname =
(
0x60 => "A",
0x70 => "B",
0x40 => "C",
0x50 => "D",
0x80 => "E",
0x90 => "F",
0xA0 => "G",
0xB0 => "H",
0xE0 => "I",
0xF0 => "J",
0xC0 => "K",
0xD0 => "L",
0x00 => "M",
0x10 => "N",
0x20 => "O",
0x30 => "P",
);
my $dev_first = "?";
my $devnr = $bytes->[0] & 0xf0;
if (exists $x10_devname{$devnr}) {
$dev_first = $x10_devname{$devnr};
}
my $unit_bit0 = ($bytes->[2] & 0x10) ? 1 : 0;
my $unit_bit1 = ($bytes->[2] & 0x08) ? 1 : 0;
my $unit_bit2 = ($bytes->[2] & 0x40) ? 1 : 0;
my $unit_bit3 = ($bytes->[0] & 0x04) ? 1 : 0;
my $unit = $unit_bit0 * 1 + $unit_bit1 * 2 + $unit_bit2 * 4 +$unit_bit3 * 8 + 1;
my $device = sprintf '%s%0d', $dev_first, $unit;
my $data = $bytes->[2];
my $hexdata = sprintf '%02x', $bytes->[2];
my $error;
if ($data == 0x98) {
$error = "RFXX10REC: X10 command 'Dim' not implemented, device=".$dev_first;
Log 1,$error;
return $error;
} elsif ($data == 0x88) {
$error = "RFXX10REC: X10 command 'Bright' not implemented, device=".$dev_first;
Log 1,$error;
return $error;
} elsif ($data == 0x90) {
$error = "RFXX10REC: X10 command 'All Lights on' not implemented, device=".$dev_first;
Log 1,$error;
return $error;
} elsif ($data == 0x80) {
$error = "RFXX10REC: X10 command 'All Lights off' not implemented, device=".$dev_first;
Log 1,$error;
return $error;
}
my $command;
if ($data & 0x20) {
$command = "off";
} else {
$command = "on";
}
my @res;
my $current = "";
#--------------
my $device_name = "RFXX10REC".$DOT.$device;
#Log 1, "RFXX10REC: device_name=$device_name command=$command" if ($RFXX10REC_debug == 1);
my $firstdevice = 1;
my $def = $modules{RFXX10REC}{defptr}{$device_name};
if(!$def) {
#Log 1, "-1- not device_name=$device_name";
$firstdevice = 0;
$def = $modules{RFXX10REC}{defptr2}{$device_name};
if (!$def) {
#Log 1, "-2- not device_name=$device_name";
Log 3, "RFXX10REC: RFXX10REC Unknown device $device_name, please define it";
return "UNDEFINED $device_name RFXX10REC $RFXX10REC_X10_type_default $device Unknown";
}
}
# Use $def->{NAME}, because the device may be renamed:
my $name = $def->{NAME};
Log 1, "RFXX10REC: $name devn=$device_name first=$firstdevice type=$command, cmd=$hexdata" if ($RFXX10REC_debug == 1);
my $n = 0;
my $tm = TimeNow();
my $val = "";
my $device_type = $def->{RFXX10REC_type};
#Log 1,"device_name=$device_name name=$name, type=$type";
my $sensor = "";
if ($device_type eq "ms14a") {
# for ms14a behave like x11, but flip second deviceid
$device_type = "x10";
if ($firstdevice == 1) {
$command = ($command eq "on") ? "alert" : "normal" ;
} else {
$command = ($command eq "on") ? "off" : "on" ;
}
}
if ($device_type eq "x10") {
$current = $command;
$sensor = $firstdevice == 1 ? $def->{RFXX10REC_devicelog} : $def->{RFXX10REC_devicelog2};
$val .= $current;
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current;
$def->{CHANGED}[$n++] = $sensor . ": " . $current;
} else {
Log 1, "RFXX10REC: X10 error unknown sensor type=$device_type $name devn=$device_name first=$firstdevice type=$command, user=$device (hex $hexdata)";
return "RFXX10REC X10 error unknown sensor type=$device_type for $device_name device=$device";
}
if (($firstdevice == 1) && $val) {
$def->{STATE} = $val;
$def->{TIME} = $tm;
$def->{CHANGED}[$n++] = $val;
}
DoTrigger($name, undef);
return "";
}
#####################################
sub RFXX10REC_parse_X10Sec {
my $bytes = shift;
# checksum test
(($bytes->[0]^0x0f) == $bytes->[1] && ($bytes->[2]^0xff) == $bytes->[3])
or return "";
#RFXX10REC_reverse_bits($bytes);
#my $device = sprintf 'x10sec%02x', $bytes->[0];
my $device = sprintf '%02x%02x', $bytes->[4], $bytes->[0];
#Log 1, "X10Sec device-nr=$device";
my $short_device = $bytes->[0];
my $data = $bytes->[2];
my $hexdata = sprintf '%02x', $bytes->[2];
#Log 1, "X10Sec data=$hexdata";
my %x10_security =
(
0x00 => ['X10Sec', 'alert', 'max_delay', 'batt_ok'],
0x01 => ['X10Sec', 'alert', 'max_delay', 'batt_low'],
0x04 => ['X10Sec', 'alert', 'min_delay', 'batt_ok'],
0x05 => ['X10Sec', 'alert', 'min_delay', 'batt_low'],
0x80 => ['X10Sec', 'normal', 'max_delay', 'batt_ok'],
0x81 => ['X10Sec', 'normal', 'max_delay', 'batt_low'],
0x84 => ['X10Sec', 'normal', 'min_delay', 'batt_ok'],
0x85 => ['X10Sec', 'normal', 'min_delay', 'batt_low'],
0x26 => ['X10Sec', 'alert', '', ''],
#
0x0c => ['X10Sec', 'alert', '', 'batt_ok'], # MS10a
0x0d => ['X10Sec', 'alert', '', 'batt_low'], # MS10a
0x8c => ['X10Sec', 'normal', '', 'batt_ok'], # MS10a
0x8d => ['X10Sec', 'normal', '', 'batt_low'], # MS10a
#
0x06 => ['X10Sec', 'Security-Arm', '', ''], # kr18
0x86 => ['X10Sec', 'Security-Disarm', '', ''], # kr18
0x42 => ['X10Sec', 'ButtonA-on', '', ''], # kr18
0xc2 => ['X10Sec', 'ButtonA-off', '', ''], # kr18
0x46 => ['X10Sec', 'ButtonB-on', '', ''], # kr18
0xc6 => ['X10Sec', 'ButtonB-off', '', ''], # kr18
);
my $command = "";
my $type = "";
my $delay = "";
my $battery = "";
my @res;
my %args;
if (exists $x10_security{$data}) {
my $rec = $x10_security{$data};
if (ref $rec) {
($type, $command, $delay, $battery) = @$rec;
} else {
$command = $rec;
}
} else {
Log 1, "RFXX10REC undefined command cmd=$data device-nr=$device, hex=$hexdata";
return "RFXX10REC undefined command";
}
my $current = "";
#--------------
my $device_name = "RFXX10REC".$DOT.$device;
#Log 1, "device_name=$device_name";
Log 4, "device_name=$device_name";
my $firstdevice = 1;
my $def = $modules{RFXX10REC}{defptr}{$device_name};
if(!$def) {
#Log 1, "-1- not device_name=$device_name";
$firstdevice = 0;
$def = $modules{RFXX10REC}{defptr2}{$device_name};
if (!$def) {
#Log 1, "-2- not device_name=$device_name";
Log 3, "RFXX10REC: RFXX10REC Unknown device $device_name, please define it";
return "UNDEFINED $device_name RFXX10REC $RFXX10REC_type_default $device Window";
}
}
# Use $def->{NAME}, because the device may be renamed:
my $name = $def->{NAME};
#Log 1, "name=$new_name";
Log 1, "RFXX10REC: $name devn=$device_name first=$firstdevice type=$command, delay=$delay, batt=$battery cmd=$hexdata" if ($RFXX10REC_debug == 1);
my $n = 0;
my $tm = TimeNow();
my $val = "";
my $device_type = $def->{RFXX10REC_type};
#Log 1,"device_name=$device_name name=$name, type=$type";
my $sensor = "";
if ($device_type eq "ds10a") {
$current = "Error";
$current = "Open" if ($command eq "alert");
$current = "Closed" if ($command eq "normal");
$sensor = $def->{RFXX10REC_devicelog};
$val .= $current;
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current;
$def->{CHANGED}[$n++] = $sensor . ": " . $current;
if (($def->{STATE} ne $val)) {
$sensor = "statechange";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current;
$def->{CHANGED}[$n++] = $sensor . ": " . $current;
}
if ($battery ne '') {
$sensor = "battery";
$current = "Error";
$current = "ok" if ($battery eq "batt_ok");
$current = "low" if ($battery eq "batt_low");
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current;
$def->{CHANGED}[$n++] = $sensor . ": " . $current;
}
if ($delay ne '') {
$sensor = "delay";
$current = "Error";
$current = "min" if ($delay eq "min_delay");
$current = "max" if ($delay eq "max_delay");
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current;
$def->{CHANGED}[$n++] = $sensor . ": " . $current;
}
} elsif ($device_type eq "sd90") {
$sensor = $firstdevice == 1 ? $def->{RFXX10REC_devicelog} : $def->{RFXX10REC_devicelog2};
$current = $command;
if ($firstdevice == 1) {
$val .= $current;
}
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current;
$def->{CHANGED}[$n++] = $sensor . ": " . $current;
if ($battery) {
$sensor = "battery";
$current = "Error";
$current = "ok" if ($battery eq "batt_ok");
$current = "low" if ($battery eq "bat_low");
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current;
$def->{CHANGED}[$n++] = $sensor . ": " . $current;
}
# sd90 does not have a delay switch
if (0 && $delay) {
$sensor = "delay";
$current = "Error";
$current = "min" if ($delay eq "min_delay");
$current = "max" if ($delay eq "max_delay");
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current;
$def->{CHANGED}[$n++] = $sensor . ": " . $current;
}
} elsif ($device_type eq "ms10a") {
$current = $command;
$sensor = $def->{RFXX10REC_devicelog};
$val .= $current;
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current;
$def->{CHANGED}[$n++] = $sensor . ": " . $current;
if (($def->{STATE} ne $val)) {
$sensor = "statechange";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current;
$def->{CHANGED}[$n++] = $sensor . ": " . $current;
}
if ($battery ne '') {
$sensor = "battery";
$current = "Error";
$current = "ok" if ($battery eq "batt_ok");
$current = "low" if ($battery eq "batt_low");
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current;
$def->{CHANGED}[$n++] = $sensor . ": " . $current;
}
} elsif ($device_type eq "kr18") {
$current = $command;
#$sensor = $def->{RFXX10REC_devicelog};
$val = $current;
#$def->{READINGS}{$sensor}{TIME} = $tm;
#$def->{READINGS}{$sensor}{VAL} = $current;
#$def->{CHANGED}[$n++] = $sensor . ": " . $current;
my @cmd_split = split(/-/, $command);
$sensor = $cmd_split[0];
$current = $cmd_split[1];
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current;
$def->{CHANGED}[$n++] = $sensor . ": " . $current;
} else {
Log 1, "RFXX10REC: error unknown sensor type=$device_type $name devn=$device_name first=$firstdevice type=$command, user=$device, delay=$delay, batt=$battery (hex $hexdata)";
return "RFXX10REC error unknown sensor type=$device_type for $device_name device=$device";
}
if (($firstdevice == 1) && $val) {
$def->{STATE} = $val;
$def->{TIME} = $tm;
$def->{CHANGED}[$n++] = $val;
}
DoTrigger($name, undef);
return "";
}
sub
RFXX10REC_Parse($$)
{
my ($hash, $msg) = @_;
my $time = time();
my $hexline = unpack('H*', $msg);
if ($time_old ==0) {
Log 5, "RFXX10REC: decoding delay=0 hex=$hexline";
} else {
my $time_diff = $time - $time_old ;
Log 5, "RFXX10REC: decoding delay=$time_diff hex=$hexline";
}
$time_old = $time;
# convert string to array of bytes. Skip length byte
my @rfxcom_data_array = ();
foreach (split(//, substr($msg,1))) {
push (@rfxcom_data_array, ord($_) );
}
my $bits = ord($msg);
my $num_bytes = $bits >> 3; if (($bits & 0x7) != 0) { $num_bytes++; }
my $res = "";
if ($bits == 41) {
Log 1, "RFXX10REC: bits=$bits num_bytes=$num_bytes hex=$hexline" if ($RFXX10REC_debug == 1);
$res = RFXX10REC_parse_X10Sec(\@rfxcom_data_array);
Log 1, "RFXX10REC: unsupported hex=$hexline" if ($res ne "" && $res !~ /^UNDEFINED.*/);
return $res;
} elsif ($bits == 32) {
Log 1, "RFXX10REC: bits=$bits num_bytes=$num_bytes hex=$hexline" if ($RFXX10REC_debug == 1);
$res = RFXX10REC_parse_X10(\@rfxcom_data_array);
Log 1, "RFXX10REC: unsupported hex=$hexline" if ($res ne "" && $res !~ /^UNDEFINED.*/);
return $res;
} else {
Log 0, "RFXX10REC: bits=$bits num_bytes=$num_bytes hex=$hexline";
}
return "";
}
1;

99
fhem/FHEM/44_RFXELSE.pm
View File

@ -1,99 +0,0 @@
#################################################################################
# 44_RFXELSE.pm
# Modul for FHEM for unkown RFXCOM messages
#
# 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.
#
##################################
#
# values for "set global verbose"
# 4: log unknown protocols
# 5: log decoding hexlines for debugging
#
package main;
use strict;
use warnings;
use Switch;
my $time_old = 0;
sub
RFXELSE_Initialize($)
{
my ($hash) = @_;
$hash->{Match} = "^.*";
$hash->{DefFn} = "RFXELSE_Define";
$hash->{UndefFn} = "RFXELSE_Undef";
$hash->{ParseFn} = "RFXELSE_Parse";
$hash->{AttrList} = "IODev do_not_notify:1,0 loglevel:0,1,2,3,4,5,6";
Log 1, "RFXELSE: Initialize";
}
#####################################
sub
RFXELSE_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $a = int(@a);
#print "a0 = $a[0]";
return "wrong syntax: define <name> RFXELSE code" if(int(@a) != 3);
my $name = $a[0];
my $code = $a[2];
$hash->{CODE} = $code;
#$modules{RFXELSE}{defptr}{$name} = $hash;
$modules{RFXELSE}{defptr}{$code} = $hash;
AssignIoPort($hash);
return undef;
}
#####################################
sub
RFXELSE_Undef($$)
{
my ($hash, $name) = @_;
delete($modules{RFXELSE}{defptr}{$name});
return undef;
}
my $DOT = q{_};
sub
RFXELSE_Parse($$)
{
my ($hash, $msg) = @_;
my $time = time();
my $hexline = unpack('H*', $msg);
if ($time_old ==0) {
Log 5, "RFXELSE: decoding delay=0 hex=$hexline";
} else {
my $time_diff = $time - $time_old ;
Log 5, "RFXELSE: decoding delay=$time_diff hex=$hexline";
}
$time_old = $time;
# convert string to array of bytes. Skip length byte
my @rfxcom_data_array = ();
foreach (split(//, substr($msg,1))) {
push (@rfxcom_data_array, ord($_) );
}
my $bits = ord($msg);
my $num_bytes = $bits >> 3; if (($bits & 0x7) != 0) { $num_bytes++; }
Log 0, "RFXELSE: bits=$bits num_bytes=$num_bytes hex=$hexline";
return "Test";
}
1;

673
fhem/FHEM/50_WS300.pm
View File

@ -1,673 +0,0 @@
################################################################
#
# Copyright notice
#
# (c) 2007 Copyright: Martin Klerx (Martin at klerx 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!
#
################################################################
# examples:
# define WS300Device WS300 /dev/ttyUSB1 (fixed name, must be first)
# define ash2200-1 WS300 0
# define ash2200-2 WS300 1
# ...
# define ash2200-8 WS300 7
# define ks300 WS300 8 (always 8)
# define ws300 WS300 9 (always 9)
# set WS300Device <interval(5-60 min.)> <height(0-2000 m)> <rainvalume(ml)>
################################################################
package main;
use strict;
use warnings;
my $DeviceName="";
my $inbuf="";
my $config;
my $cmd=0x32;
my $errcount=0;
my $ir="no";
my $willi=0;
my $oldwind=0.0;
my $polling=0;
my $acthour=99;
my $actday=99;
my $actmonth=99;
my $oldrain=0;
my $rain_hour=0;
my $rain_day=0;
my $rain_month=0;
#####################################
sub
WS300_Initialize($)
{
my ($hash) = @_;
# Provider
$hash->{AttrList} = "do_not_notify:0,1 showtime:0,1 model:ws300 loglevel:0,1,2,3,4,5,6";
$hash->{DefFn} = "WS300_Define";
$hash->{GetFn} = "WS300_Get";
$hash->{ParseFn} = "WS300_Parse";
$hash->{SetFn} = "WS300_Set";
$hash->{UndefFn} = "WS300_Undef";
$hash->{Clients} = ":WS300:"; # Not needed
$hash->{Match} = "^WS300.*"; # Not needed
$hash->{ReadFn} = "WS300_Read"; # Not needed
$hash->{Type} = "FHZ1000"; # Not needed
$hash->{WriteFn} = "WS300_Write"; # Not needed
}
###################################
sub
WS300_Set($@)
{
my ($hash, @a) = @_;
if($hash->{NAME} eq "WS300Device")
{
return "wrong syntax: set WS300Device <Interval(5-60 min.)> <height(0-2000 m)> <rainvolume(ml)>" if(int(@a) < 4 || int($a[1]) < 5 || int($a[1]) > 60 || int($a[2]) > 2000);
my $bstring = sprintf("%c%c%c%c%c%c%c%c",0xfe,0x30,(int($a[1])&0xff),((int($a[2])>>8)&0xff),(int($a[2])&0xff),((int($a[3])>>8)&0xff),(int($a[3])&0xff),0xfc);
$hash->{PortObj}->write($bstring);
Log 1,"WS300 synchronization started (".unpack('H*',$bstring).")";
return "the ws300pc will now synchronize for 10 minutes";
}
return "No set function implemented";
}
###################################
sub
WS300_Get(@)
{
my ($hash, @a) = @_;
if($hash->{NAME} eq "WS300Device")
{
Log 5,"WS300_Get $a[0] $a[1]";
WS300_Poll($hash);
return undef;
}
return "No get function implemented";
}
#####################################
sub
WS300_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $po;
if($a[0] eq "WS300Device")
{
$modules{WS300}{defptr}{10} = $hash;
return "wrong syntax: define WS300Device WS300 <DeviceName>" if(int(@a) < 3);
$DeviceName = $a[2];
$hash->{STATE} = "Initializing";
$hash->{SENSOR} = 10;
$hash->{READINGS}{WS300Device}{VAL} = "Initializing";
$hash->{READINGS}{WS300Device}{TIME} = TimeNow;
if ($^O=~/Win/) {
eval ("use Win32::SerialPort;");
$po = new Win32::SerialPort ($DeviceName);
}else{
eval ("use Device::SerialPort;");
$po = new Device::SerialPort ($DeviceName);
}
if(!$po)
{
$hash->{STATE} = "error opening device";
$hash->{READINGS}{WS300Device}{VAL} = "error opening device";
$hash->{READINGS}{WS300Device}{TIME} = TimeNow;
Log 1,"Error opening WS300 Device $a[2]";
return "Can't open $a[2]: $!\n";
}
$po->reset_error();
$po->baudrate(19200);
$po->databits(8);
$po->parity('even');
$po->stopbits(1);
$po->handshake('none');
$po->rts_active(1);
$po->dtr_active(1);
sleep(1);
$po->rts_active(0);
$po->write_settings;
$hash->{PortObj} = $po;
$hash->{DeviceName} = $a[2];
$hash->{STATE} = "opened";
$hash->{READINGS}{WS300Device}{VAL} = "opened";
$hash->{READINGS}{WS300Device}{TIME} = TimeNow;
CommandDefine(undef,"WS300Device_timer at +*00:00:05 get WS300Device data");
Log 1,"WS300 Device $a[2] opened";
return undef;
}
return "wrong syntax: define <name> WS300 <sensor (0-9)>\n0-7=ASH2200\n8=KS300\n9=WS300" if(int(@a) < 3);
return "no device: define WS300Device WS300 <DeviceName> first" if($DeviceName eq "");
return "Define $a[0]: wrong sensor number." if($a[2] !~ m/^[0-9]$/);
$hash->{SENSOR} = $a[2];
$modules{WS300}{defptr}{$a[2]} = $hash;
return undef;
}
#####################################
sub
WS300_Undef($$)
{
my ($hash, $name) = @_;
return undef if(!defined($hash->{SENSOR}));
delete($modules{WS300}{defptr}{$hash->{SENSOR}});
return undef;
}
#####################################
sub
WS300_Parse($$)
{
my ($hash, $msg) = @_;
my $ll = GetLogLevel("WS300Device");
$ll = 5 if($ll == 2);
my @c = split("", $config);
my @cmsg = split("",unpack('H*',$config));
my $dmsg = unpack('H*',$msg);
my @a = split("", $dmsg);
my $val = "";
my $tm;
my $h;
my $t;
my $b;
my $l;
my $value;
my $offs=0;
my $ref;
my $def;
my $zeit;
my @txt = ( "temperature", "humidity", "wind", "rain_raw", "israining", "battery", "lost_receives", "pressure", "rain_cum", "rain_hour", "rain_day", "rain_month");
my @sfx = ( "(Celsius)", "(%)", "(km/h)", "(counter)", "(yes/no)", " ", "(counter)", "(hPa)", "(mm)", "(mm)", "(mm)", "(mm)");
# 1 2 3 4 5 6 7 8
# 012345678901234567890123456789012345678901234567890123456789012345678901234567890123456789
# 3180800001005d4e00000000000000000000000000000000000000000000594a0634001e00f62403f1fc stored
# aaaatttthhtttthhtttthhtttthhtttthhtttthhtttthhtttthhtttthhrrrrwwwwtttthhpppp
# 3300544a0000000000000000000000000000000000000000000057470634002c00f32303ee32fc current
# tttthhtttthhtttthhtttthhtttthhtttthhtttthhtttthhtttthhrrrrwwwwtttthhppppss
# 3210000000000000001005003a0127fc config
# 001122334455667788iihhhhmmmm
$offs = 2 if(hex($a[0].$a[1]) == 0x33);
$offs = 10 if(hex($a[0].$a[1]) == 0x31);
if($offs == 0)
{
Log 1,"WS300 illegal data in WS300_Parse";
return undef;
}
$zeit = time;
my $wind = hex($a[58+$offs].$a[59+$offs].$a[60+$offs].$a[61+$offs]);
$wind /= 10.0;
if(hex($a[0].$a[1]) == 0x33)
{
return undef if(hex($a[74].$a[75]) == $willi && $wind == $oldwind );
$willi = hex($a[74].$a[75]);
$ir="no";
$ir="yes" if(($willi&0x80));
}
else
{
$zeit -= (hex($a[6].$a[7].$a[8].$a[9])*60);
}
my @lt = localtime($zeit);
$tm = sprintf("%04d-%02d-%02d %02d:%02d:%02d",$lt[5]+1900, $lt[4]+1, $lt[3], $lt[2], $lt[1], $lt[0]);
$oldwind = $wind;
my $press = hex($a[68+$offs].$a[69+$offs].$a[70+$offs].$a[71+$offs]);
my $hpress = hex($cmsg[22].$cmsg[23].$cmsg[24].$cmsg[25]);
$hpress /= 8.5;
$press += $hpress;
$press = sprintf("%.1f",$press);
my $rainc = hex($a[54+$offs].$a[55+$offs].$a[56+$offs].$a[57+$offs]);
my $rain = hex($cmsg[26].$cmsg[27].$cmsg[28].$cmsg[29]);
$rain *= $rainc;
$rain /= 1000;
$rain = sprintf("%.1f",$rain);
for(my $s=0;$s<9;$s++)
{
if((ord($c[$s+1])&0x10))
{
my $p=($s*6)+$offs;
Log $ll,"Sensor $s vorhanden";
if(!defined($modules{WS300}{defptr}{$s}))
{
Log 3, "WS300 Unknown device $s, please define it";
return "UNDEFINED WS300_$s WS300 $s";
}
else
{
$def = $modules{WS300}{defptr}{$s};
$def->{READINGS}{$txt[0]}{VAL} = 0 if(!$def->{READINGS});
$ref = $def->{READINGS};
$t = hex($a[$p].$a[$p+1].$a[$p+2].$a[$p+3]);
$t -= 65535 if( $t > 32767 );
$t /= 10.0;
$h = hex($a[$p+4].$a[$p+5]);
if((ord($c[$s+1])&0xe0))
{
$b = "Empty"
}
else
{
$b = "Ok"
}
$l = (ord($c[$s+1])&0x0f);
if($s < 8)
{
# state
$val = "T: $t H: $h Bat: $b LR: $l";
$def->{STATE} = $val;
$def->{CHANGED}[0] = $val;
$def->{CHANGETIME}[0] = $tm;
# temperatur
$ref->{$txt[0]}{TIME} = $tm;
$value = "$t $sfx[0]";
$ref->{$txt[0]}{VAL} = $value;
$def->{CHANGED}[1] = "$txt[0]: $value";
$def->{CHANGETIME}[1] = $tm;
# humidity
$ref->{$txt[1]}{TIME} = $tm;
$value = "$h $sfx[1]";
$ref->{$txt[1]}{VAL} = $value;
$def->{CHANGED}[2] = "$txt[1]: $value";
$def->{CHANGETIME}[2] = $tm;
# battery
$ref->{$txt[5]}{TIME} = $tm;
$value = "$b $sfx[5]";
$ref->{$txt[5]}{VAL} = $value;
$def->{CHANGED}[3] = "$txt[5]: $value";
$def->{CHANGETIME}[3] = $tm;
# lost receives
$ref->{$txt[6]}{TIME} = $tm;
$value = "$l $sfx[6]";
$ref->{$txt[6]}{VAL} = $value;
$def->{CHANGED}[4] = "$txt[6]: $value";
$def->{CHANGETIME}[4] = $tm;
Log $ll,"WS300 $def->{NAME}: $val";
DoTrigger($def->{NAME},undef);
}
else
{
# state
$val = "T: $t H: $h W: $wind R: $rain IR: $ir Bat: $b LR: $l";
$def->{STATE} = $val;
$def->{CHANGED}[0] = $val;
$def->{CHANGETIME}[0] = $tm;
# temperature
$ref->{$txt[0]}{TIME} = $tm;
$value = "$t $sfx[0]";
$ref->{$txt[0]}{VAL} = $value;
$def->{CHANGED}[1] = "$txt[0]: $value";
$def->{CHANGETIME}[1] = $tm;
# humidity
$ref->{$txt[1]}{TIME} = $tm;
$value = "$h $sfx[1]";
$ref->{$txt[1]}{VAL} = $value;
$def->{CHANGED}[2] = "$txt[1]: $value";
$def->{CHANGETIME}[2] = $tm;
# wind
$ref->{$txt[2]}{TIME} = $tm;
$value = "$wind $sfx[2]";
$ref->{$txt[2]}{VAL} = $value;
$def->{CHANGED}[3] = "$txt[2]: $value";
$def->{CHANGETIME}[3] = $tm;
#rain counter
$ref->{$txt[3]}{TIME} = $tm;
$value = "$rainc $sfx[3]";
$ref->{$txt[3]}{VAL} = $value;
$def->{CHANGED}[4] = "$txt[3]: $value";
$def->{CHANGETIME}[4] = $tm;
# is raining
$ref->{$txt[4]}{TIME} = $tm;
$value = "$ir $sfx[4]";
$ref->{$txt[4]}{VAL} = $value;
$def->{CHANGED}[5] = "$txt[4]: $value";
$def->{CHANGETIME}[5] = $tm;
# battery
$ref->{$txt[5]}{TIME} = $tm;
$value = "$b $sfx[5]";
$ref->{$txt[5]}{VAL} = $value;
$def->{CHANGED}[6] = "$txt[5]: $value";
$def->{CHANGETIME}[6] = $tm;
# lost receives
$ref->{$txt[6]}{TIME} = $tm;
$value = "$l $sfx[6]";
$ref->{$txt[6]}{VAL} = $value;
$def->{CHANGED}[7] = "$txt[6]: $value";
$def->{CHANGETIME}[7] = $tm;
# rain cumulative
$ref->{$txt[8]}{TIME} = $tm;
$value = "$rain $sfx[8]";
$ref->{$txt[8]}{VAL} = $value;
$def->{CHANGED}[8] = "$txt[8]: $value";
$def->{CHANGETIME}[8] = $tm;
# statistics
if($actday == 99)
{
$oldrain = $rain;
$acthour = $ref->{acthour}{VAL} if(defined($ref->{acthour}{VAL}));
$actday = $ref->{actday}{VAL} if(defined($ref->{actday}{VAL}));
$actmonth = $ref->{actmonth}{VAL} if(defined($ref->{actmonth}{VAL}));
$rain_day = $ref->{rain_day}{VAL} if(defined($ref->{rain_day}{VAL}));
$rain_month = $ref->{rain_month}{VAL} if(defined($ref->{rain_month}{VAL}));
$rain_hour = $ref->{rain_hour}{VAL} if(defined($ref->{rain_hour}{VAL}));
}
if($acthour != $lt[2])
{
$acthour = $lt[2];
$rain_hour = sprintf("%.1f",$rain_hour);
$rain_day = sprintf("%.1f",$rain_day);
$rain_month = sprintf("%.1f",$rain_month);
$ref->{acthour}{TIME} = $tm;
$ref->{acthour}{VAL} = "$acthour";
$ref->{$txt[9]}{TIME} = $tm;
$ref->{$txt[9]}{VAL} = $rain_hour;
$def->{CHANGED}[9] = "$txt[9]: $rain_hour $sfx[9]";
$def->{CHANGETIME}[9] = $tm;
$ref->{$txt[10]}{TIME} = $tm;
$ref->{$txt[10]}{VAL} = $rain_day;
$def->{CHANGED}[10] = "$txt[10]: $rain_day $sfx[10]";
$def->{CHANGETIME}[10] = $tm;
$ref->{$txt[11]}{TIME} = $tm;
$ref->{$txt[11]}{VAL} = $rain_month;
$def->{CHANGED}[11] = "$txt[11]: $rain_month $sfx[11]";
$def->{CHANGETIME}[11] = $tm;
$rain_hour=0;
}
if($actday != $lt[3])
{
$actday = $lt[3];
$ref->{actday}{TIME} = $tm;
$ref->{actday}{VAL} = "$actday";
$rain_day=0;
}
if($actmonth != $lt[4]+1)
{
$actmonth = $lt[4]+1;
$ref->{actmonth}{TIME} = $tm;
$ref->{actmonth}{VAL} = "$actmonth";
$rain_month=0;
}
if($rain != $oldrain)
{
$rain_hour += ($rain-$oldrain);
$rain_hour = sprintf("%.1f",$rain_hour);
$rain_day += ($rain-$oldrain);
$rain_day = sprintf("%.1f",$rain_day);
$rain_month += ($rain-$oldrain);
$rain_month = sprintf("%.1f",$rain_month);
$oldrain = $rain;
$ref->{acthour}{TIME} = $tm;
$ref->{acthour}{VAL} = "$acthour";
$ref->{$txt[9]}{TIME} = $tm;
$ref->{$txt[9]}{VAL} = $rain_hour;
$def->{CHANGED}[9] = "$txt[9]: $rain_hour $sfx[9]";
$def->{CHANGETIME}[9] = $tm;
$ref->{$txt[10]}{TIME} = $tm;
$ref->{$txt[10]}{VAL} = $rain_day;
$def->{CHANGED}[10] = "$txt[10]: $rain_day $sfx[10]";
$def->{CHANGETIME}[10] = $tm;
$ref->{$txt[11]}{TIME} = $tm;
$ref->{$txt[11]}{VAL} = $rain_month;
$def->{CHANGED}[11] = "$txt[11]: $rain_month $sfx[11]";
$def->{CHANGETIME}[11] = $tm;
}
Log $ll,"WS300 $def->{NAME}: $val";
DoTrigger($def->{NAME},undef);
}
}
}
}
if(!defined($modules{WS300}{defptr}{9}))
{
Log 3, "WS300 Unknown device 9, please define it";
return "UNDEFINED WS300_9 WS300 9";
}
else
{
$def = $modules{WS300}{defptr}{9};
$def->{READINGS}{$txt[0]}{VAL} = 0 if(!$def->{READINGS});
$ref = $def->{READINGS};
$t = hex($a[62+$offs].$a[63+$offs].$a[64+$offs].$a[65+$offs]);
$t -= 65535 if( $t > 32767 );
$t /= 10.0;
$h = hex($a[66+$offs].$a[67+$offs]);
# state
$val = "T: $t H: $h P: $press Willi: $willi";
$def->{STATE} = $val;
$def->{CHANGED}[0] = $val;
$def->{CHANGETIME}[0] = $tm;
# temperature
$ref->{$txt[0]}{TIME} = $tm;
$value = "$t $sfx[0]";
$ref->{$txt[0]}{VAL} = $value;
$def->{CHANGED}[1] = "$txt[0]: $value";
$def->{CHANGETIME}[1] = $tm;
# humidity
$ref->{$txt[1]}{TIME} = $tm;
$value = "$h $sfx[1]";
$ref->{$txt[1]}{VAL} = $value;
$def->{CHANGED}[2] = "$txt[1]: $value";
$def->{CHANGETIME}[2] = $tm;
# pressure
$ref->{$txt[7]}{TIME} = $tm;
$value = "$press $sfx[7]";
$ref->{$txt[7]}{VAL} = $value;
$def->{CHANGED}[3] = "$txt[7]: $value";
$def->{CHANGETIME}[3] = $tm;
# willi
$ref->{willi}{TIME} = $tm;
$value = "$willi";
$ref->{willi}{VAL} = $value;
$def->{CHANGED}[4] = "willi: $value";
$def->{CHANGETIME}[4] = $tm;
Log $ll,"WS300 $def->{NAME}: $val";
DoTrigger($def->{NAME},undef);
}
return undef;
}
#####################################
sub
WS300_Read($)
{
my ($hash) = @_;
}
#####################################
sub
WS300_Write($$$)
{
my ($hash,$fn,$msg) = @_;
}
#####################################
sub
WS300_Poll($)
{
my $hash = shift;
my $bstring=" ";
my $count;
my $po;
my $inchar='';
my $escape=0;
my $ll = GetLogLevel("WS300Device");
$ll = 5 if($ll == 2);
if(!$hash || !defined($hash->{PortObj}))
{
return;
}
return if($polling);
$polling=1;
NEXTPOLL:
$inbuf = $hash->{PortObj}->input();
$bstring = sprintf("%c%c%c",0xfe,$cmd,0xfc);
my $ret = $hash->{PortObj}->write($bstring);
if($ret <= 0)
{
my $devname = $hash->{DeviceName};
Log 1, "USB device $devname disconnected, waiting to reappear";
$hash->{PortObj}->close();
$hash->{STATE} = "disconnected";
$hash->{READINGS}{WS300Device}{VAL} = "disconnected";
$hash->{READINGS}{WS300Device}{TIME} = TimeNow;
sleep(1);
if ($^O=~/Win/) {
$po = new Win32::SerialPort ($devname);
}else{
$po = new Device::SerialPort ($devname);
}
if($po)
{
$po->reset_error();
$po->baudrate(19200);
$po->databits(8);
$po->parity('even');
$po->stopbits(1);
$po->handshake('none');
$po->rts_active(1);
$po->dtr_active(1);
sleep(1);
$po->rts_active(0);
$po->write_settings;
Log 1, "USB device $devname reappeared";
$hash->{PortObj} = $po;
$hash->{STATE} = "opened";
$hash->{READINGS}{WS300Device}{VAL} = "opened";
$hash->{READINGS}{WS300Device}{TIME} = TimeNow;
$polling=0;
return;
}
}
$inbuf = "";
my $start=0;
my $tout=time();
my $rcount=0;
my $ic=0;
for(;;)
{
($count,$inchar) = $hash->{PortObj}->read(1);
if($count == 0)
{
last if($tout < time());
}
else
{
$ic = hex(unpack('H*',$inchar));
if(!$start)
{
if($ic == 0xfe)
{
$start = 1;
}
}
else
{
if($ic == 0xf8)
{
$escape = 1;
$count = 0;
}
else
{
if($escape)
{
$ic--;
$inbuf .= chr($ic);
$escape = 0;
}
else
{
$inbuf .= $inchar;
last if($ic == 0xfc);
}
}
}
$rcount += $count;
$tout=time();
}
}
Log($ll,"WS300/RAW: ".$rcount." ".unpack('H*',$inbuf));
if($ic != 0xfc)
{
$errcount++ if($errcount < 10);
if($errcount == 10)
{
$hash->{STATE} = "timeout";
$hash->{READINGS}{WS300Device}{VAL} = "timeout";
$hash->{READINGS}{WS300Device}{TIME} = TimeNow;
$errcount++;
}
Log 1,"WS300: no data" if($rcount == 0);
Log 1,"WS300: wrong data ".unpack('H*',$inbuf) if($rcount > 0);
$polling=0;
return;
}
if($hash->{STATE} ne "connected" && $errcount > 10)
{
$hash->{STATE} = "connected";
$hash->{READINGS}{WS300Device}{VAL} = "connected";
$hash->{READINGS}{WS300Device}{TIME} = TimeNow;
}
$errcount = 0;
$ic = ord(substr($inbuf,0,1));
if($ic == 0x32)
{
$config = $inbuf if($rcount == 16);
$cmd=0x31;
goto NEXTPOLL;
}
if($ic == 0x31)
{
if($rcount == 42)
{
WS300_Parse($hash, $inbuf);
goto NEXTPOLL;
}
else
{
$cmd=0x33;
goto NEXTPOLL;
}
}
if($ic == 0x33)
{
WS300_Parse($hash, $inbuf) if($rcount == 39);
$cmd=0x32;
}
$polling=0;
}
1;

199
fhem/FHEM/59_Weather.pm
View File

@ -1,199 +0,0 @@
#
#
# 59_Weather.pm
# written by Dr. Boris Neubert 2009-06-01
# e-mail: omega at online dot de
#
##############################################
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
use Weather::Google;
#####################################
sub Weather_Initialize($) {
my ($hash) = @_;
# Provider
# $hash->{Clients} = undef;
# Consumer
$hash->{DefFn} = "Weather_Define";
$hash->{UndefFn} = "Weather_Undef";
$hash->{GetFn} = "Weather_Get";
$hash->{AttrList}= "loglevel:0,1,2,3,4,5";
}
###################################
sub f_to_c($) {
my ($f)= @_;
return int(($f-32)*5/9+0.5);
}
###################################
sub Weather_UpdateReading($$$$$) {
my ($hash,$prefix,$key,$tn,$value)= @_;
return 0 if(!defined($value) || $value eq "");
return 0 if($key eq "unit_system");
if($key eq "temp") {
$key= "temp_c";
$value= f_to_c($value);
} elsif($key eq "low") {
$key= "low_c";
$value= f_to_c($value);
} elsif($key eq "high") {
$key= "high_c";
$value= f_to_c($value);
}
my $reading= $prefix . $key;
my $r= $hash->{READINGS};
$r->{$reading}{TIME}= $tn;
$r->{$reading}{VAL} = $value;
Log 5, "Weather $hash->{NAME}: $reading= $value";
return 1;
}
###################################
sub Weather_GetUpdate($)
{
my ($hash) = @_;
if(!$hash->{LOCAL}) {
InternalTimer(gettimeofday()+$hash->{INTERVAL}, "Weather_GetUpdate", $hash, 1);
}
my $name = $hash->{NAME};
# time
my $tn = TimeNow();
# get weather information from Google weather API
# see http://search.cpan.org/~possum/Weather-Google-0.03/lib/Weather/Google.pm
my $location= $hash->{LOCATION};
my $WeatherObj;
Log 4, "$name: Updating weather information for $location.";
eval {
$WeatherObj= new Weather::Google($location);
};
if($@) {
Log 1, "$name: Could not retrieve weather information.";
return 0;
}
my $current = $WeatherObj->current_conditions;
foreach my $condition ( keys ( %$current ) ) {
my $value= $current->{$condition};
Weather_UpdateReading($hash,"",$condition,$tn,$value);
}
my $fci= $WeatherObj->forecast_information;
foreach my $i ( keys ( %$fci ) ) {
my $reading= $i;
my $value= $fci->{$i};
Weather_UpdateReading($hash,"",$i,$tn,$value);
}
for(my $t= 0; $t<= 3; $t++) {
my $fcc= $WeatherObj->forecast_conditions($t);
my $prefix= sprintf("fc%d_", $t);
foreach my $condition ( keys ( %$fcc ) ) {
my $value= $fcc->{$condition};
Weather_UpdateReading($hash,$prefix,$condition,$tn,$value);
}
}
if(!$hash->{LOCAL}) {
DoTrigger($name, undef) if($init_done);
}
return 1;
}
# Perl Special: { $defs{Weather}{READINGS}{condition}{VAL} }
# conditions: Mostly Cloudy, Overcast, Clear, Chance of Rain
###################################
sub Weather_Get($@) {
my ($hash, @a) = @_;
return "argument is missing" if(int(@a) != 2);
$hash->{LOCAL} = 1;
Weather_GetUpdate($hash);
delete $hash->{LOCAL};
my $reading= $a[1];
my $value;
if(defined($hash->{READINGS}{$reading})) {
$value= $hash->{READINGS}{$reading}{VAL};
} else {
return "no such reading: $reading";
}
return "$a[0] $reading => $value";
}
#####################################
sub Weather_Define($$) {
my ($hash, $def) = @_;
# define <name> Weather <location> [interval]
# define MyWeather Weather "Maintal,HE" 3600
my @a = split("[ \t][ \t]*", $def);
return "syntax: define <name> Weather <location> [interval]"
if(int(@a) < 3 && int(@a) > 4);
$hash->{STATE} = "Initialized";
my $name = $a[0];
my $location = $a[2];
my $interval = 3600;
if(int(@a)==4) { $interval= $a[3]; }
$hash->{LOCATION} = $location;
$hash->{INTERVAL} = $interval;
$hash->{READINGS}{current_date_time}{TIME}= TimeNow();
$hash->{READINGS}{current_date_time}{VAL}= "none";
$hash->{LOCAL} = 1;
Weather_GetUpdate($hash);
delete $hash->{LOCAL};
InternalTimer(gettimeofday()+$hash->{INTERVAL}, "Weather_GetUpdate", $hash, 0);
return undef;
}
#####################################
sub Weather_Undef($$) {
my ($hash, $arg) = @_;
RemoveInternalTimer($hash);
return undef;
}
#####################################
1;

424
fhem/FHEM/60_EM.pm
View File

@ -1,424 +0,0 @@
##############################################
package main;
use strict;
use warnings;
sub EM_Write($$);
sub EmCrc($$);
sub EmCrcCheck($$);
sub EmEsc($);
sub EmGetData($$);
sub EmMakeMsg($);
sub EM_Set($@);
# Following one-byte commands are trange, as they cause a timeout:
# 124 127 150 153 155 156
#####################################
sub
EM_Initialize($)
{
my ($hash) = @_;
# Provider
$hash->{WriteFn} = "EM_Write";
$hash->{Clients} = ":EMWZ:EMEM:EMGZ:";
# Consumer
$hash->{DefFn} = "EM_Define";
$hash->{UndefFn} = "EM_Undef";
$hash->{GetFn} = "EM_Get";
$hash->{SetFn} = "EM_Set";
$hash->{AttrList}= "model:em1010pc dummy:1,0 loglevel:0,1,2,3,4,5,6";
}
#####################################
sub
EM_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $po;
$hash->{STATE} = "Initialized";
my $name = $a[0];
my $dev = $a[2];
if($dev eq "none") {
Log 1, "EM device is none, commands will be echoed only";
$attr{$name}{dummy} = 1;
return undef;
}
Log 3, "EM opening device $dev";
if ( $^O =~ /Win/) {
eval ("use Win32::SerialPort;");
$po = new Win32::SerialPort ($dev);
}else{
eval ("use Device::SerialPort;");
$po = new Device::SerialPort ($dev);
}
return "Can't open $dev: $!" if(!$po);
Log 3, "EM opened device $dev";
$po->close();
$hash->{DeviceName} = $dev;
return undef;
}
#####################################
sub
EM_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};
}
}
return undef;
}
#####################################
sub
EM_Set($@)
{
my ($hash, @a) = @_;
my $u1 = "Usage: set <name> reset\n" .
" set <name> time [YYYY-MM-DD HH:MM:SS]";
return $u1 if(int(@a) < 2);
my $name = $hash->{DeviceName};
if($a[1] eq "time") {
if (int(@a) == 2) {
my @lt = localtime;
$a[2] = sprintf ("%04d-%02d-%02d", $lt[5]+1900, $lt[4]+1, $lt[3]);
$a[3] = sprintf ("%02d:%02d:%02d", $lt[2], $lt[1], $lt[0]);
} elsif (int(@a) != 4) {
return $u1;
}
my @d = split("-", $a[2]);
my @t = split(":", $a[3]);
my $msg = sprintf("73%02x%02x%02x00%02x%02x%02x",
$d[2],$d[1],$d[0]-2000+0xd0, $t[0],$t[1],$t[2]);
my $d = EmGetData($name, $msg);
return "Read error" if(!defined($d));
return b($d,0);
} elsif($a[1] eq "reset") {
my $d = EmGetData($name, "4545"); # Reset
return "Read error" if(!defined($d));
sleep(10);
EM_Set($hash, ($a[0], "time")); # Set the time
sleep(1);
$d = EmGetData($name, "67"); # "Push the button", we don't want usesr interaction
return "Read error" if(!defined($d));
} else {
return "Unknown argument $a[1], choose one of reset time"
}
return undef;
}
#########################
sub
b($$)
{
my ($t,$p) = @_;
return -1 if(!defined($t) || length($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
EM_Get($@)
{
my ($hash, @a) = @_;
return "\"get EM\" needs only one parameter" if(@a != 2);
my $v;
if($a[1] eq "time") {
my $d = EmGetData($hash->{DeviceName}, "74");
return "Read error" if(!defined($d));
$v = sprintf "%4d-%02d-%02d %02d:%02d:%02d",
b($d,5)+2006, b($d,4), b($d,3),
b($d,0), b($d,1), b($d,2);
} elsif($a[1] eq "version") {
my $d = EmGetData($hash->{DeviceName},"76");
return "Read error" if(!defined($d));
$v = sprintf "%d.%d", b($d,0), b($d,1);
} else {
return "Unknown argument $a[1], choose one of time,version";
}
$hash->{READINGS}{$a[1]}{VAL} = $v;
$hash->{READINGS}{$a[1]}{TIME} = TimeNow();
return "$a[0] $a[1] => $v";
}
#####################################
sub
EM_Write($$)
{
my ($hash,$msg) = @_;
return EmGetData($hash->{DeviceName}, $msg);
}
#####################################
sub
EmCrc($$)
{
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
EmEsc($)
{
my ($b) = @_;
my $out = "";
$out .= chr(0x10) if($b==0x02 || $b==0x03 || $b==0x10);
$out .= chr($b);
}
#####################################
sub
EmCrcCheck($$)
{
my ($otxt, $len) = @_;
my $crc = 0x8c27;
for(my $l = 2; $l < $len+4; $l++) {
my $b = ord(substr($otxt,$l,1));
$crc = EmCrc($crc, 0x10) if($b==0x02 || $b==0x03 || $b==0x10);
$crc = EmCrc($crc, $b);
}
return ($crc == w($otxt, $len+4));
}
#########################
sub
EmMakeMsg($)
{
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 = EmCrc($crc, 0x10) if($b==0x02 || $b==0x03 || $b==0x10);
$crc = EmCrc($crc, $b);
$out .= EmEsc($b);
}
$out .= EmEsc($crc&0xff);
$out .= EmEsc($crc/256);
$out .= chr(0x03);
return $out;
}
#####################################
# This is the only
sub
EmGetData($$)
{
my ($dev, $d) = @_;
$d = EmMakeMsg(pack('H*', $d));
my $serport;
my $rm;
return undef if(!$dev);
#OS depends
if ($^O=~/Win/) {
$serport = new Win32::SerialPort ($dev);
}else{
$serport = new Device::SerialPort ($dev);
}
if(!$serport) {
Log 1, "EM: Can't open $dev: $!";
return undef;
}
$serport->reset_error();
$serport->baudrate(38400);
$serport->databits(8);
$serport->parity('none');
$serport->stopbits(1);
$serport->handshake('none');
if ( $^O =~ /Win/ ) {
unless ($serport->write_settings) {
$rm= "EM:Can't change Device_Control_Block: $^E\n";
goto DONE;
}
}
Log 4, "EM: Sending " . unpack('H*', $d);
$rm = "EM: timeout reading the answer";
for(my $rep = 0; $rep < 3; $rep++) {
$serport->write($d);
my $retval = "";
my $esc = 0;
my $started = 0;
my $complete = 0;
my $buf;
my $i;
my $b;
for(;;) {
if($^O =~ /Win/) {
#select will not work on windows, replaced with status
my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags)=(0,0,0,0);
for ($i=0;$i<9; $i++) {
sleep(1); #waiiiit
($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags)=$serport->status;
last if $InBytes>0;
}
Log 5,"EM: read returned $InBytes Bytes($i trys)";
last if ($InBytes<1);
$buf = $serport->input();
} else {
my ($rout, $rin) = ('', '');
vec($rin, $serport->FILENO, 1) = 1;
my $nfound = select($rout=$rin, undef, undef, 1.0);
if($nfound < 0) {
$rm = "EM Select error $nfound / $!";
goto DONE;
}
last if($nfound == 0);
$buf = $serport->input();
}
if(!defined($buf) || length($buf) == 0) {
$rm = "EM EOF on $dev";
goto DONE;
}
for($i = 0; $i < length($buf); $i++) {
$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) { $rm = "EM Msg too short"; goto DONE; }
if(b($retval,1) != 0) { $rm = "EM Bad second byte"; goto DONE; }
if(w($retval,2) != $l-7) { $rm = "EM Length mismatch"; goto DONE; }
if(!EmCrcCheck($retval,$l-7)) { $rm = "EM Bad CRC"; goto DONE; }
$serport->close();
my $data=substr($retval, 4, $l-7);
Log 5,"EM: returned ".unpack("H*",$data);
return $data;
}
}
}
DONE:
Log 5,$rm;
$serport->close();
return undef;
}
#########################
# Interpretation is left for the "user";
sub
EmGetDevData($)
{
my ($hash) = @_;
my $dnr = $hash->{DEVNR};
my $d = IOWrite($hash, sprintf("7a%02x", $dnr-1));
return("ERROR: No device no. $dnr present")
if($d eq ((pack('H*',"00") x 45) . pack('H*',"FF") x 6));
my $nrreadings = w($d,2);
return("ERROR: No data to read (yet?)")
if($nrreadings == 0);
my $step = b($d,6);
my $start = b($d,18)+13;
my $end = $start + int(($nrreadings-1)/64)*$step;
my @ret;
my $max;
my $off;
for(my $p = $start; $p <= $end; $p += $step) { # blockwise
$d = IOWrite($hash, sprintf("52%02x%02x00000801", $p%256, int($p/256)));
$max = (($p == $end) ? ($nrreadings%64)*4+4 : 260);
$step = b($d, 6);
for($off = 8; $off <= $max; $off += 4) { # Samples in each block
push(@ret, sprintf("%04x%04x\n", w($d,$off), w($d,$off+2)));
}
}
return @ret;
}
1;

184
fhem/FHEM/61_EMWZ.pm
View File

@ -1,184 +0,0 @@
##############################################
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
sub EMWZ_Get($@);
sub EMWZ_Set($@);
sub EMWZ_Define($$);
sub EMWZ_GetStatus($);
###################################
sub
EMWZ_Initialize($)
{
my ($hash) = @_;
$hash->{GetFn} = "EMWZ_Get";
$hash->{SetFn} = "EMWZ_Set";
$hash->{DefFn} = "EMWZ_Define";
$hash->{AttrList} = "IODev dummy:1,0 model;EM1000WZ loglevel:0,1,2,3,4,5,6";
}
###################################
sub
EMWZ_GetStatus($)
{
my ($hash) = @_;
if(!$hash->{LOCAL}) {
InternalTimer(gettimeofday()+300, "EMWZ_GetStatus", $hash, 0);
}
my $dnr = $hash->{DEVNR};
my $name = $hash->{NAME};
return "Empty status: dummy IO device" if(IsIoDummy($name));
my $d = IOWrite($hash, sprintf("7a%02x", $dnr-1));
if(!defined($d)) {
my $msg = "EMWZ $name read error (GetStatus 1)";
Log GetLogLevel($name,2), $msg;
return $msg;
}
if($d eq ((pack('H*',"00") x 45) . pack('H*',"FF") x 6)) {
my $msg = "EMWZ no device no. $dnr present";
Log GetLogLevel($name,2), $msg;
return $msg;
}
my $pulses=w($d,13);
my $ec=w($d,49) / 10;
if($ec <= 0) {
my $msg = "EMWZ read error (GetStatus 2)";
Log GetLogLevel($name,2), $msg;
return $msg;
}
my $cur_energy = $pulses / $ec; # ec = U/kWh
my $cur_power = $cur_energy / 5 * 60; # 5minute interval scaled to 1h
if($cur_power > 30) { # 20Amp x 3 Phase
my $msg = "EMWZ Bogus reading: curr. power is reported to be $cur_power";
Log GetLogLevel($name,2), $msg;
return $msg;
}
my %vals;
$vals{"5min_pulses"} = $pulses;
$vals{"energy"} = sprintf("%0.3f", $cur_energy);
$vals{"power"} = sprintf("%.3f", $cur_power);
$vals{"alarm_PA"} = w($d,45) . " Watt";
$vals{"price_CF"} = sprintf("%.3f", w($d,47)/10000);
$vals{"RperKW_EC"} = $ec;
$hash->{READINGS}{cum_kWh}{VAL} = 0 if(!$hash->{READINGS}{cum_kWh}{VAL});
$vals{"cum_kWh"} = sprintf("%0.3f",
$hash->{READINGS}{cum_kWh}{VAL} + $vals{"energy"});
$vals{summary} = sprintf("Pulses: %s Energy: %s Power: %s Cum: %s",
$vals{"5min_pulses"}, $vals{energy},
$vals{power}, $vals{cum_kWh});
my $tn = TimeNow();
my $idx = 0;
foreach my $k (keys %vals) {
my $v = $vals{$k};
$hash->{CHANGED}[$idx++] = "$k: $v";
$hash->{READINGS}{$k}{TIME} = $tn;
$hash->{READINGS}{$k}{VAL} = $v
}
if(!$hash->{LOCAL}) {
DoTrigger($name, undef) if($init_done);
}
$hash->{STATE} = "$cur_power kW";
Log GetLogLevel($name,4), "EMWZ $name: $cur_power kW / $vals{energy}";
return $hash->{STATE};
}
###################################
sub
EMWZ_Get($@)
{
my ($hash, @a) = @_;
return "argument is missing" if(int(@a) != 2);
my $d = $hash->{DEVNR};
my $msg;
if($a[1] ne "status") {
return "unknown get value, valid is status";
}
$hash->{LOCAL} = 1;
my $v = EMWZ_GetStatus($hash);
delete $hash->{LOCAL};
return "$a[0] $a[1] => $v";
}
sub
EMWZ_Set($@)
{
my ($hash, @a) = @_;
my $name = $hash->{NAME};
my $v = $a[2];
my $d = $hash->{DEVNR};
my $msg;
if($a[1] eq "price" && int(@a) == 3) {
$v *= 10000; # Make display and input the same
$msg = sprintf("79%02x2f02%02x%02x", $d-1, $v%256, int($v/256));
} elsif($a[1] eq "alarm" && int(@a) == 3) {
$msg = sprintf("79%02x2d02%02x%02x", $d-1, $v%256, int($v/256));
} elsif($a[1] eq "rperkw" && int(@a) == 3) {
$v *= 10; # Make display and input the same
$msg = sprintf("79%02x3102%02x%02x", $d-1, $v%256, int($v/256));
} else {
return "Unknown argument $a[1], choose one of price alarm rperkw";
}
return "" if(IsIoDummy($name));
my $ret = IOWrite($hash, $msg);
if(!defined($ret)) {
my $msg = "EMWZ $name read error (Set)";
Log GetLogLevel($name,2), $msg;
return $msg;
}
if(ord(substr($ret,0,1)) != 6) {
$ret = "EMWZ Error occured: " . unpack('H*', $ret);
Log GetLogLevel($name,2), $ret;
return $ret;
}
return undef;
}
#############################
sub
EMWZ_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "syntax: define <name> EMWZ devicenumber"
if(@a != 3 || $a[2] !~ m,^[1-4]$,);
$hash->{DEVNR} = $a[2];
AssignIoPort($hash);
EMWZ_GetStatus($hash);
return undef;
}
1;

138
fhem/FHEM/62_EMEM.pm
View File

@ -1,138 +0,0 @@
##############################################
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
sub EMEM_Get($@);
sub EMEM_Define($$);
sub EMEM_GetStatus($);
###################################
sub
EMEM_Initialize($)
{
my ($hash) = @_;
$hash->{GetFn} = "EMEM_Get";
$hash->{DefFn} = "EMEM_Define";
$hash->{AttrList} = "IODev dummy:1,0 model;EM1000EM loglevel:0,1,2,3,4,5,6";
}
###################################
sub
EMEM_GetStatus($)
{
my ($hash) = @_;
if(!$hash->{LOCAL}) {
InternalTimer(gettimeofday()+300, "EMEM_GetStatus", $hash, 0);
}
my $dnr = $hash->{DEVNR};
my $name = $hash->{NAME};
return "Empty status: dummy IO device" if(IsIoDummy($name));
my $d = IOWrite($hash, sprintf("7a%02x", $dnr-1));
if(!defined($d)) {
my $msg = "EMEM $name read error (GetStatus 1)";
Log GetLogLevel($name,2), $msg;
return $msg;
}
if($d eq ((pack('H*',"00") x 45) . pack('H*',"FF") x 6)) {
my $msg = "EMEM no device no. $dnr present";
Log GetLogLevel($name,2), $msg;
return $msg;
}
my $pulses=w($d,13);
my $pulses_max= w($d,15);
my $iec = 1000;
my $cur_power = $pulses / 100;
my $cur_power_max = $pulses_max / 100;
if($cur_power > 30) { # 20Amp x 3 Phase
my $msg = "EMEM Bogus reading: curr. power is reported to be $cur_power, setting to -1";
Log GetLogLevel($name,2), $msg;
#return $msg;
$cur_power = -1.0;
}
if($cur_power_max > 30) { # 20Amp x 3 Phase
$cur_power_max = -1.0;
}
my %vals;
$vals{"5min_pulses"} = $pulses;
$vals{"5min_pulses_max"} = $pulses_max;
$vals{"energy_kWh_h"} = sprintf("%0.3f", dw($d,33) / $iec);
$vals{"energy_kWh_d"} = sprintf("%0.3f", dw($d,37) / $iec);
$vals{"energy_kWh_w"} = sprintf("%0.3f", dw($d,41) / $iec);
$vals{"energy_kWh"} = sprintf("%0.3f", dw($d, 7) / $iec);
$vals{"power_kW"} = sprintf("%.3f", $cur_power);
$vals{"power_kW_max"} = sprintf("%.3f", $cur_power_max);
$vals{"alarm_PA_W"} = w($d,45);
$vals{"price_CF"} = sprintf("%.3f", w($d,47)/10000);
my $tn = TimeNow();
my $idx = 0;
foreach my $k (keys %vals) {
my $v = $vals{$k};
$hash->{CHANGED}[$idx++] = "$k: $v";
$hash->{READINGS}{$k}{TIME} = $tn;
$hash->{READINGS}{$k}{VAL} = $v
}
if(!$hash->{LOCAL}) {
DoTrigger($name, undef) if($init_done);
}
$hash->{STATE} = "$cur_power kW";
Log GetLogLevel($name,4), "EMEM $name: $cur_power kW / $vals{energy_kWh} kWh";
return $hash->{STATE};
}
###################################
sub
EMEM_Get($@)
{
my ($hash, @a) = @_;
return "argument is missing" if(int(@a) != 2);
my $d = $hash->{DEVNR};
my $msg;
if($a[1] ne "status") {
return "unknown get value, valid is status";
}
$hash->{LOCAL} = 1;
my $v = EMEM_GetStatus($hash);
delete $hash->{LOCAL};
return "$a[0] $a[1] => $v";
}
#############################
sub
EMEM_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "syntax: define <name> EMEM devicenumber"
if(@a != 3 || $a[2] !~ m,^[5-8]$,);
$hash->{DEVNR} = $a[2];
AssignIoPort($hash);
EMEM_GetStatus($hash);
return undef;
}
1;

171
fhem/FHEM/63_EMGZ.pm
View File

@ -1,171 +0,0 @@
##############################################
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
sub EMGZ_Get($@);
sub EMGZ_Set($@);
sub EMGZ_Define($$);
sub EMGZ_GetStatus($);
###################################
sub
EMGZ_Initialize($)
{
my ($hash) = @_;
$hash->{GetFn} = "EMGZ_Get";
$hash->{SetFn} = "EMGZ_Set";
$hash->{DefFn} = "EMGZ_Define";
$hash->{AttrList} = "IODev dummy:1,0 model;EM1000GZ loglevel:0,1,2,3,4,5,6";
}
###################################
sub
EMGZ_GetStatus($)
{
my ($hash) = @_;
if(!$hash->{LOCAL}) {
InternalTimer(gettimeofday()+300, "EMGZ_GetStatus", $hash, 0);
}
my $dnr = $hash->{DEVNR};
my $name = $hash->{NAME};
return "Empty status: dummy IO device" if(IsIoDummy($name));
my $d = IOWrite($hash, sprintf("7a%02x", $dnr-1));
if(!defined($d)) {
my $msg = "EMGZ $name read error (GetStatus 1)";
Log GetLogLevel($name,2), $msg;
return $msg;
}
if($d eq ((pack('H*',"00") x 45) . pack('H*',"FF") x 6)) {
my $msg = "EMGZ no device no. $dnr present";
Log GetLogLevel($name,2), $msg;
return $msg;
}
my $pulses=w($d,13);
my $ec = 100; # fixed value
my $cur_energy = $pulses / $ec; # ec = U/m^3
my $cur_power = $cur_energy / 5 * 60; # 5minute interval scaled to 1h
if($cur_power > 30) { # depending on "Anschlussleistung"
my $msg = "EMGZ Bogus reading: curr. power is reported to be $cur_power";
Log GetLogLevel($name,2), $msg;
return $msg;
}
my %vals;
$vals{"5min_pulses"} = $pulses;
$vals{"act_flow_m3"} = sprintf("%0.3f", $cur_energy);
$vals{"m3ph"} = sprintf("%.3f", $cur_power);
$vals{"alarm_PA"} = w($d,45) . " Watt"; # nonsens
$vals{"price_CF"} = sprintf("%.3f", w($d,47)/10000);
$vals{"Rperm3_EC"} = $ec;
$hash->{READINGS}{cum_m3}{VAL} = 0 if(!$hash->{READINGS}{cum_m3}{VAL});
$vals{"cum_m3"} = sprintf("%0.3f",
$hash->{READINGS}{cum_m3}{VAL} + $vals{"act_flow_m3"});
my $tn = TimeNow();
my $idx = 0;
foreach my $k (keys %vals) {
my $v = $vals{$k};
$hash->{CHANGED}[$idx++] = "$k: $v";
$hash->{READINGS}{$k}{TIME} = $tn;
$hash->{READINGS}{$k}{VAL} = $v
}
if(!$hash->{LOCAL}) {
DoTrigger($name, undef) if($init_done);
}
$hash->{STATE} = "$cur_power m3ph";
Log GetLogLevel($name,4), "EMGZ $name: $cur_power m3ph / $vals{act_flow_m3}";
return $hash->{STATE};
}
###################################
sub
EMGZ_Get($@)
{
my ($hash, @a) = @_;
my $d = $hash->{DEVNR};
my $msg;
if($a[1] ne "status" && int(@a) != 2) {
return "unknown get value, valid is status";
}
$hash->{LOCAL} = 1;
my $v = EMGZ_GetStatus($hash);
delete $hash->{LOCAL};
return "$a[0] $a[1] => $v";
}
sub
EMGZ_Set($@)
{
my ($hash, @a) = @_;
my $name = $hash->{NAME};
my $v = $a[2];
my $d = $hash->{DEVNR};
my $msg;
if($a[1] eq "price" && int(@a) != 3) {
$v *= 10000; # Make display and input the same
$msg = sprintf("79%02x2f02%02x%02x", $d-1, $v%256, int($v/256));
} else {
return "Unknown argument $a[1], choose one of price";
}
return "" if(IsIoDummy($name));
my $ret = IOWrite($hash, $msg);
if(!defined($ret)) {
$msg = "EMWZ $name read error (Set)";
Log GetLogLevel($name,2), $msg;
return $msg;
}
if(ord(substr($ret,0,1)) != 6) {
$ret = "EMGZ Error occured: " . unpack('H*', $ret);
Log GetLogLevel($name,2), $ret;
return $ret;
}
return undef;
}
#############################
sub
EMGZ_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "syntax: define <name> EMGZ devicenumber"
if(@a != 3 || $a[2] !~ m,^[9]$,);
$hash->{DEVNR} = $a[2];
AssignIoPort($hash);
EMGZ_GetStatus($hash);
return undef;
}
1;

282
fhem/FHEM/64_ESA2000.pm
View File

@ -1,282 +0,0 @@
##############################################
# (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
ESA2000_Initialize($)
{
my ($hash) = @_;
# S0119FA011E00007D6E003100000007C9 ESA2000_LED
$hash->{Match} = "^S................................\$";
$hash->{DefFn} = "ESA2000_Define";
$hash->{UndefFn} = "ESA2000_Undef";
$hash->{ParseFn} = "ESA2000_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 base_1 base_2";
}
#####################################
sub
ESA2000_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "wrong syntax: define <name> ESA2000 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{ESA2000}{defptr}{$a[2]} = $hash;
AssignIoPort($hash);
return undef;
}
#####################################
sub
ESA2000_Undef($$)
{
my ($hash, $name) = @_;
delete($modules{ESA2000}{defptr}{$hash->{CODE}})
if(defined($hash->{CODE}) &&
defined($modules{ESA2000}{defptr}{$hash->{CODE}}));
return undef;
}
#####################################
sub
ESA2000_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, "ESA2000 msg $msg";
Log 5, "ESA2000 seq $seq";
Log 5, "ESA2000 device $dev";
Log 5, "ESA2000 code $cde";
my $type = "";
foreach my $c (keys %codes) {
$c = lc($c);
if($cde =~ m/$c/) {
$type = $codes{$c};
last;
}
}
if(!defined($modules{ESA2000}{defptr}{$dev})) {
Log 3, "Unknown ESA2000 device $dev, please define it";
$type = "ESA2000" if(!$type);
return "UNDEFINED ${type}_$dev ESA2000 $dev";
}
my $def = $modules{ESA2000}{defptr}{$dev};
my $name = $def->{NAME};
return "" if(IsIgnored($name));
my $now = TimeNow();
my (@v, @txt);
# ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = gmtime(time);
# $year = $year + 1900;
if($type eq "ESA2000_LED") {
@txt = ( "repeat", "sequence", "total_ticks", "actual_ticks", "ticks_kwh", "raw", "total_kwh", "actual_kwh", "diff_kwh", "diff_sec", "diff_ticks", "last_sec", "raw_total_kwh", "max_kwh", "day_kwh", "month_kwh", "year_kwh", "rate", "hr_kwh", "lr_kwh", "day_hr_kwh", "day_lr_kwh", "month_hr_kwh", "month_lr_kwh", "year_hr_kwh", "year_lr_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?!?! Probably a (receive-) error in CUL-FW?
$v[11] = time();
# check if low-rate or high-rate. note that this is different per electricity company! (Here weekday from 6-20 is high rate)
my ($sec,$min,$hour,$mday,$month,$year,$wday,$yday,$isdst) = localtime;
if ( (0 < $wday ) && ($wday < 6) && (5 < $hour) && ($hour < 20) ) {
$v[17] = "HR";
} else {
$v[17] = "LR";
}
$v[5] = sprintf("CNT: %d%s CUM: %d CUR: %d TICKS: %d %s",
$v[1], $v[0], $v[2], $v[3], $v[4], $v[17] );
if (defined($def->{READINGS}{$txt[11]}{VAL})) {
$v[9] = $v[11] - $def->{READINGS}{$txt[11]}{VAL}; # seconds since last update
}
if(defined($v[9]) && $v[9] != 0) {
$v[7] = $v[3]/$v[4]/$v[9]*3600; # calculate kW/h since last update
} else {
$v[7] = -1;
}
$v[8] = $v[3]/$v[4]; # calculate kWh diff from readings (raw from device....), whats this relly?
if(defined($def->{READINGS}{$txt[2]}{VAL})) {
if($def->{READINGS}{$txt[2]}{VAL} <=$v[2]) { # check for resetted counter.... only accept increase in counter
$v[10] = $v[2] - $def->{READINGS}{$txt[2]}{VAL}; # shoudl be the same as actual_ticks if no packets are lost
}
}
if(defined($v[10])) {
$v[6] = $v[10]/$v[4] + (defined($def->{READINGS}{$txt[6]}{VAL}) ? $def->{READINGS}{$txt[6]}{VAL} : 0); # cumulate kWh to ensure tick-changes are calculated correctly (does this ever happen?)
if(defined($def->{READINGS}{$txt[14]}{TIME})) {
if(substr($now,0,10) eq substr($def->{READINGS}{$txt[14]}{TIME},0,10)) { # a bit clumsy, I agree, but it works and its logical and this is pearl, right?
$v[14] = $v[10]/$v[4] + (defined($def->{READINGS}{$txt[14]}{VAL}) ? $def->{READINGS}{$txt[14]}{VAL} : 0); # cumulate kWh to ensure tick-changes are calculated correctly (does this ever happen?)
if ($v[17] eq "HR" ) {
$v[18] = $v[10]/$v[4] + (defined($def->{READINGS}{$txt[18]}{VAL}) ? $def->{READINGS}{$txt[18]}{VAL} : 0); # high-rate
} else {
$v[19] = $v[10]/$v[4] + (defined($def->{READINGS}{$txt[19]}{VAL}) ? $def->{READINGS}{$txt[19]}{VAL} : 0); # low-rate
}
} else {
$v[14] = $v[10]/$v[4];
if ($v[17] eq "HR" ) {
$v[18] = $v[10]/$v[4];
} else {
$v[19] = $v[10]/$v[4];
}
}
} else {
$v[14] = $v[10]/$v[4];
if ($v[17] eq "HR" ) {
$v[18] = $v[10]/$v[4];
} else {
$v[19] = $v[10]/$v[4];
}
}
if(defined($def->{READINGS}{$txt[15]}{TIME})) {
if(substr($now,0,7) eq substr($def->{READINGS}{$txt[15]}{TIME},0,7)) { # a bit clumsy, I agree, but it works and its logical and this is pearl, right?
$v[15] = $v[10]/$v[4] + (defined($def->{READINGS}{$txt[15]}{VAL}) ? $def->{READINGS}{$txt[15]}{VAL} : 0); # cumulate kWh to ensure tick-changes are calculated correctly (does this ever happen?)
if ($v[17] eq "HR" ) {
$v[20] = $v[10]/$v[4] + (defined($def->{READINGS}{$txt[20]}{VAL}) ? $def->{READINGS}{$txt[20]}{VAL} : 0); # high-rate
} else {
$v[21] = $v[10]/$v[4] + (defined($def->{READINGS}{$txt[21]}{VAL}) ? $def->{READINGS}{$txt[21]}{VAL} : 0); # low-rate
}
} else {
$v[15] = $v[10]/$v[4];
if ($v[17] eq "HR" ) {
$v[20] = $v[10]/$v[4];
} else {
$v[21] = $v[10]/$v[4];
}
}
} else {
$v[15] = $v[10]/$v[4];
if ($v[17] eq "HR" ) {
$v[20] = $v[10]/$v[4];
} else {
$v[21] = $v[10]/$v[4];
}
}
if(defined($def->{READINGS}{$txt[16]}{TIME})) {
if(substr($now,0,4) eq substr($def->{READINGS}{$txt[16]}{TIME},0,4)) { # a bit clumsy, I agree, but it works and its logical and this is pearl, right?
$v[16] = $v[10]/$v[4] + (defined($def->{READINGS}{$txt[16]}{VAL}) ? $def->{READINGS}{$txt[16]}{VAL} : 0); # cumulate kWh to ensure tick-changes are calculated correctly (does this ever happen?)
if ($v[17] eq "HR" ) {
$v[22] = $v[10]/$v[4] + (defined($def->{READINGS}{$txt[22]}{VAL}) ? $def->{READINGS}{$txt[22]}{VAL} : 0); # high-rate
} else {
$v[23] = $v[10]/$v[4] + (defined($def->{READINGS}{$txt[23]}{VAL}) ? $def->{READINGS}{$txt[23]}{VAL} : 0); # low-rate
}
} else {
$v[16] = $v[10]/$v[4];
if ($v[17] eq "HR" ) {
$v[22] = $v[10]/$v[4];
} else {
$v[23] = $v[10]/$v[4];
}
}
} else {
$v[16] = $v[10]/$v[4];
if ($v[17] eq "HR" ) {
$v[22] = $v[10]/$v[4];
} else {
$v[23] = $v[10]/$v[4];
}
}
} else {
$v[6] = 0;
}
$v[12] = $v[2]/$v[4]; # calculate kWh total since reset of device (does only make sense if ticks per kWh does not change!!)
if(defined($def->{READINGS}{$txt[13]}{VAL})) {
if($v[7] >= $def->{READINGS}{$txt[13]}{VAL}) {
$v[13] = $v[7]; # update max kw/h
}
} else {
$v[13] = $v[7]; # update max kw/h
}
# add counter_1 and counter_2 (Hoch- und Niedertarif Basiswerte)
if(defined($attr{$name}) &&
defined($attr{$name}{"count_1"}) &&
($attr{$name}{"count_1"}>0)) {
$v[13] = $v[12] + $attr{$name}{"count_1"};
}
if(defined($attr{$name}) &&
defined($attr{$name}{"count_2"}) &&
($attr{$name}{"count_2"}>0)) {
$v[13] = $v[12] + $attr{$name}{"count_2"};
}
$val = sprintf("CNT: %d%s CUM: %0.3f CUR: %0.3f TICKS: %d %s",
$v[1], $v[0], $v[6], $v[7], $v[4], $v[17]);
} else {
Log 3, "ESA2000 Device $dev (Unknown type: $type)";
return "";
}
my $max = int(@txt);
if ( (defined($def->{READINGS}{"sequence"}{VAL}) ? $def->{READINGS}{"sequence"}{VAL} : "") ne $v[1] ) {
Log GetLogLevel($name,4), "ESA2000 $name: $val";
for( my $i = 0; $i < $max; $i++) {
if ( $v[$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), "(ESA2000/DISCARDED $name: $val)";
return "($name)";
}
return $name;
}
1;

605
fhem/FHEM/66_ECMD.pm
View File

@ -1,605 +0,0 @@
#
#
# 66_ECMD.pm
# written by Dr. Boris Neubert 2011-01-15
# e-mail: omega at online dot de
#
##############################################
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
#sub ECMD_Attr(@);
sub ECMD_Clear($);
#sub ECMD_Parse($$$$$);
#sub ECMD_Read($);
sub ECMD_ReadAnswer($$);
#sub ECMD_Ready($);
sub ECMD_Write($$);
sub ECMD_OpenDev($$);
sub ECMD_CloseDev($);
sub ECMD_SimpleWrite(@);
sub ECMD_SimpleRead($);
sub ECMD_Disconnected($);
use vars qw {%attr %defs};
#####################################
sub
ECMD_Initialize($)
{
my ($hash) = @_;
# Provider
$hash->{WriteFn} = "ECMD_Write";
#$hash->{ReadFn} = "ECMD_Read";
$hash->{Clients}= ":ECMDDevice:";
# Consumer
$hash->{DefFn} = "ECMD_Define";
$hash->{UndefFn} = "ECMD_Undef";
$hash->{GetFn} = "ECMD_Get";
$hash->{SetFn} = "ECMD_Set";
$hash->{AttrFn} = "ECMD_Attr";
$hash->{AttrList}= "classdefs loglevel:0,1,2,3,4,5";
}
#####################################
sub
ECMD_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t]+", $def);
my $name = $a[0];
my $protocol = $a[2];
if(@a < 4 || @a > 4 || (($protocol ne "telnet") && ($protocol ne "serial"))) {
my $msg = "wrong syntax: define <name> ECMD telnet <ipaddress[:port]> or define <name> ECMD serial <devicename[\@baudrate]>";
Log 2, $msg;
return $msg;
}
ECMD_CloseDev($hash);
$hash->{Protocol}= $protocol;
my $devicename= $a[3];
$hash->{DeviceName} = $devicename;
my $ret = ECMD_OpenDev($hash, 0);
return $ret;
}
#####################################
sub
ECMD_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};
}
}
ECMD_CloseDev($hash);
return undef;
}
#####################################
sub
ECMD_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});
}
($dev, undef) = split("@", $dev); # Remove the baudrate
delete($selectlist{"$name.$dev"});
delete($readyfnlist{"$name.$dev"});
delete($hash->{FD});
}
########################
sub
ECMD_OpenDev($$)
{
my ($hash, $reopen) = @_;
my $protocol = $hash->{Protocol};
my $name = $hash->{NAME};
my $devicename = $hash->{DeviceName};
$hash->{PARTIAL} = "";
Log 3, "ECMD opening $name (protocol $protocol, device $devicename)"
if(!$reopen);
if($hash->{Protocol} eq "telnet") {
# 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 => $devicename);
if($conn) {
delete($hash->{NEXT_OPEN})
} else {
Log(3, "Can't connect to $devicename: $!") if(!$reopen);
$readyfnlist{"$name.$devicename"} = $hash;
$hash->{STATE} = "disconnected";
$hash->{NEXT_OPEN} = time()+60;
return "";
}
$hash->{TCPDev} = $conn;
$hash->{FD} = $conn->fileno();
delete($readyfnlist{"$name.$devicename"});
$selectlist{"$name.$devicename"} = $hash;
} else {
my $baudrate;
($devicename, $baudrate) = split("@", $devicename);
my $po;
if ($^O=~/Win/) {
require Win32::SerialPort;
$po = new Win32::SerialPort ($devicename);
} else {
require Device::SerialPort;
$po = new Device::SerialPort ($devicename);
}
if(!$po) {
return undef if($reopen);
Log(3, "Can't open $devicename: $!");
$readyfnlist{"$name.$devicename"} = $hash;
$hash->{STATE} = "disconnected";
return "";
}
$hash->{USBDev} = $po;
if( $^O =~ /Win/ ) {
$readyfnlist{"$name.$devicename"} = $hash;
} else {
$hash->{FD} = $po->FILENO;
delete($readyfnlist{"$name.$devicename"});
$selectlist{"$name.$devicename"} = $hash;
}
if($baudrate) {
$po->reset_error();
Log 3, "ECMD 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, "ECMD $name ($devicename) reappeared";
} else {
Log 3, "ECMD device opened";
}
$hash->{STATE}= ""; # Allow InitDev to set the state
my $ret = ECMD_DoInit($hash);
if($ret) {
Log 1, "$ret";
ECMD_CloseDev($hash);
Log 1, "Cannot init $name ($devicename), ignoring it";
}
DoTrigger($name, "CONNECTED") if($reopen);
return $ret;
}
#####################################
sub
ECMD_DoInit($)
{
my $hash = shift;
my $name = $hash->{NAME};
my $msg = undef;
ECMD_Clear($hash);
#ECMD_SimpleWrite($hash, "version");
#my ($err,$version)= ECMD_ReadAnswer($hash, "version");
#return "$name: $err" if($err);
#Log 2, "ECMD version: $version";
#$hash->{VERSION} = $version;
$hash->{STATE} = "Initialized" if(!$hash->{STATE});
return undef;
}
########################
sub
ECMD_SimpleWrite(@)
{
my ($hash, $msg, $nonl) = @_;
return if(!$hash);
$msg .= "\n" unless($nonl);
$hash->{USBDev}->write($msg) if($hash->{USBDev});
syswrite($hash->{TCPDev}, $msg) if($hash->{TCPDev});
select(undef, undef, undef, 0.001);
}
########################
sub
ECMD_SimpleRead($)
{
my ($hash) = @_;
if($hash->{USBDev}) {
return $hash->{USBDev}->input();
}
if($hash->{TCPDev}) {
my $buf;
if(!defined(sysread($hash->{TCPDev}, $buf, 1024))) {
ECMD_Disconnected($hash);
return undef;
}
return $buf;
}
return undef;
}
#####################################
# This is a direct read for commands like get
sub
ECMD_ReadAnswer($$)
{
my ($hash, $arg) = @_;
#Log 5, "ECMD reading answer for get $arg...";
return ("No FD", undef)
if(!$hash || ($^O !~ /Win/ && !defined($hash->{FD})));
my ($data, $rin) = ("", '');
my $buf;
my $to = 3; # 3 seconds timeout
$to = $hash->{RA_Timeout} if($hash->{RA_Timeout}); # ...or less
#Log 5, "Timeout is $to seconds";
for(;;) {
return ("Error: 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 = $!;
ECMD_Disconnected($hash);
return("Error reading answer for get $arg: $err", undef);
}
return ("Error: timeout reading answer for get $arg", undef)
if($nfound == 0);
$buf = ECMD_SimpleRead($hash);
return ("No data", undef) if(!defined($buf));
if($buf) {
chomp $buf; # remove line break
Log 5, "ECMD (ReadAnswer): $buf";
$data .= $buf;
}
return (undef, $data)
}
}
#####################################
sub
ECMD_SetState($$$$)
{
my ($hash, $tim, $vt, $val) = @_;
return undef;
}
#####################################
sub
ECMD_Clear($)
{
my $hash = shift;
# Clear the pipe
$hash->{RA_Timeout} = 0.1;
for(;;) {
my ($err, undef) = ECMD_ReadAnswer($hash, "clear");
last if($err && $err =~ m/^Error/);
}
delete($hash->{RA_Timeout});
}
#####################################
sub
ECMD_Disconnected($)
{
my $hash = shift;
my $dev = $hash->{DeviceName};
my $name = $hash->{NAME};
return if(!defined($hash->{FD})); # Already deleted o
Log 1, "$dev disconnected, waiting to reappear";
ECMD_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");
}
#####################################
sub
ECMD_Get($@)
{
my ($hash, @a) = @_;
return "get needs at least one parameter" if(@a < 2);
my $name = $a[0];
my $cmd= $a[1];
my $arg = ($a[2] ? $a[2] : "");
my @args= @a; shift @args; shift @args;
my ($msg, $err);
return "No get $cmd for dummies" if(IsDummy($name));
if($cmd eq "raw") {
return "get raw needs an argument" if(@a< 3);
my $ecmd= join " ", @args;
Log 5, $ecmd;
ECMD_SimpleWrite($hash, $ecmd);
($err, $msg) = ECMD_ReadAnswer($hash, "raw");
return $err if($err);
} else {
return "get $cmd: unknown command ";
}
$hash->{READINGS}{$cmd}{VAL} = $msg;
$hash->{READINGS}{$cmd}{TIME} = TimeNow();
return "$name $cmd => $msg";
}
#####################################
sub
ECMD_EvalClassDef($$$)
{
my ($hash, $classname, $filename)=@_;
my $name= $hash->{NAME};
# refuse overwriting existing definitions
if(defined($hash->{fhem}{classDefs}{$classname})) {
my $err= "$name: class $classname is already defined.";
Log 1, $err;
return $err;
}
# try and open the class definition file
if(!open(CLASSDEF, $filename)) {
my $err= "$name: cannot open file $filename for class $classname.";
Log 1, $err;
return $err;
}
my @classdef= <CLASSDEF>;
close(CLASSDEF);
# add the class definition
Log 5, "$name: adding new class $classname from file $filename";
$hash->{fhem}{classDefs}{$classname}{filename}= $filename;
# format of the class definition:
# params <params> parameters for device definition
# get <cmdname> cmd {<perlexpression>} defines a get command
# get <cmdname> params <params> parameters for get command
# set <cmdname> cmd {<perlexpression>} defines a set command
# set <cmdname> params <params> parameters for get command
# all lines are optional
#
# eaxmple class definition 1:
# get adc cmd {"adc get %channel"}
# get adc params channel
#
# eaxmple class definition 1:
# params btnup btnstop btndown
# set up cmd {"io set ddr 2 ff\nio set port 2 1%btnup\nwait 1000\nio set port 2 00"}
# set stop cmd {"io set ddr 2 ff\nio set port 2 1%btnstop\nwait 1000\nio set port 2 00"}
# set down cmd {"io set ddr 2 ff\nio set port 2 1%btndown\nwait 1000\nio set port 2 00"}
foreach my $line (@classdef) {
# kill trailing newline
chomp $line;
# kill comments and blank lines
$line=~ s/\#.*$//;
$line=~ s/\s+$//;
next unless($line);
Log 5, "$name: evaluating >$line<";
# split line into command and definition
my ($cmd, $def)= split("[ \t]+", $line, 2);
if($cmd eq "params") {
Log 5, "$name: parameters are $def";
$hash->{fhem}{classDefs}{$classname}{params}= $def;
} elsif($cmd eq "set" || $cmd eq "get") {
my ($cmdname, $spec, $arg)= split("[ \t]+", $def, 3);
if($spec eq "params") {
if($cmd eq "set") {
Log 5, "$name: set $cmdname has parameters $arg";
$hash->{fhem}{classDefs}{$classname}{sets}{$cmdname}{params}= $arg;
} elsif($cmd eq "get") {
Log 5, "$name: get $cmdname has parameters $arg";
$hash->{fhem}{classDefs}{$classname}{gets}{$cmdname}{params}= $arg;
}
} elsif($spec eq "cmd") {
if($arg !~ m/^{.*}$/s) {
Log 1, "$name: command for $cmd $cmdname is not a perl command.";
next;
}
$arg =~ s/^(\\\n|[ \t])*//; # Strip space or \\n at the begginning
$arg =~ s/[ \t]*$//;
if($cmd eq "set") {
Log 5, "$name: set $cmdname defined as $arg";
$hash->{fhem}{classDefs}{$classname}{sets}{$cmdname}{cmd}= $arg;
} elsif($cmd eq "get") {
Log 5, "$name: get $cmdname defined as $arg";
$hash->{fhem}{classDefs}{$classname}{gets}{$cmdname}{cmd}= $arg;
}
}
} else {
Log 1, "$name: illegal tag $cmd for class $classname in file $filename.";
}
}
# store class definitions in attribute
$attr{$name}{classdefs}= "";
my @a;
foreach my $c (keys %{$hash->{fhem}{classDefs}}) {
push @a, "$c=$hash->{fhem}{classDefs}{$c}{filename}";
}
$attr{$name}{"classdefs"}= join(":", @a);
return undef;
}
#####################################
sub
ECMD_Attr($@)
{
my @a = @_;
my $hash= $defs{$a[1]};
if($a[0] eq "set" && $a[2] eq "classdefs") {
my @classdefs= split(/:/,$a[3]);
delete $hash->{fhem}{classDefs};
foreach my $classdef (@classdefs) {
my ($classname,$filename)= split(/=/,$classdef,2);
ECMD_EvalClassDef($hash, $classname, $filename);
}
}
return undef;
}
#####################################
sub
ECMD_Reopen($)
{
my ($hash) = @_;
ECMD_CloseDev($hash);
ECMD_OpenDev($hash, 1);
return undef;
}
#####################################
sub
ECMD_Set($@)
{
my ($hash, @a) = @_;
my $name = $a[0];
# usage check
my $usage= "Usage: set $name classdef <classname> <filename> OR set $name reopen";
if((@a == 2) && ($a[1] eq "reopen")) {
return ECMD_Reopen($hash);
}
return $usage if(@a != 4);
return $usage if($a[1] ne "classdef");
# from the definition
my $classname= $a[2];
my $filename= $a[3];
return ECMD_EvalClassDef($hash, $classname, $filename);
}
#####################################
sub
ECMD_Write($$)
{
my ($hash,$msg) = @_;
my $answer;
my @r;
my @ecmds= split "\n", $msg;
foreach my $ecmd (@ecmds) {
Log 5, "$hash->{NAME} sending $ecmd";
ECMD_SimpleWrite($hash, $ecmd);
$answer= ECMD_ReadAnswer($hash, "$ecmd");
push @r, $answer;
Log 5, $answer;
}
return join(";", @r);
}
#####################################
1;

228
fhem/FHEM/67_ECMDDevice.pm
View File

@ -1,228 +0,0 @@
#
#
# 66_ECMDDevice.pm
# written by Dr. Boris Neubert 2011-01-15
# e-mail: omega at online dot de
#
##############################################
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
sub ECMDDevice_Get($@);
sub ECMDDevice_Set($@);
sub ECMDDevice_Define($$);
my %gets= (
);
my %sets= (
);
###################################
sub
ECMDDevice_Initialize($)
{
my ($hash) = @_;
$hash->{GetFn} = "ECMDDevice_Get";
$hash->{SetFn} = "ECMDDevice_Set";
$hash->{DefFn} = "ECMDDevice_Define";
$hash->{AttrList} = "loglevel 0,1,2,3,4,5";
}
sub
ECMDDevice_AnalyzeCommand($)
{
my ($ecmd)= @_;
Log 5, "ECMDDevice: Analyze command >$ecmd<";
return AnalyzePerlCommand(undef, $ecmd);
}
#############################
sub
ECMDDevice_GetDeviceParams($)
{
my ($hash)= @_;
my $classname= $hash->{fhem}{classname};
my $IOhash= $hash->{IODev};
if(defined($IOhash->{fhem}{classDefs}{$classname}{params})) {
my $params= $IOhash->{fhem}{classDefs}{$classname}{params};
return split("[ \t]+", $params);
}
return;
}
sub
ECMDDevice_DeviceParams2Specials($)
{
my ($hash)= @_;
my %specials= (
"%NAME" => $hash->{NAME},
"%TYPE" => $hash->{TYPE}
);
my @deviceparams= ECMDDevice_GetDeviceParams($hash);
foreach my $param (@deviceparams) {
$specials{"%".$param}= $hash->{fhem}{params}{$param};
}
return %specials;
}
###################################
sub
ECMDDevice_Changed($$$)
{
my ($hash, $cmd, $value)= @_;
my $name= $hash->{NAME};
$hash->{READINGS}{$cmd}{TIME} = TimeNow();
$hash->{READINGS}{$cmd}{VAL} = $value;
$hash->{CHANGED}[0]= "$cmd: $value";
DoTrigger($name, undef) if($init_done);
$hash->{STATE} = "$cmd: $value";
Log GetLogLevel($name, 4), "ECMDDevice $name $cmd: $value";
return $hash->{STATE};
}
###################################
sub
ECMDDevice_Get($@)
{
my ($hash, @a)= @_;
my $name= $hash->{NAME};
my $type= $hash->{TYPE};
return "get $name needs at least one argument" if(int(@a) < 2);
my $cmdname= $a[1];
my $IOhash= $hash->{IODev};
my $classname= $hash->{fhem}{classname};
if(!defined($IOhash->{fhem}{classDefs}{$classname}{gets}{$cmdname})) {
return "$name error: unknown command $cmdname";
}
my $ecmd= $IOhash->{fhem}{classDefs}{$classname}{gets}{$cmdname}{cmd};
my $params= $IOhash->{fhem}{classDefs}{$classname}{gets}{$cmdname}{params};
my %specials= ECMDDevice_DeviceParams2Specials($hash);
# add specials for command
if($params) {
shift @a; shift @a;
my @params= split('[\s]+', $params);
return "Wrong number of parameters." if($#a != $#params);
my $i= 0;
foreach my $param (@params) {
Log 5, "Parameter %". $param . " is " . $a[$i];
$specials{"%".$param}= $a[$i++];
}
}
$ecmd= EvalSpecials($ecmd, %specials);
my $r = ECMDDevice_AnalyzeCommand($ecmd);
my $v= IOWrite($hash, $r);
return ECMDDevice_Changed($hash, $cmdname, $v);
}
#############################
sub
ECMDDevice_Set($@)
{
my ($hash, @a)= @_;
my $name= $hash->{NAME};
my $type= $hash->{TYPE};
return "set $name needs at least one argument" if(int(@a) < 2);
my $cmdname= $a[1];
my $IOhash= $hash->{IODev};
my $classname= $hash->{fhem}{classname};
if(!defined($IOhash->{fhem}{classDefs}{$classname}{sets}{$cmdname})) {
return "$name error: unknown command $cmdname";
}
my $ecmd= $IOhash->{fhem}{classDefs}{$classname}{sets}{$cmdname}{cmd};
my $params= $IOhash->{fhem}{classDefs}{$classname}{sets}{$cmdname}{params};
my %specials= ECMDDevice_DeviceParams2Specials($hash);
# add specials for command
if($params) {
shift @a; shift @a;
my @params= split('[\s]+', $params);
return "Wrong number of parameters." if($#a != $#params);
my $i= 0;
foreach my $param (@params) {
$specials{"%".$param}= $a[$i++];
}
}
$ecmd= EvalSpecials($ecmd, %specials);
my $r = ECMDDevice_AnalyzeCommand($ecmd);
my $v= IOWrite($hash, $r);
$v= join(" ", @a) if($params);
return ECMDDevice_Changed($hash, $cmdname, $v);
}
#############################
sub
ECMDDevice_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t]+", $def);
return "Usage: define <name> ECMDDevice <classname> [...]" if(int(@a) < 3);
my $name= $a[0];
my $classname= $a[2];
AssignIoPort($hash);
my $IOhash= $hash->{IODev};
if(!defined($IOhash->{fhem}{classDefs}{$classname}{filename})) {
my $err= "$name error: unknown class $classname.";
Log 1, $err;
return $err;
}
$hash->{fhem}{classname}= $classname;
my @prms= ECMDDevice_GetDeviceParams($hash);
my $numparams= 0;
$numparams= $#prms+1 if(defined($prms[0]));
#Log 5, "ECMDDevice $classname requires $numparams parameter(s): ". join(" ", @prms);
# keep only the parameters
shift @a; shift @a; shift @a;
# verify identical number of parameters
if($numparams != $#a+1) {
my $err= "$name error: wrong number of parameters";
Log 1, $err;
return $err;
}
# set parameters
for(my $i= 0; $i< $numparams; $i++) {
$hash->{fhem}{params}{$prms[$i]}= $a[$i];
}
return undef;
}
1;

273
fhem/FHEM/70_SCIVT.pm
View File

@ -1,273 +0,0 @@
##############################################
package main;
use strict;
use warnings;
use Device::SerialPort;
my %sets = (
"cmd" => "",
"freq" => "",
);
#####################################
sub
SCIVT_Initialize($)
{
my ($hash) = @_;
# Consumer
$hash->{DefFn} = "SCIVT_Define";
$hash->{GetFn} = "SCIVT_Get";
$hash->{SetFn} = "SCIVT_Set";
$hash->{AttrList}= "model:SCD10,SCD20,SCD30 loglevel:0,1,2,3,4,5,6";
}
#####################################
sub
SCIVT_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "Define the serial device as a parameter, use none for a fake device"
if(@a != 3);
$hash->{STATE} = "Initialized";
my $dev = $a[2];
Log 1, "SCIVT device is none, commands will be echoed only"
if($dev eq "none");
if($dev ne "none") {
Log 3, "SCIVT opening device $dev";
my $po = new Device::SerialPort ($dev);
return "SCIVT Can't open $dev: $!" if(!$po);
Log 2, "SCIVT opened device $dev";
$po->close();
}
$hash->{DeviceName} = $dev;
$hash->{Timer} = 900; # call every 15 min
$hash->{Cmd} = 'F'; # get all data, min/max unchanged
my $tn = TimeNow();
$hash->{READINGS}{"freq"}{TIME} = $tn;
$hash->{READINGS}{"freq"}{VAL} = $hash->{Timer};
$hash->{READINGS}{"cmd"}{TIME} = $tn;
$hash->{READINGS}{"cmd"}{VAL} = $hash->{Cmd};
$hash->{CHANGED}[0] = "freq: $hash->{Timer}";
$hash->{CHANGED}[1] = "cmd: $hash->{Cmd}";
# InternalTimer blocks if init_done is not true
my $oid = $init_done;
$init_done = 1;
SCIVT_GetStatus($hash);
$init_done = $oid;
return undef;
}
#####################################
sub
SCIVT_Set($@)
{
my ($hash, @a) = @_;
return "\"set SCIVT\" needs at least two parameter" if(@a < 3);
my $name = $hash->{NAME};
Log GetLogLevel($name,4), "SCIVT Set request $a[1] $a[2], old: Timer:$hash->{Timer} Cmd: $hash->{Cmd}";
return "Unknown argument $a[1], choose one of " . join(" ", sort keys %sets)
if(!defined($sets{$a[1]}));
$name = shift @a;
my $type = shift @a;
my $arg = join("", @a);
my $tn = TimeNow();
if($type eq "freq")
{
if ($arg > 0)
{
$hash->{Timer} = $arg * 60;
$hash->{READINGS}{$type}{TIME} = $tn;
$hash->{READINGS}{$type}{VAL} = $hash->{Timer};
$hash->{CHANGED}[0] = "$type: $hash->{Timer}";
}
}
if($type eq "cmd")
{
if ($arg eq "F")
{
$hash->{Cmd} = 'F'; # F : get all data
}
if ($arg eq "L") # L : get all data and clear min-/max values
{
$hash->{Cmd} = 'L';
}
$hash->{READINGS}{$type}{TIME} = $tn;
$hash->{READINGS}{$type}{VAL} = $hash->{Cmd};
$hash->{CHANGED}[0] = "$type: $hash->{Cmd}";
}
DoTrigger($name, undef) if($init_done);
Log GetLogLevel($name,3), "SCIVT Set result Timer:$hash->{Timer} sec Cmd:$hash->{Cmd}";
return "SCIVT => Timer:$hash->{Timer} Cmd:$hash->{Cmd}";
}
#####################################
sub
SCIVT_Get($@)
{
my ($hash, @a) = @_;
return "get for an SCIVT device needs exactly one parameter" if(@a != 2);
my $name = $hash->{NAME};
my $v;
if($a[1] eq "data")
{
$v = SCIVT_GetLine($hash->{DeviceName}, $hash->{Cmd});
if(!defined($v))
{
Log GetLogLevel($name,2), "SCIVT Get $a[1] error";
return "$a[0] $a[1] => Error";
}
$v =~ s/[\r\n]//g; # Delete the NewLine
$hash->{READINGS}{$a[1]}{VAL} = $v;
$hash->{READINGS}{$a[1]}{TIME} = TimeNow();
}
else
{
if($a[1] eq "param")
{
$v = "$hash->{DeviceName} $hash->{Timer} $hash->{Cmd}";
}
else
{
return "Unknown argument $a[1], must be data or param";
}
}
Log GetLogLevel($name,3), "SCIVT Get $a[1] $v";
return "$a[0] $a[1] => $v";
}
#####################################
sub
SCIVT_GetStatus($)
{
my ($hash) = @_;
my $dnr = $hash->{DEVNR};
my $name = $hash->{NAME};
# Call us in n minutes again.
InternalTimer(gettimeofday()+ $hash->{Timer}, "SCIVT_GetStatus", $hash,1);
my %vals;
my $result = SCIVT_GetLine($hash->{DeviceName}, $hash->{Cmd});
if(!defined($result))
{
Log GetLogLevel($name,4), "SCIVT read error, retry $hash->{DeviceName}, $hash->{Cmd}";
$result = SCIVT_GetLine($hash->{DeviceName}, $hash->{Cmd});
}
if(!defined($result))
{
Log GetLogLevel($name,2), "SCIVT read error, abort $hash->{DeviceName}, $hash->{Cmd}";
$hash->{STATE} = "timeout";
return $hash->{STATE};
}
if (length($result) < 10)
{
Log GetLogLevel($name,2), "SCIVT incomplete line ($result)";
$hash->{STATE} = "incomplete";
}
else
{
$result =~ s/^.*R://;
$result =~ s/[\r\n ]//g;
Log GetLogLevel($name,3), "SCIVT $result (raw)";
$result=~ s/,/./g;
my @data = split(";", $result);
my @names = ("Vs", "Is", "Temp", "minV", "maxV", "minI", "maxI");
my $tn = TimeNow();
for(my $i = 0; $i < int(@names); $i++)
{
$hash->{CHANGED}[$i] = "$names[$i]: $data[$i]";
$hash->{READINGS}{$names[$i]}{TIME} = $tn;
$hash->{READINGS}{$names[$i]}{VAL} = $data[$i];
}
DoTrigger($name, undef) if($init_done);
$result =~ s/;/ /g;
$hash->{STATE} = "$result";
}
return $hash->{STATE};
}
#####################################
sub
SCIVT_GetLine($$)
{
my $retry = 0;
my ($dev,$cmd) = @_;
return "R:13,66; 0,0;30;13,62;15,09;- 0,2; 2,8;\n"
if($dev eq "none"); # Fake-mode
my $serport = new Device::SerialPort ($dev);
if(!$serport) {
Log 1, "SCIVT: Can't open $dev: $!";
return undef;
}
$serport->reset_error();
$serport->baudrate(1200);
$serport->databits(8);
$serport->parity('none');
$serport->stopbits(1);
$serport->handshake('none');
my $rm = "SCIVT timeout reading the answer";
my $data="";
$serport->write($cmd);
sleep(1);
for(;;)
{
my ($rout, $rin) = ('', '');
vec($rin, $serport->FILENO, 1) = 1;
my $nfound = select($rout=$rin, undef, undef, 3.0);
if($nfound < 0) {
$rm = "SCIVT Select error $nfound / $!";
goto DONE;
}
last if($nfound == 0);
my $buf = $serport->input();
if(!defined($buf) || length($buf) == 0) {
$rm = "SCIVT EOF on $dev";
goto DONE;
}
$data .= $buf;
if($data =~ m/[\r\n]/) { # Newline received
$serport->close();
return $data;
}
}
DONE:
$serport->close();
Log 3, "SCIVT $rm";
return undef;
}
1;

475
fhem/FHEM/70_SISPM.pm
View File

@ -1,475 +0,0 @@
################################################################
#
# Copyright notice
#
# (c) 2009 Copyright: Kai 'wusel' Siering (wusel+fhem at uu dot org)
# All rights reserved
#
# This code 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.
#
# This copyright notice MUST APPEAR in all copies of the script!
###############################################
###########################
# 70_SISPM.pm
# Module for FHEM
#
# Contributed by Kai 'wusel' Siering <wusel+fhem@uu.org> in 2010
# Based in part on work for FHEM by other authors ...
# $Id: 70_SISPM.pm,v 1.5 2010-01-22 09:59:14 painseeker Exp $
###########################
package main;
use strict;
use warnings;
#####################################
sub
SISPM_Initialize($)
{
my ($hash) = @_;
# Consumer
$hash->{DefFn} = "SISPM_Define";
$hash->{Clients} =
":SIS_PMS:";
my %mc = (
"1:SIS_PMS" => "^socket ..:..:..:..:.. . state o.*",
);
$hash->{MatchList} = \%mc;
$hash->{AttrList}= "model:SISPM loglevel:0,1,2,3,4,5,6";
$hash->{ReadFn} = "SISPM_Read";
$hash->{WriteFn} = "SISPM_Write";
$hash->{UndefFn} = "SISPM_Undef";
}
#####################################
sub FixSISPMSerial($) {
my $serial=$_[0];
if(length($serial)!=length("..:..:..:..:..")){
my ($sn1, $sn2, $sn3, $sn4, $sn5) = split(":", $serial);
$serial=sprintf("%2s:%2s:%2s:%2s:%2s", substr($sn1, -2, 2), substr($sn2, -2, 2), substr($sn3, -2, 2), substr($sn4, -2, 2), substr($sn5, -2, 2));
$serial =~ s/ /0/g;
}
return $serial;
}
#####################################
sub
SISPM_GetCurrentConfig($)
{
my ($hash) = @_;
my $numdetected=0;
my $currentdevice=0;
my $FH;
my $i;
my $dev = sprintf("%s", $hash->{DeviceName});
Log 3, "SISPM_GetCurrentConfig: Using \"$dev\" as parameter to open(); trying ...";
# First, clear the old data! As we're addressing by hashes, keeping old data would be unwise.
if(defined($hash->{NUMUNITS}) && $hash->{NUMUNITS}>0) {
for($i=0; $i<$hash->{NUMUNITS}; $i++) {
my $serial;
if(defined($hash->{UNITS}{$i}{SERIAL})) {
$serial=$hash->{UNITS}{$i}{SERIAL};
delete $hash->{SERIALS}{$serial}{UNIT};
delete $hash->{SERIALS}{$serial}{USB};
}
if(defined($hash->{UNITS}{$i}{USB})) {
delete $hash->{UNITS}{$i}{USB};
delete $hash->{UNITS}{$i}{SERIAL};
}
}
}
$hash->{NUMUNITS}=0;
my $tmpdev=sprintf("%s -s 2>&1 |", $dev);
open($FH, $tmpdev);
if(!$FH) {
Log 3, "SISPM_GetCurrentConfig: Can't start $tmpdev: $!";
return "Can't start $tmpdev: $!";
}
local $_;
while (<$FH>) {
if(/^(No GEMBIRD SiS-PM found.)/) {
Log 3, "SISPM_GetCurrentConfig: Whoops? $1";
}
if(/^Gembird #(\d+) is USB device (\d+)./) {
Log 3, "SISPM_GetCurrentConfig: Found SISPM device number $1 as USB $2";
$hash->{UNITS}{$1}{USB}=$2;
$currentdevice=$1;
$numdetected++;
$hash->{NUMUNITS}=$numdetected;
}
if(/^This device has a serial number of (.*)/) {
my $serial=$1;
Log 3, "SISPM_GetCurrentConfig: Device number " . $currentdevice . " has serial $serial";
if(length($serial)!=length("..:..:..:..:..")){
$serial = FixSISPMSerial($serial);
Log 3, "SISPM_GetCurrentConfig: Whoopsi, weird serial format; fixing to $serial.";
}
$hash->{UNITS}{$currentdevice}{SERIAL}=$serial;
$hash->{SERIALS}{$serial}{UNIT}=$currentdevice;
$hash->{SERIALS}{$serial}{USB}=$hash->{UNITS}{$currentdevice}{USB};
}
}
close($FH);
Log 3, "SISPM_GetCurrentConfig: Initial read done";
if ($numdetected==0) {
Log 3, "SISPM_GetCurrentConfig: No SIMPM devices found.";
return "no SIMPM devices found.";
}
$hash->{NUMUNITS} = $numdetected;
$hash->{STATE} = "initialized";
return undef;
}
#####################################
sub
SISPM_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $numdetected=0;
my $currentdevice=0;
my $retval;
return "Define the /path/to/sispmctl as a parameter" if(@a != 3);
my $FH;
my $dev = sprintf("%s", $a[2]);
$hash->{DeviceName} = $dev;
Log 3, "SISPM using \"$dev\" as parameter to open(); trying ...";
$retval=SISPM_GetCurrentConfig($hash);
Log 3, "SISPM GetCurrentConfing done";
if(defined($retval)) {
Log 3, "SISPM: An error occured: $retval";
return $retval;
}
if($hash->{NUMUNITS} < 1) {
return "SISPM no SIMPM devices found.";
}
$hash->{Timer} = 30;
Log 3, "SISPM setting callback timer";
my $oid = $init_done;
$init_done = 1;
InternalTimer(gettimeofday()+ $hash->{Timer}, "SISPM_GetStatus", $hash, 1);
$init_done = $oid;
Log 3, "SISPM initialized";
return undef;
}
#####################################
sub
SISPM_Undef($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $name = $hash->{NAME};
if(defined($hash->{FD})) {
close($hash->{FD});
delete $hash->{FD};
}
delete $selectlist{"$name.pipe"};
$hash->{STATE}='undefined';
Log 3, "$name shutdown complete";
return undef;
}
#####################################
sub
SISPM_GetStatus($)
{
my ($hash) = @_;
my $dnr = $hash->{DEVNR};
my $name = $hash->{NAME};
my $dev = $hash->{DeviceName};
my $FH;
my $i;
# Call us in n seconds again.
# InternalTimer(gettimeofday()+ $hash->{Timer}, "SISPM_GetStatus", $hash, 1);
Log 4, "SISPM contacting device";
my $tmpdev=sprintf("%s -s ", $dev);
for($i=0; $i<$hash->{NUMUNITS}; $i++) {
$tmpdev=sprintf("%s -d %d -g all ", $tmpdev, $i);
}
$tmpdev=sprintf("%s 2>&1 |", $tmpdev);
open($FH, $tmpdev);
if(!$FH) {
return "SISPM Can't open pipe: $dev: $!";
}
$hash->{FD}=$FH;
$selectlist{"$name.pipe"} = $hash;
Log 4, "SISPM pipe opened";
$hash->{STATE} = "running";
$hash->{pipeopentime} = time();
# InternalTimer(gettimeofday() + 6, "SISPM_Read", $hash, 1);
# return $hash->{STATE};
}
#####################################
sub
SISPM_Read($)
{
my ($hash) = @_;
my $dnr = $hash->{DEVNR};
my $name = $hash->{NAME};
my $dev = $hash->{DeviceName};
my $FH;
my $inputline;
Log 4, "SISPM Read entered";
if(!defined($hash->{FD})) {
Log 3, "Oops, SISPM FD undef'd";
return undef;
}
if(!$hash->{FD}) {
Log 3, "Oops, SISPM FD empty";
return undef;
}
$FH = $hash->{FD};
Log 4, "SISPM reading started";
my @lines;
my $eof;
my $i=0;
my $tn = TimeNow();
my $reading;
my $readingforstatus;
my $currentserial="none";
my $currentdevice=0;
my $currentusbid=0;
my $renumbered=0;
my $newPMfound=0;
($eof, @lines) = nonblockGetLinesSISPM($FH);
if(!defined($eof)) {
Log 4, "SISPM FIXME: eof undefined?!";
$eof=0;
}
Log 4, "SISPM reading ended with eof==$eof";
# FIXME! Current observed behaviour is "would block", then read of only EOF.
# Not sure if it's always that way; more correct would be checking
# for empty $inputline or undef'd $rawreading,$val. -wusel, 2010-01-04
if($eof != 1) {
foreach my $inputline ( @lines ) {
$inputline =~ s/\s+$//;
# wusel, 2010-01-16: Seems as if reading not always works as expected;
# throw away the whole readings if there's a NULL
# serial number.
if($currentserial eq "00:00:00:00:00") {
next;
}
# wusel, 2010-01-19: Multiple (2) SIS PM do work now. But USB renumbering will still
# break things rather badly. Thinking about dropping it altogether,
# that is wipe old state data ($hash->{UNITS} et. al.) and rebuild
# data each time from scratch. That should work as SIS_PMS uses the
# serial as key; unfortunately, sispmctl doesn't offer this (and it
# wont work due to those FFFFFFxx readings), so we need to keep
# track of unit number <-> serial ... But if between reading this
# data and a "set" statement something changes, we still could switch
# the wrong socket.
#
# As sispmctl 2.7 is broken already for multiple invocations with -d,
# I consider fixing both the serial number issue as well as add the
# serial as selector ... Drat. Instead of getting the ToDo list shorter,
# it just got longer ;-)
if($inputline =~ /^(No GEMBIRD SiS-PM found.)/) {
Log 3, "SISPM Whoopsie? $1";
next;
}
if($inputline =~ /^Gembird #(\d+) is USB device (\d+)\./ ||
$inputline =~ /^Accessing Gembird #(\d+) USB device (\d+)/) {
Log 5, "SISPM found SISPM device number $1 as USB $2";
if($1 < $hash->{NUMUNITS}) {
if($hash->{UNITS}{$1}{USB}!=$2) {
Log 3, "SISPM: USB ids changed (unit $1 is now USB $2 but was " . $hash->{UNITS}{$1}{USB} . "); will fix.";
$renumbered=1;
$hash->{FIXRENUMBER}="yes";
}
} else { # Something wonderful has happened, we have a new SIS PM!
Log 3, "SISPM: Wuuuhn! Found a new unit $1 as USB $2. Will assimilate it.";
$newPMfound=1;
$hash->{FIXNEW}="yes";
}
$currentdevice=$1;
$currentusbid=$2;
$currentserial="none";
if(defined($hash->{UNITS}{$currentdevice}{SERIAL})) {
$currentserial=$hash->{UNITS}{$currentdevice}{SERIAL};
}
}
if($inputline =~ /^This device has a serial number of (.*)/) {
$currentserial=FixSISPMSerial($1);
if($currentserial eq "00:00:00:00:00") {
Log 3, "SISPM Whooopsie! Your serial nullified ($currentserial). Skipping ...";
next;
}
if($newPMfound==1) {
$hash->{UNITS}{$currentdevice}{USB}=$currentusbid;
$hash->{UNITS}{$currentdevice}{SERIAL}=$currentserial;
$hash->{SERIALS}{$currentserial}{UNIT}=$currentdevice;
$hash->{SERIALS}{$currentserial}{USB}=$currentusbid;
$hash->{NUMUNITS}+=1;
}
}
if($inputline =~ /^Status of outlet (\d):\s+(.*)/) {
if($currentserial ne "none") {
Log 5, "SISPM found socket $1 on $currentserial, state $2";
my $dmsg="socket " . $currentserial . " $1 state " . $2;
my %addvals;
Dispatch($hash, $dmsg, \%addvals);
} else {
Log 3, "SISPM Whooopsie! Found socket $1, state $2, but no serial (serial is $currentserial)?";
}
}
}
}
if($eof) {
close($FH);
delete $hash->{FD};
delete $selectlist{"$name.pipe"};
InternalTimer(gettimeofday()+ $hash->{Timer}, "SISPM_GetStatus", $hash, 1);
$hash->{STATE} = "read";
Log 4, "SISPM done reading pipe";
if(defined($hash->{FIXRENUMBER}) || defined($hash->{FIXNEW})) {
my $retval;
Log 3, "SISPM now adapts to new environment ...";
$retval=SISPM_GetCurrentConfig($hash);
if(defined($retval)) {
Log 3, "SISPM an error occured during reconfiguration: $retval";
}
if(defined($hash->{FIXRENUMBER})) {
delete $hash->{FIXRENUMBER};
}
if(defined($hash->{FIXNEW})) {
delete $hash->{FIXNEW};
}
}
} else {
$hash->{STATE} = "reading";
Log 4, "SISPM (further) reading would block";
}
}
#####################################
sub SISPM_Write($$$) {
my ($hash,$fn,$msg) = @_;
my $dev = $hash->{DeviceName};
# Log 3, "SISPM_Write entered for $hash->{NAME} with $fn and $msg";
my ($serial, $socket, $what) = split(' ', $msg);
my $deviceno;
my $cmdline;
my $cmdletter="t";
if($what eq "on") {
$cmdletter="o";
} elsif($what eq "off") {
$cmdletter="f";
}
if(defined($hash->{SERIALS}{$serial}{UNIT})) {
$deviceno=($hash->{SERIALS}{$serial}{UNIT});
$cmdline=sprintf("%s -d %d -%s %d 2>&1 >/dev/null", $dev, $deviceno, $cmdletter, $socket);
system($cmdline);
} else {
Log 2, "SISPM_Write can not find SISPM device with serial $serial";
}
return;
}
# From http://www.perlmonks.org/?node_id=713384 / http://davesource.com/Solutions/20080924.Perl-Non-blocking-Read-On-Pipes-Or-Files.html
#
# Used, hopefully, with permission ;)
#
# An non-blocking filehandle read that returns an array of lines read
# Returns: ($eof,@lines)
my %nonblockGetLines_lastSISPM;
sub nonblockGetLinesSISPM {
my ($fh,$timeout) = @_;
$timeout = 0 unless defined $timeout;
my $rfd = '';
$nonblockGetLines_lastSISPM{$fh} = ''
unless defined $nonblockGetLines_lastSISPM{$fh};
vec($rfd,fileno($fh),1) = 1;
return unless select($rfd, undef, undef, $timeout)>=0;
# I'm not sure the following is necessary?
return unless vec($rfd,fileno($fh),1);
my $buf = '';
my $n = sysread($fh,$buf,1024*1024);
# If we're done, make sure to send the last unfinished line
return (1,$nonblockGetLines_lastSISPM{$fh}) unless $n;
# Prepend the last unfinished line
$buf = $nonblockGetLines_lastSISPM{$fh}.$buf;
# And save any newly unfinished lines
$nonblockGetLines_lastSISPM{$fh} =
(substr($buf,-1) !~ /[\r\n]/ && $buf =~ s/([^\r\n]*)$//)
? $1 : '';
$buf ? (0,split(/\n/,$buf)) : (0);
}
1;

645
fhem/FHEM/70_USBWX.pm
View File

@ -1,645 +0,0 @@
#################################################################################
# 70_USBWX.pm
# Module for FHEM to receive sensors via ELV USB-WDE1
#
# derived from previous 70_USBWX.pm version written by "Peter from Vienna"
#
# Willi Herzig, 2011
#
# 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.
#
##############################################
package main;
use strict;
use warnings;
use Device::SerialPort;
#####################################
sub
USBWX_Initialize($)
{
my ($hash) = @_;
$hash->{ReadFn} = "USBWX_Read";
$hash->{ReadyFn} = "USBWX_Ready";
# Normal devices
$hash->{DefFn} = "USBWX_Define";
$hash->{UndefFn} = "USBWX_Undef";
$hash->{GetFn} = "USBWX_Get";
$hash->{SetFn} = "USBWX_Set";
$hash->{ParseFn} = "USBWX_Parse";
$hash->{StateFn} = "USBWX_SetState";
$hash->{Match} = ".*";
#$hash->{AttrList}= "model:USB-WDE1 loglevel:0,1,2,3,4,5,6";
$hash->{AttrList}= "loglevel:0,1,2,3,4,5,6";
$hash->{ShutdownFn} = "USBWX_Shutdown";
}
#####################################
sub
USBWX_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "wrong syntax: 'define <name> USBWX <devicename>' or define <name> USBWX <code> [<corr1>...<corr4>]"
if(@a < 3);
if ($a[2] =~/^[0-9].*/) {
# define <name> USBWX <code> [<corr1>...<corr4>]
return "wrong syntax: define <name> USBWX <code> [corr1...corr4]"
if(int(@a) < 3 || int(@a) > 7);
return "Define $a[0]: wrong CODE format: valid is 1-8"
if($a[2] !~ m/^[1-9]$/);
#Log 1,"USBWX_Define def=$def";
my $name = $a[0];
my $code = $a[2];
$hash->{CODE} = $code;
$hash->{corr1} = ((int(@a) > 3) ? $a[3] : 0);
$hash->{corr2} = ((int(@a) > 4) ? $a[4] : 0);
$hash->{corr3} = ((int(@a) > 5) ? $a[5] : 0);
$hash->{corr4} = ((int(@a) > 6) ? $a[6] : 0);
$modules{USBWX}{defptr}{$code} = $hash;
#AssignIoPort($hash);
} else {
# define <name> USBWX <devicename>
return "wrong syntax: define <name> USBWX <devicename>"
if(@a != 3);
USBWX_CloseDev($hash);
my $name = $a[0];
my $dev = $a[2];
if($dev eq "none") {
Log 1, "USBWX $name device is none, commands will be echoed only";
$attr{$name}{dummy} = 1;
return undef;
}
$hash->{DeviceName} = $dev;
my $ret = USBWX_OpenDev($hash, 0);
return $ret;
}
return undef;
}
#####################################
sub
USBWX_OpenDev($$)
{
my ($hash, $reopen) = @_;
my $dev = $hash->{DeviceName};
my $name = $hash->{NAME};
my $po;
#Log 1, "USBWX opening $name device $dev reopen = $reopen";
$hash->{PARTIAL} = "";
Log 3, "USBWX opening $name device $dev"
if(!$reopen);
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(2, "USBWX Can't open $dev: $!");
$readyfnlist{"$name.$dev"} = $hash;
$hash->{STATE} = "disconnected";
return "";
}
$hash->{USBWX} = $po;
if( $^O =~ /Win/ ) {
$readyfnlist{"$name.$dev"} = $hash;
} else {
$hash->{FD} = $po->FILENO;
delete($readyfnlist{"$name.$dev"});
$selectlist{"$name.$dev"} = $hash;
}
$po->baudrate(9600) || Log 1, "USBWX could not set baudrate";
$po->databits(8) || Log 1, "USBWX could not set databits";
$po->parity('none') || Log 1, "USBWX could not set parity";
$po->stopbits(1) || Log 1, "USBWX could not set stopbits";
$po->handshake('none') || Log 1, "USBWX could not set handshake";
#$po->reset_error() || Log 1, "USBWX reset_error";
$po->lookclear || Log 1, "USBWX could not set lookclear";
$po->write_settings || Log 1, "USBWX could not write_settings $dev";
if($reopen) {
Log 1, "USBWX $dev reappeared ($name)";
} else {
Log 2, "USBWX opened device $dev";
}
$hash->{po} = $po;
$hash->{socket} = 0;
$hash->{STATE}=""; # Allow InitDev to set the state
my $ret = USBWX_DoInit($hash);
if($ret) {
# try again
Log 1, "USBWX Cannot init $dev, at first try. Trying again.";
my $ret = USBWX_DoInit($hash);
if($ret) {
USBWX_CloseDev($hash);
Log 1, "USBWX Cannot init $dev, ignoring it";
return "USBWX Error Init string.";
}
}
DoTrigger($name, "CONNECTED") if($reopen);
#return undef;
return $ret;
}
########################
sub
USBWX_CloseDev($)
{
my ($hash) = @_;
my $name = $hash->{NAME};
my $dev = $hash->{DeviceName};
return if(!$dev);
Log 1, "USBWX: closing $dev";
$hash->{USBWX}->close() ;
delete($hash->{USBWX});
delete($selectlist{"$name.$dev"});
delete($readyfnlist{"$name.$dev"});
delete($hash->{FD});
}
#####################################
sub
USBWX_Ready($)
{
my ($hash) = @_;
return USBWX_OpenDev($hash, 1)
if($hash->{STATE} eq "disconnected");
# This is relevant for windows/USB only
my $po = $hash->{USBWX};
my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags) = $po->status;
return ($InBytes>0);
}
#####################################
sub
USBWX_SetState($$$$)
{
my ($hash, $tim, $vt, $val) = @_;
return undef;
}
#####################################
sub
USBWX_Clear($)
{
my $hash = shift;
my $buf;
# clear buffer:
if($hash->{USBWX})
{
while ($hash->{USBWX}->lookfor())
{
$buf = USBWX_SimpleRead($hash);
}
}
return $buf;
}
#####################################
sub
USBWX_DoInit($)
{
my $hash = shift;
my $name = $hash->{NAME};
my $init ="?";
my $buf;
USBWX_Clear($hash);
USBWX_SimpleWrite($hash, $init);
return undef;
}
#####################################
sub USBWX_Undef($$)
{
my ($hash, $arg) = @_;
my $name = $hash->{NAME};
delete $hash->{FD};
$hash->{STATE}='close';
$hash->{USBWX}->close() if($hash->{USBWX});
Log 2, "$name shutdown complete";
return undef;
}
#####################################
# called from the global loop, when the select for hash->{FD} reports data
sub
USBWX_Read($)
{
my ($hash) = @_;
my $name = $hash->{NAME};
my $char;
#Log 4, "USBWX Read State:$hash->{STATE}";
my $mybuf = USBWX_SimpleRead($hash);
my $usbwx_data = $hash->{PARTIAL};
#Log 1, "USBWX usbwxdata='$usbwx_data' $mybuf='$mybuf'";
if(!defined($mybuf) || length($mybuf) == 0) {
USBWX_Disconnected($hash);
return "";
}
if ( ( length($usbwx_data) > 1) && ($mybuf eq "\n") ) {
Log 4, "USBWX/RAW line: '$usbwx_data'";
#Log 1, "USBWX/RAW line='$usbwx_data'";
}
if ($mybuf eq "\n") {
USBWX_Parse($hash, $usbwx_data);
$hash->{PARTIAL} = "";
} else {
$usbwx_data .= $mybuf;
$hash->{PARTIAL} = $usbwx_data;
}
}
#####################################
sub
USBWX_Shutdown($)
{
my ($hash) = @_;
return undef;
}
#####################################
sub
USBWX_Set($@)
{
my ($hash, @a) = @_;
my $msg;
my $name=$a[0];
my $reading= $a[1];
$msg="$name => No Set function ($reading) implemented";
Log 1,$msg;
return $msg;
}
#####################################
sub
USBWX_Get($@)
{
my ($hash, @a) = @_;
my $msg;
my $name=$a[0];
my $reading= $a[1];
$msg="$name => No Get function ($reading) implemented";
Log 1,$msg;
return $msg;
}
########################
sub
USBWX_SimpleRead($)
{
my ($hash) = @_;
my $buf;
if($hash->{USBWX})
{
$buf = $hash->{USBWX}->read(1) ;
if (!defined($buf) || length($buf) == 0)
{
$buf = $hash->{USBWX}->read(1) ;
}
# Log 4, "USBWX SimpleRead=>$buf";
return $buf;
}
return undef;
}
########################
sub
USBWX_SimpleWrite(@)
{
my ($hash, $msg) = @_;
return if(!$hash);
$hash->{USBWX}->write($msg) if($hash->{USBWX});
Log 4, "USBWX SimpleWrite $msg";
select(undef, undef, undef, 0.001);
}
# -----------------------------
# Dewpoint calculation.
# see http://www.faqs.org/faqs/meteorology/temp-dewpoint/ "5. EXAMPLE"
sub
dewpoint($$)
{
my ($temperature, $humidity) = @_;
my $dp;
my $A = 17.2694;
my $B = ($temperature > 0) ? 237.3 : 265.5;
my $es = 610.78 * exp( $A * $temperature / ($temperature + $B) );
my $e = $humidity/ 100 * $es;
if ($e == 0) {
Log 1, "Error: dewpoint() e==0: temp=$temperature, hum=$humidity";
return 0;
}
my $e1 = $e / 610.78;
my $f = log( $e1 ) / $A;
my $f1 = 1 - $f;
if ($f1 == 0) {
Log 1, "Error: dewpoint() (1-f)==0: temp=$temperature, hum=$humidity";
return 0;
}
$dp = $B * $f / $f1 ;
return($dp);
}
#####################################
sub
USBWX_Parse($$)
{
my ($hash,$rmsg) = @_;
$rmsg =~ s/[\r\n]//g;
#Log 4, "USBWX Parse Msg:$rmsg, State:$hash->{STATE}";
# Testmessages
#$rmsg = "\$1;1;;;;;;;23,5;21,0;24,2;;;;;;36;42;;16,8;39;6,1;5;0;0";
if ($rmsg =~ /^\$1;.*/) {
#$1;1;;23,9;;23,6;24,3;;;26,0;;56;;59;58;;;54;;;;;;;0
#$1;1;;;;;;;;;;;;;;;;;;;;;;;0
Log 4, "USBWX Parse Msg:'$rmsg', State:$hash->{STATE}";
# Reset to clear data already read. Otherwise data will be read multiple times.
USBWX_SimpleWrite($hash, "RESET");
my @c = split(";", $rmsg);
#Log 4, "USBWX T1:$c[3] T2:$c[4] T3:$c[5] T4:$c[6] T5:$c[7] T6:$c[8] T7:$c[9] T8:$c[10]";
$rmsg =~ s/,/./g; # format for FHEM
my @data = split(";", $rmsg);
my @names = ("1", "2", "3", "4", "5", "6", "7", "8");
my $tm = TimeNow();
# perform sensors with ID 1 up to 8
for(my $i = 0; $i < int(@names); $i++) {
my $sensor = "";
my $val = "";
my $current;
if ($data[$i+3] ne "") { # only for existing sensors
my $n = 0;
my $device_name = $names[$i];
my $code = $i+1;
#Log 1, "i=$i, device_name=$device_name code=$code";
my $def = $modules{USBWX}{defptr}{"$device_name"};
if(!$def) {
Log 3, "USBWX: Unknown device USBWX_$device_name, please define it";
#Log 1, "USBWX: Unknown device USBWX_$device_name, please define it";
my $ret = "UNDEFINED USBWX_$device_name USBWX $device_name";
DoTrigger("global", $ret);
return undef;
}
my $name = $def->{NAME};
my $temperature = $data[$i+3] + $def->{corr1};;
$current = $temperature;
$val .= "T: ".$current." ";
$sensor = "temperature";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current;
$def->{CHANGED}[$n++] = $sensor . ": " . $current;
if ($data[$i+11] ne "") {
my $humidity = $data[$i+11] + $def->{corr2};;
$current = $humidity;
$val .= "H: ".$current." ";
$sensor = "humidity";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current;
$def->{CHANGED}[$n++] = $sensor . ": " . $current;
my $dewpoint = sprintf("%.1f", dewpoint($temperature,$humidity));
$current = $dewpoint;
$sensor = "dewpoint";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current;
$def->{CHANGED}[$n++] = $sensor . ": " . $current;
}
#Log 1, "i=$i, device_name=$device_name temp=$temperature, hum=$humidity";
if ("$val" ne "") {
$def->{STATE} = $val;
$def->{TIME} = $tm;
$def->{CHANGED}[$n++] = $val;
}
DoTrigger($name, undef);
}
}
# Look for KS300 data:
if ($data[19] ne "") {
my $n = 0;
my $sensor = "";
my $val = "";
my $current;
my $ks300_temperature = $data[19]; # KS300 temperature
my $ks300_humidity = $data[20]; # KS300 humidity
my $ks300_windspeed = $data[21]; # KS300 windspeed km/h
my $ks300_rain = $data[22]; # KS300 rain (units)
my $ks300_israining = $data[23]; # KS300 rain indicator 1=yes, 0=no
Log 4, "USBWX Parse KS300 data found $ks300_temperature, $ks300_humidity, $ks300_windspeed, $ks300_rain, $ks300_israining ";
my $device_name = "9";
my $def = $modules{USBWX}{defptr}{"$device_name"};
if(!$def) {
Log 3, "USBWX: Unknown device USBWX_ks300, please define it";
#Log 1, "USBWX: Unknown device USBWX_ks300, please define it";
my $ret = "UNDEFINED USBWX_ks300 USBWX $device_name";
DoTrigger("global", $ret);
return undef;
}
my $name = $def->{NAME};
$current = $ks300_temperature;
$val .= "T: ".$current." ";
$sensor = "temperature";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current;
$def->{CHANGED}[$n++] = $sensor . ": " . $current;
$current = $ks300_humidity;
$val .= "H: ".$current." ";
$sensor = "humidity";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current;
$def->{CHANGED}[$n++] = $sensor . ": " . $current;
my $dewpoint = sprintf("%.1f", dewpoint($ks300_temperature,$ks300_humidity));
$current = $dewpoint;
$sensor = "dewpoint";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current;
$def->{CHANGED}[$n++] = $sensor . ": " . $current;
$current = $ks300_windspeed;
$val .= "W: ".$current." ";
$sensor = "wind";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current;
$def->{CHANGED}[$n++] = $sensor . ": " . $current;
$current = $ks300_rain;
$sensor = "rain_raw";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current;
$def->{CHANGED}[$n++] = $sensor . ": " . $current;
$current = $ks300_rain * 255 / 1000;
$val .= "R: ".$current." ";
$sensor = "rain";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current;
$def->{CHANGED}[$n++] = $sensor . ": " . $current;
$current = $ks300_israining ? "yes" : "no";
$val .= "IR: ".$current." ";
$sensor = "israining";
$def->{READINGS}{$sensor}{TIME} = $tm;
$def->{READINGS}{$sensor}{VAL} = $current;
$def->{CHANGED}[$n++] = $sensor . ": " . $current;
$def->{STATE} = $val;
$def->{TIME} = $tm;
$def->{CHANGED}[$n++] = $val;
DoTrigger($name, undef);
}
} elsif ($rmsg =~ /^ELV.*/) {
#ELV USB-WDE1 v1.1
#Baud:9600bit/s
#Mode:LogView
Log 4, "USBWX Parse ID";
my @c = split(" ", $rmsg);
if ($c[1] eq "USB-WDE1") {
Log 4, "USBWX $c[1] $c[2] found";
$rmsg =~ s/[\r\n]/ /g;
$hash->{READINGS}{"status"}{VAL} = $rmsg;
$hash->{READINGS}{"status"}{TIME} = TimeNow();
}
} elsif ($rmsg =~ /^Mod.*/) {
Log 4, "USBWX Parse mode $rmsg";
my @c = split(":", $rmsg);
my @d = split("\n", $c[1]);
$d[0] =~ s/[\r\n]//g; # Delete the NewLine
Log 4, "USBWX Parse mode >$d[0]<";
if ($d[0] eq "LogView") {
Log 2, "USBWX in $c[0] $d[0] found. rmsg=$rmsg";
#Log 2, "USBWX in $c[0] $d[0] found";
$hash->{STATE} = "Initialized";
$hash->{READINGS}{"mode"}{VAL} = $d[0];
$hash->{READINGS}{"mode"}{TIME} = TimeNow();
}
} elsif ($rmsg =~ /^Baud.*/) {
Log 4, "USBWX BAUD rmsg='$rmsg'";
} elsif ($rmsg =~ /^OK.*/) {
Log 4, "USBWX EMPTY rmsg='$rmsg'";
} elsif ($rmsg =~ /^FullBuff/) {
Log 1, "USBWX Fullbuf-Error rmsg='$rmsg'";
Log 1, "USBWX closing device";
USBWX_Disconnected($hash);
Log 1, "USBWX opening device";
my $ret = USBWX_OpenDev($hash, 0);
} elsif ($rmsg eq "") {
Log 4, "USBWX OK rmsg='$rmsg'";
} else {
Log 2, "USBWX unknown: '$rmsg'";
}
return undef;
}
#####################################
sub
USBWX_Disconnected($)
{
my $hash = shift;
my $dev = $hash->{DeviceName};
my $name = $hash->{NAME};
return if(!defined($hash->{FD})); # Already deleted
Log 1, "USBWX dev='$dev' name='$name' disconnected, waiting to reappear";
USBWX_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;

445
fhem/FHEM/70_WS3600.pm
View File

@ -1,445 +0,0 @@
################################################################
#
# Copyright notice
#
# (c) 2009 Copyright: Kai 'wusel' Siering (wusel+fhem at uu dot org)
# All rights reserved
#
# This code 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.
#
# This copyright notice MUST APPEAR in all copies of the script!
###############################################
package main;
###########################
# 70_WS3600.pm
# Modul for FHEM
#
# Contributed by Kai 'wusel' Siering <wusel+fhem@uu.org> in 2009/2010
# Based in part on work for FHEM by other authors ...
# $Id: 70_WS3600.pm,v 1.3 2010-01-30 16:25:37 painseeker Exp $
###########################
use strict;
use warnings;
#use Device::SerialPort;
my %sets = (
"cmd" => "",
"freq" => "",
);
my %TranslatedCodes = (
"Date" => "Date",
"Time" => "Time",
"Ti" => "Temp-inside",
"Timin" => "Temp-inside-min",
"Timax" => "Temp-inside-max",
"TTimin" => "Temp-inside-min-Time",
"DTimin" => "Temp-inside-min-Date",
"TTimax" => "Temp-inside-max-Time",
"DTimax" => "Temp-inside-max-Date",
"To" => "Temp-outside",
"Tomin" => "Temp-outside-min",
"Tomax" => "Temp-outside-max",
"TTomin" => "Temp-outside-min-Time",
"DTomin" => "Temp-outside-min-Date",
"TTomax" => "Temp-outside-max-Time",
"DTomax" => "Temp-outside-max-Date",
"DP" => "Dew-Point",
"DPmin" => "Dew-Point-min",
"DPmax" => "Dew-Point-max",
"TDPmin" => "Dew-Point-min-Time",
"DDPmin" => "Dew-Point-min-Date",
"TDPmax" => "Dew-Point-min-Time",
"DDPmax" => "Dew-Point-min-Date",
"RHi" => "rel-Humidity-inside",
"RHimin" => "rel-Humidity-inside-min",
"RHimax" => "rel-Humidity-inside-max",
"TRHimin" => "rel-Humidity-inside-min-Time",
"DRHimin" => "rel-Humidity-inside-min-Date",
"TRHimax" => "rel-Humidity-inside-max-Time",
"DRHimax" => "rel-Humidity-inside-max-Date",
"RHo" => "rel-Humidity-outside",
"RHomin" => "rel-Humidity-outside-min",
"RHomax" => "rel-Humidity-outside-max",
"TRHomin" => "rel-Humidity-outside-min-Time",
"DRHomin" => "rel-Humidity-outside-min-Date",
"TRHomax" => "rel-Humidity-outside-max-Time",
"DRHomax" => "rel-Humidity-outside-max-Date",
"WS" => "Wind-Speed",
"DIRtext" => "Wind-Direction-Text",
"DIR0" => "Wind-DIR0",
"DIR1" => "Wind-DIR1",
"DIR2" => "Wind-DIR2",
"DIR3" => "Wind-DIR3",
"DIR4" => "Wind-DIR4",
"DIR5" => "Wind-DIR5",
"WC" => "Wind-Chill",
"WCmin" => "Wind-Chill-min",
"WCmax" => "Wind-Chill-max",
"TWCmin" => "Wind-Chill-min-Time",
"DWCmin" => "Wind-Chill-min-Date",
"TWCmax" => "Wind-Chill-max-Time",
"DWCmax" => "Wind-Chill-max-Date",
"WSmin" => "Wind-Speed-min",
"WSmax" => "Wind-Speed-max",
"TWSmin" => "Wind-Speed-min-Time",
"DWSmin" => "Wind-Speed-min-Date",
"TWSmax" => "Wind-Speed-max-Time",
"DWSmax" => "Wind-Speed-max-Date",
"R1h" => "Rain-1h",
"R1hmax" => "Rain-1h-hmax",
"TR1hmax" => "Rain-1h-hmax-Time",
"DR1hmax" => "Rain-1h-hmax-Date",
"R24h" => "Rain-24h",
"R24hmax" => "Rain-24-hmax",
"TR24hmax" => "Rain-24h-max-Time",
"DR24hmax" => "Rain-24h-max-Date",
"R1w" => "Rain-1w",
"R1wmax" => "Rain-1w-max",
"TR1wmax" => "Rain-1w-max-Time",
"DR1wmax" => "Rain-1w-max-Date",
"R1m" => "Rain-1M",
"R1mmax" => "Rain-1M-max",
"TR1mmax" => "Rain-1M-max-Time",
"DR1mmax" => "Rain-1M-max-Date",
"Rtot" => "Rain-total",
"TRtot" => "Rain-total-Time",
"DRtot" => "Rain-total-Date",
"RP" => "rel-Pressure",
"AP" => "abs-Pressure",
"RPmin" => "rel-Pressure-min",
"RPmax" => "rel-Pressure-max",
"TRPmin" => "rel-Pressure-min-Time",
"DRPmin" => "rel-Pressure-min-Date",
"TRPmax" => "rel-Pressure-max-Time",
"DRPmax" => "rel-Pressure-max-Date",
"Tendency" => "Tendency",
"Forecast" => "Forecast",
);
my %WantedCodesForStatus = (
"Ti" => "Ti:",
"To" => "T:",
"DP" => "DP:",
"RHi" => "Hi:",
"RHo" => "H:",
"WS" => "W:",
"DIRtext" => "Dir:",
"WC" => "WC:",
"R1h" => "R:",
"RP" => "P:",
"Tendency" => "Tendency:",
"Forecast" => "Forecast:",
);
#####################################
sub
WS3600_Initialize($)
{
my ($hash) = @_;
# Consumer
$hash->{DefFn} = "WS3600_Define";
$hash->{AttrList}= "model:WS3600,WS2300 loglevel:0,1,2,3,4,5,6";
$hash->{ReadFn} = "WS3600_Read";
$hash->{UndefFn} = "WS3600_Undef";
}
#####################################
sub
WS3600_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "Define the /path/to/fetch3600 as a parameter" if(@a != 3);
my $FH;
my $dev = sprintf("%s |", $a[2]);
Log 3, "WS3600 using \"$dev\" as parameter to open(); trying ...";
open($FH, $dev);
if(!$FH) {
return "WS3600 Can't start $dev: $!";
}
local $_;
while (<$FH>) {
# my ($reading, $val)=split(/ /, $_);
if(/^(Date) (.*)/ || /^(Time) (.*)/ || /^(Ti) (.*)/ || /^(To) (.*)/) {
Log 3, "WS3600 initial read: $1 $2";
}
}
close($FH);
Log 3, "WS3600 initial read done";
$hash->{DeviceName} = $dev;
$hash->{Timer} = 64; # call every 64 seconds; normal wireless update interval
# is 128 sec, on wind >10 km/h 32 sec. 64 sec should ensure
# quite current data.
# my $tn = TimeNow();
# $hash->{READINGS}{"freq"}{TIME} = $tn;
# $hash->{READINGS}{"freq"}{VAL} = $hash->{Timer};
# $hash->{CHANGED}[0] = "freq: $hash->{Timer}";
# InternalTimer blocks if init_done is not true
# my $oid = $init_done;
# $init_done = 1;
# WS3600_GetStatus($hash);
# $init_done = $oid;
Log 3, "WS3600 setting callback timer";
my $oid = $init_done;
$init_done = 1;
InternalTimer(gettimeofday()+ $hash->{Timer}, "WS3600_GetStatus", $hash, 1);
$init_done = $oid;
Log 3, "WS3600 initialized";
$hash->{STATE} = "initialized";
$hash->{TMPSTATE} = "";
return undef;
}
#####################################
sub
WS3600_Undef($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $name = $hash->{NAME};
if(defined($hash->{FD})) {
close($hash->{FD});
delete $hash->{FD};
}
delete $selectlist{"$name.pipe"};
$hash->{STATE}='undefined';
Log GetLogLevel($name,3), "$name shutdown complete";
return undef;
}
#####################################
sub
WS3600_GetStatus($)
{
my ($hash) = @_;
my $dnr = $hash->{DEVNR};
my $name = $hash->{NAME};
my $dev = $hash->{DeviceName};
my $FH;
# Call us in n seconds again.
# InternalTimer(gettimeofday()+ $hash->{Timer}, "WS3600_GetStatus", $hash, 1);
Log GetLogLevel($name,4), "WS3600 contacting station";
open($FH, $dev);
if(!$FH) {
return "WS3600 Can't start $dev: $!";
}
$hash->{FD}=$FH;
$selectlist{"$name.pipe"} = $hash;
Log GetLogLevel($name,4), "WS3600 pipe opened";
# $hash->{STATE} = "running";
$hash->{pipeopentime} = time();
# InternalTimer(gettimeofday() + 6, "WS3600_Read", $hash, 1);
return $hash->{STATE};
}
#####################################
sub
WS3600_Read($)
{
my ($hash) = @_;
my $dnr = $hash->{DEVNR};
my $name = $hash->{NAME};
my $dev = $hash->{DeviceName};
my $FH;
my $inputline;
Log GetLogLevel($name,4), "WS3600 Read entered";
if(!defined($hash->{FD})) {
Log GetLogLevel($name,3), "Oops, WS3600 FD undef'd";
return undef;
}
if(!$hash->{FD}) {
Log GetLogLevel($name,3), "Oops, WS3600 FD empty";
return undef;
}
$FH = $hash->{FD};
Log GetLogLevel($name,4), "WS3600 reading started";
my @lines;
my $eof;
my $i=0;
my $tn = TimeNow();
my $StateString=$hash->{TMPSTATE};
my $HumidString="";
my $TempsString="";
my $OtherString="";
my $reading;
my $readingforstatus;
($eof, @lines) = nonblockGetLines($FH);
if(!defined($eof)) {
Log GetLogLevel($name,4), "WS3600 FIXME: eof undefined?!";
$eof=0;
}
Log GetLogLevel($name,4), "WS3600 reading ended with eof==$eof";
# FIXME! Current observed behaviour is "would block", then read of only EOF.
# Not sure if it's always that way; more correct would be checking
# for empty $inputline or undef'd $rawreading,$val. -wusel, 2010-01-04
if($eof != 1) {
foreach my $inputline ( @lines ) {
$inputline =~ s/\s+$//;
my ($rawreading, $val)=split(/ /, $inputline);
Log GetLogLevel($name,5), "WS3600 read $inputline:$rawreading:$val";
if(defined($TranslatedCodes{$rawreading})) {
# delete $defs{$name}{READINGS}{" $rawreading"};
$reading=$TranslatedCodes{$rawreading};
$defs{$name}{READINGS}{$reading}{VAL} = $val;
$defs{$name}{READINGS}{$reading}{TIME} = $tn;
#
# -wusel, 2010-01-30: BIG CHANGE: only put into CHANGED[] what will be in
# STATE as well; this is done to reduce the burden on
# the notification framework (each one currently leads
# to a separate notify which will in turn lead a call
# of EVERY NotifyFn()) and to improve FHEMs overall
# performance.
# Every value is still be stored in READINGS though.
#
# $hash->{CHANGED}[$i++] = "$reading: $val";
if(defined($WantedCodesForStatus{$rawreading})) {
$readingforstatus=$WantedCodesForStatus{$rawreading};
$StateString=sprintf("%s %s %s", $StateString, $readingforstatus, $val);
$hash->{CHANGED}[$i++] = "$reading: $val";
}
# if($rawreading =~ m/^(Tendency|Forecast)/) {
# $hash->{CHANGED}[$i++] = "$reading: $val";
# $StateString=sprintf("%s %s: %s", $StateString, $reading, $val);
# }
# if($rawreading =~ m/^(Ti$|To$|WC$)/) {
# $hash->{CHANGED}[$i++] = "$reading: $val";
# $TempsString=sprintf("%s %s: %s °C", $TempsString, $reading, $val);
# }
# if($rawreading =~ m/^(RHi$|RHo$)/) {
# $hash->{CHANGED}[$i++] = "$reading: $val";
# $HumidString=sprintf("%s %s: %s %%", $HumidString, $reading, $val);
# }
# if($rawreading =~ m/^(R1h$|R24h$)/) {
# $hash->{CHANGED}[$i++] = "$reading: $val";
# $OtherString=sprintf("%s %s: %s mm", $OtherString, $reading, $val);
# }
# if($rawreading =~ m/^(RP$|AP$)/) {
# $hash->{CHANGED}[$i++] = "$reading: $val";
# $OtherString=sprintf("%s %s: %s hPa", $OtherString, $reading, $val);
# }
}
}
$hash->{TMPSTATE} = $StateString;
}
if($eof) {
close($FH);
delete $hash->{FD};
delete $selectlist{"$name.pipe"};
InternalTimer(gettimeofday()+ $hash->{Timer}, "WS3600_GetStatus", $hash, 1);
Log GetLogLevel($name,4), "WS3600 done reading pipe";
} else {
Log GetLogLevel($name,4), "WS3600 (further) reading would block";
}
# $OtherString =~ s/^\s+//;
# $HumidString =~ s/^\s+//;
# $TempsString =~ s/^\s+//;
# $StateString =~ s/^\s+//;
#
# $defs{$name}{READINGS}{"Humidity"}{VAL} = $HumidString;
# $defs{$name}{READINGS}{"Humidity"}{TIME} = $tn;
# $hash->{CHANGED}[$i++] = $HumidString;
# $defs{$name}{READINGS}{"Temperatures"}{VAL} = $TempsString;
# $defs{$name}{READINGS}{"Temperatures"}{TIME} = $tn;
# $hash->{CHANGED}[$i++] = $TempsString;
# $defs{$name}{READINGS}{"Rain/Pressure"}{VAL} = $OtherString;
# $defs{$name}{READINGS}{"Rain/Pressure"}{TIME} = $tn;
# $hash->{CHANGED}[$i++] = $OtherString;
# $defs{$name}{READINGS}{"Forecast"}{VAL} = $StateString;
# $defs{$name}{READINGS}{"Forecast"}{TIME} = $tn;
# $hash->{CHANGED}[$i++] = $StateString;
# -wusel, 2010-01-06: FIXME: does this logic with STATE work?
# -wusel, 2010-01-30: Removed setting STATE to "reading".
if($eof) {
# $hash->{CHANGED}[$i++] = "Status: $StateString";
$hash->{STATE} = $hash->{TMPSTATE};
$hash->{TMPSTATE} = "";
DoTrigger($name, undef);
# } else {
# $hash->{STATE} = "reading";
}
return $hash->{STATE};
}
# From http://www.perlmonks.org/?node_id=713384 / http://davesource.com/Solutions/20080924.Perl-Non-blocking-Read-On-Pipes-Or-Files.html
#
# Used, hopefully, with permission ;)
#
# An non-blocking filehandle read that returns an array of lines read
# Returns: ($eof,@lines)
my %nonblockGetLines_last;
sub nonblockGetLines {
my ($fh,$timeout) = @_;
$timeout = 0 unless defined $timeout;
my $rfd = '';
$nonblockGetLines_last{$fh} = ''
unless defined $nonblockGetLines_last{$fh};
vec($rfd,fileno($fh),1) = 1;
return unless select($rfd, undef, undef, $timeout)>=0;
# I'm not sure the following is necessary?
return unless vec($rfd,fileno($fh),1);
my $buf = '';
my $n = sysread($fh,$buf,1024*1024);
# If we're done, make sure to send the last unfinished line
return (1,$nonblockGetLines_last{$fh}) unless $n;
# Prepend the last unfinished line
$buf = $nonblockGetLines_last{$fh}.$buf;
# And save any newly unfinished lines
$nonblockGetLines_last{$fh} =
(substr($buf,-1) !~ /[\r\n]/ && $buf =~ s/([^\r\n]*)$//)
? $1 : '';
$buf ? (0,split(/\n/,$buf)) : (0);
}
1;

346
fhem/FHEM/80_M232.pm
View File

@ -1,346 +0,0 @@
#
#
# 80_M232.pm
# written by Dr. Boris Neubert 2007-11-26
# e-mail: omega at online dot de
#
##############################################
package main;
use strict;
use warnings;
sub M232Write($$);
sub M232GetData($$);
sub Log($$);
use vars qw {%attr %defs};
#####################################
sub
M232_Initialize($)
{
my ($hash) = @_;
# Provider
$hash->{WriteFn} = "M232_Write";
$hash->{Clients} = ":M232Counter:M232Voltage:";
# Consumer
$hash->{DefFn} = "M232_Define";
$hash->{UndefFn} = "M232_Undef";
$hash->{GetFn} = "M232_Get";
$hash->{SetFn} = "M232_Set";
$hash->{AttrList}= "model:m232 loglevel:0,1,2,3,4,5";
}
#####################################
sub
M232_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
$hash->{STATE} = "Initialized";
my $dev = $a[2];
if($dev eq "none") {
Log 1, "M232 device is none, commands will be echoed only";
return undef;
}
Log 3, "M232 opening device $dev";
my $po;
if ($^O eq 'MSWin32') {
eval ("use Win32::SerialPort;");
if ($@) {
$hash->{STATE} = "error using Modul Win32::SerialPort";
Log 1,"Error using Device::SerialPort";
return "Can't use Win32::SerialPort $@\n";
}
$po = new Win32::SerialPort ($dev, 1);
} else {
eval ("use Device::SerialPort;");
if ($@) {
$hash->{STATE} = "error using Modul Device::SerialPort";
Log 1,"Error using Device::SerialPort";
return "Can't Device::SerialPort $@\n";
}
$po = new Device::SerialPort ($dev, 1);
}
if (!$po) {
$hash->{STATE} = "error opening device";
Log 1,"Error opening Serial Device $dev";
return "Can't open Device $dev: $^E\n";
}
Log 3, "M232 opened device $dev";
$po->close();
$hash->{DeviceName} = $dev;
return undef;
}
#####################################
sub
M232_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};
}
}
return undef;
}
#####################################
# M232_Ready
# implement ReadyFn
# only used for Win32
#
sub
M232_Ready($$)
{
my ($hash, $dev) = @_;
my $po=$dev||$hash->{po};
return 0 if !$po;
my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags)=$po->status;
return ($InBytes>0);
}
#####################################
sub
M232_Set($@)
{
my ($hash, @a) = @_;
my $u1 = "Usage: set <name> auto <value>\n" .
"set <name> stop\n" .
"set <name> start\n" .
"set <name> octet <value>\n" .
"set <name> [io0..io7] 0|1\n";
return $u1 if(int(@a) < 2);
my $msg;
my $reading= $a[1];
my $value;
my @legal;
if($reading eq "auto") {
return $u1 if(int(@a) !=3);
$value= $a[2];
@legal= (0..5,"none");
if(!grep($value eq $_, @legal)) {
return "Illegal value $value, possible values: @legal";
}
if($value eq "none") { $value= 0; } else { $value+=1; }
$msg= "M" . $value;
}
elsif($reading eq "start") {
return $u1 if(int(@a) !=2);
$msg= "Z1";
}
elsif($reading eq "stop") {
return $u1 if(int(@a) !=2);
$msg= "Z0";
}
elsif($reading eq "octet") {
return $u1 if(int(@a) !=3);
$value= $a[2];
@legal= (0..255);
if(!grep($value eq $_, @legal)) {
return "Illegal value $value, possible values: 0..255";
}
$msg= sprintf("W%02X", $value);
}
elsif($reading =~ /^io[0-7]$/) {
return $u1 if(int(@a) !=3);
$value= $a[2];
return $u1 unless($value eq "0" || $value eq "1");
$msg= "D" . substr($reading,2,1) . $value;
}
else { return $u1; }
my $d = M232GetData($hash, $msg);
return "Read error" if(!defined($d));
return $d;
}
#####################################
sub
M232_Get($@)
{
my ($hash, @a) = @_;
my $u1 = "Usage: get <name> [an0..an5]\n" .
"get <name> [io0..io7]\n" .
"get <name> octet\n" .
"get <name> counter";
return $u1 if(int(@a) != 2);
my $name= $a[0];
my $reading= $a[1];
my $msg;
my $retval;
my ($count,$d,$state,$iscurrent,$voltage);
if($reading eq "counter") {
$msg= "z";
$d = M232GetData($hash, $msg);
return "Read error" if(!defined($d));
$count= hex $d;
$retval= $count;
}
elsif($reading =~ /^an[0-5]$/) {
$msg= "a" . substr($reading,2,1);
$d = M232GetData($hash, $msg);
return "Read error" if(!defined($d));
$voltage= (hex substr($d,0,3))*5.00/1024.0;
$iscurrent= substr($d,3,1);
$retval= $voltage; # . " " . $iscurrent;
}
elsif($reading =~ /^io[0-7]$/) {
$msg= "d" . substr($reading,2,1);
$d = M232GetData($hash, $msg);
return "Read error" if(!defined($d));
$state= hex $d;
$retval= $state;
}
elsif($reading eq "octet") {
$msg= "w";
$d = M232GetData($hash, $msg);
return "Read error" if(!defined($d));
$state= hex $d;
$retval= $state;
}
else { return $u1; }
$hash->{READINGS}{$reading}{VAL}= $retval;
$hash->{READINGS}{$reading}{TIME}= TimeNow();
return "$name $reading => $retval";
}
#####################################
sub
M232_Write($$)
{
my ($hash,$msg) = @_;
return M232GetData($hash, $msg);
}
#####################################
sub
M232GetData($$)
{
my ($hash, $data) = @_;
my $dev=$hash->{DeviceName};
my $MSGSTART= chr 1;
my $MSGEND= chr 13;
my $MSGACK= chr 6;
my $MSGNACK= chr 21;
my $serport;
my $d = $MSGSTART . $data . $MSGEND;
if ($^O eq 'MSWin32') {
$serport=new Win32::SerialPort ($dev, 1);
}else{
$serport=new Device::SerialPort ($dev, 1);
}
if(!$serport) {
Log 3, "M232: Can't open $dev: $!";
return undef;
}
$serport->reset_error();
$serport->baudrate(2400);
$serport->databits(8);
$serport->parity('none');
$serport->stopbits(1);
$serport->handshake('none');
$serport->write_settings;
$hash->{po}=$serport;
Log 4, "M232: Sending $d";
my $rm = "M232: ?";
$serport->lookclear;
$serport->write($d);
my $retval = "";
my $status = "";
my $nfound=0;
my $ret=undef;
sleep(1);
for(;;) {
if ($^O eq 'MSWin32') {
$nfound=M232_Ready($hash,undef);
}else{
my ($rout, $rin) = ('', '');
vec($rin, $serport->FILENO, 1) = 1;
$nfound = select($rin, undef, undef, 1.0); # 3 seconds timeout
if($nfound < 0) {
next if ($! == EAGAIN() || $! == EINTR() || $! == 0);
$rm="M232:Select error $nfound / $!";
last;
}
}
last if($nfound == 0);
my $out = $serport->read(1);
if(!defined($out) || length($out) == 0) {
$rm = "M232 EOF on $dev";
last;
}
if($out eq $MSGACK) {
$rm= "M232: acknowledged";
Log 4, "M232: return value \'" . $retval . "\'";
$status= "ACK";
} elsif($out eq $MSGNACK) {
$rm= "M232: not acknowledged";
$status= "NACK";
$retval= undef;
} else {
$retval .= $out;
}
if($status) {
$ret=$retval;
last;
}
}
DONE:
$serport->close();
undef $serport;
delete $hash->{po} if exists($hash->{po});
Log 4, $rm;
return $ret;
}
1;

305
fhem/FHEM/80_xxLG7000.pm
View File

@ -1,305 +0,0 @@
#
# 80_xxLG7000.pm; an FHEM module for interfacing
# with LG's Scarlet Series of LCDs (e. g. LG 47LG7000)
#
# Written by Kai 'wusel' Siering <wusel+fhem@uu.org> around 2010-01-20
# $Id: 80_xxLG7000.pm,v 1.2 2010-01-22 09:51:56 painseeker Exp $
#
# re-using code of 80_M232.pm by Dr. Boris Neubert
##############################################
package main;
use strict;
use warnings;
sub xxLG7000Write($$);
sub xxLG7000GetData($$);
sub Log($$);
use vars qw {%attr %defs};
my %commands = (
"power state" => "ka %x FF\r",
"power on" => "ka %x 01\r",
"power off" => "ka %x 00\r",
"input AV1" => "xb %x 20\r",
"input AV2" => "xb %x 21\r",
"input AV3" => "xb %x 22\r",
"input AV4" => "xb %x 23\r",
"input Component" => "xb %x 40\r",
"input RGB-PC" => "xb %x 50\r",
"input HDMI1" => "xb %x 90\r",
"input HDMI2" => "xb %x 91\r",
"input HDMI3" => "xb %x 92\r",
"input HDMI4" => "xb %x 93\r",
"input DVB-T" => "xb %x 00\r",
"input PAL" => "xb %x 10\r",
"selected input" => "xb %x FF\r",
"audio mute" => "ke %x 00\r",
"audio normal" => "ke %x 01\r",
"audio state" => "ke %x FF\r",
);
my %responses = (
"a OK00" => "power off",
"a OK01" => "power on",
"b OK20" => "input AV1",
"b OK21" => "input AV2",
"b OK22" => "input AV3",
"b OK23" => "input AV4",
"b OK90" => "input HDMI1",
"b OK91" => "input HDMI2",
"b OK92" => "input HDMI3",
"b OK93" => "input HDMI4",
"b OKa0" => "input HDMI1-no_link", # At least 47LG7000 returns 10100001 instead of 10010001 when
"b OKa1" => "input HDMI2-no_link", # there is no link/signal connected to the corresponding
"b OKa2" => "input HDMI3-no_link", # HDMI input. -wusel, 2010-01-20
"b OKa3" => "input HDMI4-no_link",
"b OK40" => "input Components",
"b OK50" => "input RGB-PC",
"b OK10" => "input PAL", # Selecting analogue (dubbed PAL here) input does not work for
"b OK00" => "input DVB-T", # me; well, there's nothing to see anymore anyway, at least
"e OK00" => "audio muted", # in Germany ;) (Ack, I don't have CATV.) -wusel, 2010-01-20
"e OK01" => "audio normal",
);
#####################################
sub
xxLG7000_Initialize($)
{
my ($hash) = @_;
# Provider
$hash->{WriteFn} = "xxLG7000_Write";
$hash->{Clients} = ":LGTV:";
# No ReadFn as this is a purely command->response interface, in contrast
# to e. g. CUL which send's data on it's own. -wusel
# Consumer
$hash->{DefFn} = "xxLG7000_Define";
$hash->{UndefFn} = "xxLG7000_Undef";
$hash->{AttrList}= "SetID:1,2,... loglevel:0,1,2,3,4,5";
}
#####################################
sub
xxLG7000_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
$hash->{STATE} = "Initialized";
my $dev = $a[2];
if($dev eq "none") {
Log 1, "xxLG7000 device is none, commands will be echoed only";
return undef;
}
Log 3, "xxLG7000 opening device $dev";
my $po;
if ($^O eq 'MSWin32') {
eval ("use Win32::SerialPort;");
if ($@) {
$hash->{STATE} = "error using Modul Win32::SerialPort";
Log 1,"Error using Device::SerialPort";
return "Can't use Win32::SerialPort $@\n";
}
$po = new Win32::SerialPort ($dev, 1);
} else {
eval ("use Device::SerialPort;");
if ($@) {
$hash->{STATE} = "error using Modul Device::SerialPort";
Log 1,"Error using Device::SerialPort";
return "Can't Device::SerialPort $@\n";
}
$po = new Device::SerialPort ($dev, 1);
}
if (!$po) {
$hash->{STATE} = "error opening device";
Log 1,"Error opening Serial Device $dev";
return "Can't open Device $dev: $^E\n";
}
Log 3, "xxLG7000 opened device $dev";
$po->close();
$hash->{DeviceName} = $dev;
$attr{$a[0]}{SetID}=1;
return undef;
}
#####################################
sub
xxLG7000_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};
}
}
return undef;
}
#####################################
# implement ReadyFn, only used for Win32
sub
xxLG7000_Ready($$)
{
my ($hash, $dev) = @_;
my $po=$dev||$hash->{po};
return 0 if !$po;
my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags)=$po->status;
return ($InBytes>0);
}
#####################################
sub
xxLG7000_Write($$)
{
my ($hash,$msg) = @_;
my $dev = $hash->{DeviceName};
my $UnitNo=1;
my $ret;
my $retmsg="error occured";
my $myname=$hash->{NAME};
if(defined($attr{$myname}{SetID})) {
$UnitNo=$attr{$myname}{SetID};
Log $UnitNo==1?5:4, "xxLG7000_Write: Using SetID $UnitNo for $myname.";
}
my $sendstring=$commands{$msg};
if(!defined($sendstring)) {
return "error unknown command $msg, choose one of " . join(" ", sort keys %commands);
}
$sendstring=sprintf($sendstring, $UnitNo);
Log 5, "xxLG7000_Write: sending $sendstring";
$ret=xxLG7000GetData($hash, $sendstring);
if(!defined($ret) || length($ret)<=6) {
Log 2, "xxLG7000_Write: error, got too short answer ($ret).";
} else {
Log 5, "xxLG7000_Write: wrote $msg, received $ret";
$retmsg=sprintf("%s %s", substr($ret, 0, 1), substr($ret, 5));
$retmsg=$responses{$retmsg};
if(!defined($retmsg)) {
if(substr($ret, 5, 2) eq "NG") {
$retmsg="error message";
Log 5, "xxLG7000_Write: error message: $ret";
} else {
Log 2, "xxLG7000_Write: Unknown response $ret, help me!";
$retmsg=sprintf("error message_unknown:%s", $ret =~ s/ /_/);
}
} else {
Log 5, "xxLG7000_Write: returns $retmsg";
}
}
return $retmsg;
}
#####################################
sub
xxLG7000GetData($$)
{
my ($hash, $data) = @_;
my $dev=$hash->{DeviceName};
my $serport;
my $d = $data;
my $MSGACK= 'x';
if ($^O eq 'MSWin32') {
$serport=new Win32::SerialPort ($dev, 1);
} else {
$serport=new Device::SerialPort ($dev, 1);
}
if(!$serport) {
Log 3, "xxLG7000: Can't open $dev: $!";
return undef;
}
$serport->reset_error();
$serport->baudrate(9800);
$serport->databits(8);
$serport->parity('none');
$serport->stopbits(1);
$serport->handshake('none');
$serport->write_settings;
$hash->{po}=$serport;
Log 4, "xxLG7000: Sending $d";
my $rm = "xxLG7000: ?";
$serport->lookclear;
$serport->write($d);
my $retval = "";
my $status = "";
my $nfound=0;
my $ret=undef;
sleep(1);
for(;;) {
if ($^O eq 'MSWin32') {
$nfound=xxLG7000_Ready($hash,undef);
} else {
my ($rout, $rin) = ('', '');
vec($rin, $serport->FILENO, 1) = 1;
$nfound = select($rin, undef, undef, 1.0); # 3 seconds timeout
if($nfound < 0) {
next if ($! == EAGAIN() || $! == EINTR() || $! == 0);
$rm="xxLG7000:Select error $nfound / $!";
last;
}
}
last if($nfound == 0);
my $out = $serport->read(1);
if(!defined($out) || length($out) == 0) {
$rm = "xxLG7000 EOF on $dev";
last;
}
if($out eq $MSGACK) {
$rm= "xxLG7000: acknowledged";
Log 4, "xxLG7000: return value \'" . $retval . "\'";
$status= "ACK";
} else {
$retval .= $out;
}
if($status) {
$ret=$retval;
last;
}
}
DONE:
$serport->close();
undef $serport;
delete $hash->{po} if exists($hash->{po});
Log 4, $rm;
return $ret;
}
1;

253
fhem/FHEM/81_M232Counter.pm
View File

@ -1,253 +0,0 @@
#
#
# 81_M232Counter.pm
# written by Dr. Boris Neubert 2007-11-26
# e-mail: omega at online dot de
#
##############################################
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
sub M232Counter_Get($@);
sub M232Counter_Set($@);
sub M232Counter_SetBasis($@);
sub M232Counter_Define($$);
sub M232Counter_GetStatus($);
###################################
sub
M232Counter_Initialize($)
{
my ($hash) = @_;
$hash->{GetFn} = "M232Counter_Get";
$hash->{SetFn} = "M232Counter_Set";
$hash->{DefFn} = "M232Counter_Define";
$hash->{AttrList} = "dummy:1,0 model;M232Counter loglevel:0,1,2,3,4,5";
}
###################################
sub
M232Counter_GetStatus($)
{
my ($hash) = @_;
if(!$hash->{LOCAL}) {
InternalTimer(gettimeofday()+$hash->{INTERVAL}, "M232Counter_GetStatus", $hash, 1);
}
my $name = $hash->{NAME};
my $r= $hash->{READINGS};
my $d = IOWrite($hash, "z");
if(!defined($d)) {
my $msg = "M232Counter $name tick count read error";
Log GetLogLevel($name,2), $msg;
return $msg;
}
# time
my $tn = TimeNow();
#tsecs
my $tsecs= time(); # number of non-leap seconds since January 1, 1970, UTC
# previous tsecs
my $tsecs_prev;
if(defined($r->{tsecs})) {
$tsecs_prev= $r->{tsecs}{VAL};
} else{
$tsecs_prev= $tsecs; # 1970-01-01
}
# basis
my $basis;
if(defined($r->{basis})) {
$basis= $r->{basis}{VAL};
} else {
$basis= 0;
}
my $basis_prev= $basis;
# previous count (this variable is currently unused)
my $count_prev;
if(defined($r->{count})) {
$count_prev= $r->{count}{VAL};
} else {
$count_prev= 0;
}
# current count
my $count= hex $d;
# If the counter reaches 65536, the counter does not wrap around but
# stops at 0. We therefore purposefully reset the counter to 0 before
# it reaches its final tick count.
if($count > 64000) {
$basis+= $count;
$count= 0;
$r->{basis}{VAL} = $basis;
$r->{basis}{TIME}= $tn;
my $ret = IOWrite($hash, "Z1");
if(!defined($ret)) {
my $msg = "M232Counter $name reset error";
Log GetLogLevel($name,2), $msg;
return $msg;
}
}
# previous value
my $value_prev;
if(defined($r->{value})) {
$value_prev= $r->{value}{VAL};
} else {
$value_prev= 0;
}
# current value
my $value= ($basis+$count) * $hash->{FACTOR};
# round to 3 digits
$value= int($value*1000.0+0.5)/1000.0;
# set new values
$r->{count}{TIME} = $tn;
$r->{count}{VAL} = $count;
$r->{value}{TIME} = $tn;
$r->{value}{VAL} = $value;
$r->{tsecs}{TIME} = $tn;
$r->{tsecs}{VAL} = $tsecs;
$hash->{CHANGED}[0]= "count: $count";
$hash->{CHANGED}[1]= "value: $value";
# delta
my $tsecs_delta= $tsecs-$tsecs_prev;
my $count_delta= ($count+$basis)-($count_prev+$basis_prev);
if($tsecs_delta>0) {
my $delta= ($count_delta/$tsecs_delta)*$hash->{DELTAFACTOR};
# round to 3 digits
$delta= int($delta*1000.0+0.5)/1000.0;
$r->{delta}{TIME} = $tn;
$r->{delta}{VAL} = $delta;
$hash->{CHANGED}[2]= "delta: $delta";
}
if(!$hash->{LOCAL}) {
DoTrigger($name, undef) if($init_done);
}
$hash->{STATE} = $value;
Log GetLogLevel($name,4), "M232Counter $name: $value $hash->{UNIT}";
return $hash->{STATE};
}
###################################
sub
M232Counter_Get($@)
{
my ($hash, @a) = @_;
return "argument is missing" if(int(@a) != 2);
my $msg;
if($a[1] ne "status") {
return "unknown get value, valid is status";
}
$hash->{LOCAL} = 1;
my $v = M232Counter_GetStatus($hash);
delete $hash->{LOCAL};
return "$a[0] $a[1] => $v";
}
#############################
sub
M232Counter_Calibrate($@)
{
my ($hash, $value) = @_;
my $rm= undef;
my $name = $hash->{NAME};
# adjust basis
my $tn = TimeNow();
$hash->{READINGS}{basis}{VAL}= $value / $hash->{FACTOR};
$hash->{READINGS}{basis}{TIME}= $tn;
$hash->{READINGS}{count}{VAL}= 0;
$hash->{READINGS}{count}{TIME}= $tn;
# recalculate value
$hash->{READINGS}{value}{VAL} = $value;
$hash->{READINGS}{value}{TIME} = $tn;
# reset counter
my $ret = IOWrite($hash, "Z1");
if(!defined($ret)) {
my $rm = "M232Counter $name read error";
Log GetLogLevel($name,2), $rm;
}
return $rm;
}
#############################
sub
M232Counter_Set($@)
{
my ($hash, @a) = @_;
my $u = "Usage: set <name> value <value>\n" .
"set <name> interval <seconds>\n" ;
return $u if(int(@a) != 3);
my $reading= $a[1];
if($a[1] eq "value") {
my $value= $a[2];
my $rm= M232Counter_Calibrate($hash, $value);
} elsif($a[1] eq "interval") {
my $interval= $a[2];
$hash->{INTERVAL}= $interval;
} else {
return $u;
}
return undef;
}
#############################
sub
M232Counter_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "syntax: define <name> M232Counter [unit] [factor] [deltaunit] [deltafactor]"
if(int(@a) < 2 && int(@a) > 6);
my $unit= ((int(@a) > 2) ? $a[2] : "ticks");
my $factor= ((int(@a) > 3) ? $a[3] : 1.0);
my $deltaunit= ((int(@a) > 4) ? $a[4] : "ticks per second");
my $deltafactor= ((int(@a) > 5) ? $a[5] : 1.0);
$hash->{UNIT}= $unit;
$hash->{FACTOR}= $factor;
$hash->{DELTAUNIT}= $deltaunit;
$hash->{DELTAFACTOR}= $deltafactor;
$hash->{INTERVAL}= 60; # poll every minute per default
AssignIoPort($hash);
if(!$hash->{LOCAL}) {
InternalTimer(gettimeofday()+60, "M232Counter_GetStatus", $hash, 0);
}
return undef;
}
1;

245
fhem/FHEM/82_LGTV.pm
View File

@ -1,245 +0,0 @@
# 82_LGTV.pm; an FHEM high level module for interfacing
# with LG's Scarlet Series of LCDs (e. g. LG 47LG7000)
# Trying to implement a generic command set so that is
# is re-usable with other low-level drivers besides my
# 80_xxLG7000.pm for a serial connection.
#
# Written by Kai 'wusel' Siering <wusel+fhem@uu.org> around 2010-01-20
# $Id: 82_LGTV.pm,v 1.2 2010-01-22 09:51:56 painseeker Exp $
#
# re-using code of 82_M232Voltage.pm
# written by Dr. Boris Neubert 2007-12-24
# e-mail: omega at online dot de
#
##############################################
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
sub LGTV_Get($@);
sub LGTV_Define($$);
sub LGTV_GetStatus($);
my @commandlist = (
"power state",
"power on",
"power off",
"input AV1",
"input AV2",
"input AV3",
"input AV3",
"input Component",
"input RGB",
"input HDMI1",
"input HDMI2",
"input HDMI3",
"input HDMI4",
"input DVB-T",
"input PAL",
"audio mute",
"audio normal",
"selected input",
"audio state"
);
###################################
sub
LGTV_Initialize($)
{
my ($hash) = @_;
$hash->{GetFn} = "LGTV_Get";
$hash->{SetFn} = "LGTV_Set";
$hash->{DefFn} = "LGTV_Define";
$hash->{AttrList} = "dummy:1,0 model:LGTV loglevel:0,1,2,3,4,5 TIMER:30";
}
###################################
sub
LGTV_GetStatus($)
{
my ($hash) = @_;
my $numchanged=0;
my $name = $hash->{NAME};
my @cmdlist;
my $retval;
@cmdlist=("get", "power", "state");
$retval=LGTV_Set($hash, @cmdlist);
my ($value, $state)=split(" ", $retval);
if($value eq "power" && $state eq "on") {
@cmdlist=("get", "selected", "input");
$retval=LGTV_Set($hash, @cmdlist);
}
InternalTimer(gettimeofday()+$attr{$name}{TIMER}, "LGTV_GetStatus", $hash, 1);
return;
my $d = IOWrite($hash, "power state");
if(!defined($d)) {
my $msg = "LGTV $name read error";
Log GetLogLevel($name,2), $msg;
return $msg;
}
my $tn = TimeNow();
# my ($value, $state)=split(" ", $d);
if($value eq "power") {
if($hash->{READINGS}{$value}{VAL} ne $state) {
$hash->{READINGS}{$value}{TIME} = $tn;
$hash->{READINGS}{$value}{VAL} = $state;
$hash->{CHANGED}[$numchanged++]= "$value: $state";
$hash->{STATE} = $hash->{READINGS}{$value}{VAL};
}
$hash->{STATE} = $hash->{READINGS}{$value}{VAL};
}
if($state eq "on") {
$d = IOWrite($hash, "selected input");
if(!defined($d)) {
my $msg = "LGTV $name read error";
Log GetLogLevel($name,2), $msg;
return $msg;
}
if($value eq "input") { # ... and not e. g. "error" ;)
if($hash->{READINGS}{$value}{VAL} ne $state) {
$tn = TimeNow();
($value, $state)=split(" ", $d);
$hash->{READINGS}{$value}{TIME} = $tn;
$hash->{READINGS}{$value}{VAL} = $state;
$hash->{CHANGED}[$numchanged++]= "$value: $state";
}
$hash->{STATE} = $hash->{STATE} . ", " . $state;
}
}
DoTrigger($name, undef);
Log GetLogLevel($name,4), "LGTV $name: $hash->{STATE}";
return $hash->{STATE};
}
###################################
sub
LGTV_Get($@)
{
my ($hash, @a) = @_;
my $msg;
return "argument is missing" if(int(@a) != 2);
if($a[1] eq "power") {
$msg="get power state";
} elsif($a[1] eq "input") {
$msg="get selected input";
} elsif($a[1] eq "audio") {
$msg="get audio state";
} else {
return "unknown get value, valid is power, input, audio";
}
my @msgarray=split(" ", $msg);
my $v = LGTV_Set($hash, @msgarray);
return "$a[0] $v";
}
###################################
sub
LGTV_Set($@)
{
my ($hash, @a) = @_;
my $ret = undef;
my $na = int(@a);
my $ncmds=int(@commandlist);
my $i;
my $known_cmd=0;
my $what = "";
my $name = $hash->{NAME};
$what=$a[1];
if($na>1) {
for($i=2; $i<$na; $i++) {
$what=$what . " " . lc($a[$i]);
}
}
for($i=0; $i<$ncmds; $i++) {
if(lc($commandlist[$i]) eq $what) {
$what=$commandlist[$i];
$known_cmd+=1;
}
}
if($known_cmd==0) {
return "Unknown argument $what, choose one of power input audio";
}
$ret=IOWrite($hash, $what, "");
if(!defined($ret)) {
my $msg = "LGTV $name read error";
Log GetLogLevel($name,2), $msg;
} else {
my $tn = TimeNow();
my ($value, $state)=split(" ", $ret);
# Logic of the following: if no error:
# if unset READINGS or difference:
# store READINGS
# if power-status: update STATE
# if input-status: update STATE
if($value ne "error") {
if(!defined($hash->{READINGS}{$value}{VAL}) || $state ne $hash->{READINGS}{$value}{VAL}) {
$hash->{READINGS}{$value}{TIME} = $tn;
$hash->{READINGS}{$value}{VAL} = $state;
$hash->{CHANGED}[0]= "$value: $state";
}
if($value eq "power") {
$hash->{STATE}=$state;
}
if($value eq "input") { # implies power being on, usually ...
$hash->{STATE}=$hash->{READINGS}{"power"}{VAL} . ", " . $state;
}
}
}
DoTrigger($name, undef);
return $ret;
}
#############################
sub
LGTV_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $name = $hash->{NAME};
AssignIoPort($hash);
$attr{$name}{TIMER}=30;
InternalTimer(gettimeofday()+$attr{$name}{TIMER}, "LGTV_GetStatus", $hash, 0);
# Preset if undefined
if(!defined($hash->{READINGS}{"power"}{VAL})) {
my $tn = TimeNow();
$hash->{READINGS}{"power"}{VAL}="unknown";
$hash->{READINGS}{"power"}{TIME}=$tn;
}
return undef;
}
1;

116
fhem/FHEM/82_M232Voltage.pm
View File

@ -1,116 +0,0 @@
#
#
# 82_M232Voltage.pm
# written by Dr. Boris Neubert 2007-12-24
# e-mail: omega at online dot de
#
##############################################
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
sub M232Voltage_Get($@);
sub M232Voltage_Define($$);
sub M232Voltage_GetStatus($);
###################################
sub
M232Voltage_Initialize($)
{
my ($hash) = @_;
$hash->{GetFn} = "M232Voltage_Get";
$hash->{DefFn} = "M232Voltage_Define";
$hash->{AttrList} = "dummy:1,0 model;M232Voltage loglevel:0,1,2,3,4,5";
}
###################################
sub
M232Voltage_GetStatus($)
{
my ($hash) = @_;
if(!$hash->{LOCAL}) {
InternalTimer(gettimeofday()+60, "M232Voltage_GetStatus", $hash, 1);
}
my $name = $hash->{NAME};
my $d = IOWrite($hash, "a" . $hash->{INPUT});
if(!defined($d)) {
my $msg = "M232Voltage $name read error";
Log GetLogLevel($name,2), $msg;
return $msg;
}
my $tn = TimeNow();
my $value= (hex substr($d,0,3))*5.00/1024.0 * $hash->{FACTOR};
$hash->{READINGS}{value}{TIME} = $tn;
$hash->{READINGS}{value}{VAL} = $value;
$hash->{CHANGED}[0]= "value: $value";
if(!$hash->{LOCAL}) {
DoTrigger($name, undef) if($init_done);
}
$hash->{STATE} = $value;
Log GetLogLevel($name,4), "M232Voltage $name: $value $hash->{UNIT}";
return $hash->{STATE};
}
###################################
sub
M232Voltage_Get($@)
{
my ($hash, @a) = @_;
return "argument is missing" if(int(@a) != 2);
my $msg;
if($a[1] ne "status") {
return "unknown get value, valid is status";
}
$hash->{LOCAL} = 1;
my $v = M232Voltage_GetStatus($hash);
delete $hash->{LOCAL};
return "$a[0] $a[1] => $v";
}
#############################
sub
M232Voltage_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "syntax: define <name> M232Voltage an0..an5 [unit [factor]]"
if(int(@a) < 3 && int(@a) > 5);
my $reading= $a[2];
return "$reading is not an analog input, valid: an0..an5"
if($reading !~ /^an[0-5]$/) ;
my $unit= ((int(@a) > 3) ? $a[3] : "volts");
my $factor= ((int(@a) > 4) ? $a[4] : 1.0);
$hash->{INPUT}= substr($reading,2);
$hash->{UNIT}= $unit;
$hash->{FACTOR}= $factor;
AssignIoPort($hash);
if(!$hash->{LOCAL}) {
InternalTimer(gettimeofday()+60, "M232Voltage_GetStatus", $hash, 0);
}
return undef;
}
1;

541
fhem/FHEM/87_WS2000.pm
View File

@ -1,541 +0,0 @@
package main;
###########################
# 87_ws2000.pm
# Modul for FHEM
#
# contributed by thomas dressler 2008
# $Id: 87_WS2000.pm,v 1.7 2009-11-22 19:16:16 rudolfkoenig Exp $
# corr. negativ temps / peterp
###########################
use strict;
use Switch;
use warnings;
#prototypes to make komodo happy
use vars qw{%attr %defs};
sub Log($$);
our $FH;
####################################
# WS2000_Initialize
# Implements Initialize function
#
sub WS2000_Initialize($)
{
my ($hash) = @_;
# Provider
#$hash->{WriteFn} = "ws2000_Write";
# $hash->{Clients} = ":WS2000Rain:WS2000Wind:WS2000Indoor:WS2000Lux:WS2000Pyro:WS2000Temp:WS2000TempHum";
# Consumer
$hash->{DefFn} = "WS2000_Define";
$hash->{UndefFn} = "WS2000_Undef";
$hash->{GetFn} = "WS2000_Get";
$hash->{SetFn} = "WS2000_Set";
$hash->{ReadyFn} = "WS2000_Ready";
$hash->{ReadFn} ="WS2000_Read";
$hash->{ListFn} ="WS2000_List";
$hash->{AttrList}= "model:WS2000 rain altitude loglevel:0,1,2,3,4,5";
}
#####################################
# WS2000_Define
# Implements DefFn function
#
sub
WS2000_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
delete $hash->{po};
delete $hash->{socket};
delete $hash->{FD};
my $ws2000_cfg='ws2000.cfg';
my $quiet=1;
my $name=$hash->{NAME};
my $PortName = $a[2];
my $PortObj;
if($PortName eq "none") {
Log 1, "WS2000 device is none, commands will be echoed only";
return undef;
}
Log 4, "WS2000 opening device $PortName";
#switch serial/socket device
if ($PortName=~/^\/dev|^COM/) {
#normal devices (/dev), on windows COMx
my $OS=$^O;
if ($OS eq 'MSWin32') {
eval ("use Win32::SerialPort;");
if ($@) {
$hash->{STATE} = "error using Modul Win32::SerialPort";
Log 1,"Error using Device::SerialPort";
return "Can't use Win32::SerialPort $@\n";
}
$PortObj = new Win32::SerialPort ($PortName, $quiet);
if (!$PortObj) {
$hash->{STATE} = "error opening device";
Log 1,"Error opening Serial Device $PortName";
return "Can't open Device $PortName: $^E\n";
}
#$hash->{FD}=$PortObj->{_HANDLE};
$readyfnlist{"$a[0].$a[2]"} = $hash;
} else {
eval ("use Device::SerialPort;");
if ($@) {
$hash->{STATE} = "error using Modul Device::SerialPort";
Log 1,"Error using Device::SerialPort";
return "Can't Device::SerialPort $@\n";
}
$PortObj = new Device::SerialPort ($PortName, $quiet);
if (!$PortObj) {
$hash->{STATE} = "error opening device";
Log 1,"Error opening Serial Device $PortName";
return "Can't open Device $PortName: $^E\n";
}
$hash->{FD}=$PortObj->FILENO;
$selectlist{"$a[0].$a[2]"} = $hash;
}
#Parameter 19200,8,2,Odd,None
$PortObj->baudrate(19200);
$PortObj->databits(8);
$PortObj->parity("odd");
$PortObj->stopbits(2);
$PortObj->handshake("none");
if (! $PortObj->write_settings) {
undef $PortObj;
return "Serial write Settings failed!\n";
}
$hash->{po}=$PortObj;
$hash->{socket}=0;
}elsif($PortName=~/([\w.]+):(\d{1,5})/){
#Sockets(hostname:port)
my $host=$1;
my $port=$2;
my $xport=IO::Socket::INET->new(PeerAddr=>$host,
PeerPort=>$port,
timeout=>1,
blocking=>0
);
if (!$xport) {
$hash->{STATE} = "error opening device";
Log 1,"Error opening Connection to $PortName";
return "Can't Connect to $PortName -> $@ ( $!)\n";
}
$xport->autoflush(1);
$hash->{FD}=$xport->fileno;
$selectlist{"$a[0].$a[2]"} = $hash;
$hash->{socket}=$xport;
}else{
$hash->{STATE} = "$PortName is no device and not implemented";
Log 1,"$PortName is no device and not implemented";
return "$PortName is no device and not implemented\n";
}
Log 4, "$name connected to device $PortName";
$hash->{STATE} = "open";
$hash->{DeviceName}=$PortName;
return undef;
}
#####################################
# WS2000_Undef
# implements UnDef-Function
#
sub
WS2000_Undef($$)
{
my ($hash, $arg) = @_;
my $name = $hash->{NAME};
delete $hash->{FD};
$hash->{STATE}='close';
if ($hash->{socket}) {
$hash->{socket}->shutdown(2);
$hash->{socket}->close();
}elsif ($hash->{po}) {
$hash->{po}->close();
}
Log 5, "$name shutdown complete";
return undef;
}
#####################################
# WS2000_Set
# implement SetFn
# currently nothing to set
#
sub
WS2000_Ready($$)
{
my ($hash, $dev) = @_;
my $po=$hash->{po};
return undef if !$po;
my ($BlockingFlags, $InBytes, $OutBytes, $ErrorFlags)=$po->status;
return ($InBytes>0);
}
#####################################
# WS2000_Set
# implement SetFn
# currently nothing to set
#
sub
WS2000_Set($@)
{
my ($hash, @a) = @_;
my $msg;
my $name=$a[0];
my $reading= $a[1];
$msg="$name => No Set function ($reading) implemented";
Log 1,$msg;
return $msg;
}
#####################################
# WS2000_Get
# implement GetFn
#
sub
WS2000_Get($@)
{
my ($hash, @a) = @_;
my $u1 = "Usage: get <name> [TH0..TH7, T0..T7, I0..I7, R0..R7, W0..W7, L0..L7, P0..P7, LAST, RAW]\n" .
"get <name> list\n";
return $u1 if(int(@a) != 2);
my $name= $a[0];
my $reading= $a[1];
my $msg;
my $retval;
my $time;
my $sensor=$hash->{READINGS};
if ($reading =~/list/i) {
$msg='';
foreach my $s (keys %$sensor) {
next if !$s;
$msg.="ID:$s, Last Update ".$sensor->{$s}{TIME}."\n";
}
}else {
if(!defined($sensor->{$reading})) {
$msg="Sensor ($reading)not defined, try 'get <n<me> list'";
}else {
$retval=$sensor->{$reading}{VAL};
$time=$sensor->{$reading}{TIME};
$retval=unpack("H*",$retval) if ($reading eq 'RAW');
$msg= "$name $reading ($time) => $retval";
}
}
return $msg;
}
#####################################
# WS2000_Write
# currently dummy
#
sub
WS2000_Write($$)
{
my ($hash,$msg) = @_;
}
#####################################
# WS2000_Read
# Implements ReadFn, called from global select
#
sub
WS2000_Read($$) {
my ($hash) = @_;
my $STX=2;
my $ETX=3;
my $retval='';
my $out=undef;
my $byte;
my $name=$hash->{NAME};
my $xport=$hash->{socket};
my $PortObj=$hash->{po};
my $message=$hash->{PARTIAL}||'';
my $status=$hash->{STEP};
#read data(1 byte), because fhem select flagged data available
if ($xport) {
$xport->read($out,1);
}elsif($PortObj) {
$out = $PortObj->read(1);
}
return if(!defined($out) || length($out) == 0) ;
Log 5, "$name => WS2000/RAW: " . unpack('H*',$out);
#check for frame: STX TYP W1 W2 W3 W4 W5 ETX
$byte=ord($out);
if($byte eq $STX) {
#Log 4, "M232: return value \'" . $retval . "\'";
$status= "STX";
$message=$out;
Log 5, "WS2000 STX received";
} elsif($byte eq $ETX) {
$status= "ETX";
$message .=$out;
Log 5, "WS2000 ETX received";
} elsif ($status eq "STX"){
$message .=$out;
}
$hash->{STEP}=$status;
$hash->{PARTIAL}=$message;
if($status eq "ETX") {
WS2000_Parse($hash,$message);
}
}
#####################################
# WS2000_Parse
# decodes complete frame
# called directly from WS2000_Read
sub
WS2000_Parse($$) {
my ($hash,$msg) = @_;
my ($stx,$typ,$w1,$w2,$w3,$w4,$w5,$etx)=map {$_ & 0x7F} unpack("U*",$msg);
my $tm=TimeNow();
my $name=$hash->{NAME};
my $factor=$attr{$name}{rain}||366;
my $altitude=$attr{$name}{altitude}||0;
if ($etx != 3) {
Log 4, "$name:Frame Error!";
return undef;
}
my ($sensor,$daten1,$einheit1,$daten2,$einheit2,$daten3,$einheit3,$result,$shortname,$val, $unit);
my $group = ($typ & 0x70)/16 ;#/slash for komodo syntax checker!
my $snr = $typ % 16;
#duplicate check (repeater?)
my $prevmsg=$hash->{READINGS}{RAW}{VAL}||'';
my $prevtime=$hash->{READINGS}{RAW}{TIME}||0;
if (($prevmsg eq $msg) && ((time() - $prevtime) <10)) {
Log 4,"$name check: Duplicate detected";
return undef;
}
my $rawtext="Typ:$typ,W1:$w1,W2:$w2,W3:$w3,W4:$w4,W5:$w5";
Log 4, "$name parsing: $rawtext";
#break into sensor specs
switch ( $group ){
case 7 {
$sensor = "Fernbedienung";
$shortname='FB';
$einheit1='(CODE)';
$daten1 = $w1 * 10000 + $w2 * 1000 + $w3 * 100 + $w4 * 10 + $w5;
$result = $shortname . " => D=" . $daten1 . $einheit1;
}
case 0 {
if ($snr < 8) {
$sensor = "Temperatursensor V1.1(" . $snr . ")";
}else{
$snr -= 8;
$sensor = "Temperatursensor V1.2(" .$snr. ")";
}
$daten1 = (($w1 * 128 + $w2) );
if ($daten1 >= 16085)
{
$daten1 = $daten1 - 16384;
}
$daten1 = $daten1 / 10;
$shortname='TX'.$snr;
$einheit1 = " C";
$result = $shortname . " => T:" . $daten1 . $einheit1;
}
case 1 {
if ($snr <8) {
$sensor = "Temperatursensor mit Feuchte V1.1(" . $snr . ")";
}else{
$snr -= 8;
$sensor = "Temperatursensor mit Feuchte V1.2(" . $snr . ")";
}
$daten1 = (($w1 * 128 + $w2) );
if ($daten1 >= 16085)
{
$daten1 = $daten1 - 16384;
}
$daten1 = $daten1 / 10;
$shortname='TH'.$snr;
$einheit1 = " C";
$daten2 = $w3;
$daten3 = 0;
$einheit2 = " %";
$result = $shortname . " => T:" . $daten1 . $einheit1 . ", H:" . $daten2 .$einheit2;
}
case 2 {
if ( $snr < 8 ) {
$sensor = "Regensensor V1.1(" . $snr . ")";
}else{
$snr -= 8;
$sensor = "Regensensor V1.2(" . $snr . ")"
}
$shortname='R'.$snr;
$daten1 = ($w1 * 128 + $w2);
$einheit1= ' Imp';
my $prev=$hash->{READINGS}{$shortname}{VAL};
if ($prev && $prev=~/C=(\d+)/i) {
$prev=$1;
}else {
$prev=0;
}
my $diff=$daten1-$prev;
$daten2= $diff * $factor/1000;
$einheit2 = " l/m2";
$result = $shortname
. " => M:".$daten2. $einheit2."(". $diff . $einheit1 ." x Faktor $factor)"
. ", C:$daten1, P:$prev" ;
}
case 3 {
if ($snr < 8) {
$sensor = "Windsensor V1.1(" . $snr . ")";
}else{
$snr -= 8;
$sensor = "Windsensor V1.2(" . $snr . ")";
}
switch( $w3) {
case 0 { $daten3 = 0;}
case 1 { $daten3 = 22.5;}
case 2 { $daten3 = 45;}
case 3 { $daten3 = 67.5;}
}
$einheit3 = " +/-";
$daten1 = ($w1 * 128 + $w2) / 10;
$daten2 = $w4 * 128 + $w5;
$einheit1 = " km/h";
$einheit2 = " Grad";
$shortname='W'.$snr;
my @wr=("N","NNO","NO","ONO","O","OSO","SO","SSO","S","SSW","SW","WSW","W","WNW","NW","NNW");
my @bf=(0,0.7,5.4,11.9,19.4,38.7,49.8,61.7,74.6,88.9,102.4,117.4);
my @bfn=("Windstille","leiser Zug","leichte Brise","schwache Brise","maessige Brise","frische Brise",
"starker Wind","steifer Wind","stuermischer Wind","Sturm","schwerer Sturm","orkanartiger Sturm","Orkan");
my $i=1;
foreach (1..$#bf) {
if ($daten1<$bf[$i]) {
last;
}
$i++;
}
$i--;
#windrichtung
my $w=int($daten2/22.5+0.5);
if ($w ==16) {$w=0;}
$result = $shortname
. " => S:" . $daten1 . $einheit1
. ", BF:$i($bfn[$i])"
. " ,R:" . $daten2 . $einheit2
. "($wr[$w])".$einheit3. $daten3;
}
case 4 {
if ($snr < 8) {
$sensor = "Innensensor V1.1(" . $snr . ")";
}else{
$snr -= 8;
$sensor = "Innensensor V1.2(" . $snr . ")";
}
$daten1 = (($w1 * 128 + $w2) );
if ($daten1 >= 16085)
{
$daten1 = $daten1 - 16384;
}
$daten1 = $daten1 / 10;
$shortname='I'.$snr;
$daten2 = $w3;
$daten3 = $w4 * 128 + $w5;
$einheit1 = " C";
$einheit2 = " %";
$einheit3 = " hPa";
$result = $shortname
. " => T:" . $daten1 . $einheit1
. ", H:" . $daten2 . $einheit2
. ", D:" . $daten3 . $einheit3;
}
case 5 {
$snr -= 8 if $snr>7;; #only V1.2 sensors exists
$sensor = "Helligkeitssensor V1.2(" . $snr . ")";
$shortname='L'.$snr;
switch ($w3) {
case 0 {$daten1 = 1;}
case 1 {$daten1 = 10;}
case 2 {$daten1 = 100;}
case 3 {$daten1 = 1000;}
}
$daten1 = $daten1 * ($w1 * 128 + $w2);
$einheit1 = "Lux";
$result = $shortname . " => L:" . $daten1 . $einheit1;
}
case 6 {
#Sensor has been never produced, but maybe there are personal implementations
$snr -= 8 if $snr>7;
$sensor = "Pyranometer V1.2(" . $snr . ")";
$shortname='P'.$snr;
switch ($w3) {
case 0 {$daten1 = 1;}
case 1 {$daten1 = 10;}
case 2 {$daten1 = 100;}
case 3 {$daten1 = 1000;}
}
$daten1 = $daten1 * ($w1 * 128 + $w2);
$einheit1 = " W/m2";
$result = $shortname . " => P:" . $daten1 . $einheit1;
}
else {
$shortname="U";
$sensor = "unknown";
$daten1 = $typ;
$result = "(Group:" . $group . "/Typ:" . $typ . ")";
Log 1, "$name => Unknown sensor detected". $result
}#switch else
}#switch
#store result
Log 4, $name." result:".$result;
$rawtext='RAW => '.$rawtext;
$hash->{READINGS}{LAST}{VAL}=$result;
$hash->{READINGS}{LAST}{TIME}=$tm;
$hash->{READINGS}{RAW}{TIME}=time();
$hash->{READINGS}{RAW}{VAL}=$msg;
$hash->{READINGS}{$shortname}{VAL}=$result;
$hash->{READINGS}{$shortname}{TIME}=$tm;
$hash->{STATE}=$result;
$hash->{CHANGED}[0] = $result;
$hash->{CHANGETIME}[0]=$tm;
$hash->{CHANGED}[1] = $rawtext;
$hash->{CHANGETIME}[1]=$tm;
#notify system
DoTrigger($name, undef);
return $result;
}
#####################################
sub
WS2000_List($$)
{
my ($hash,$msg) = @_;
$msg=WS2000_Get($hash,$hash->{NAME},'list');
return $msg;
}
1;

140
fhem/FHEM/88_ALL4000T.pm
View File

@ -1,140 +0,0 @@
################################################################
#
# Copyright notice
#
# (c) 2010 Sacha Gloor (sacha@imp.ch)
#
# 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.
# 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!
#
################################################################
package main;
use strict;
use warnings;
use XML::Simple;
use Data::Dumper;
use LWP::UserAgent;
use HTTP::Request;
sub Log($$);
#####################################
sub
trim($)
{
my $string = shift;
$string =~ s/^\s+//;
$string =~ s/\s+$//;
return $string;
}
sub
ALL4000T_Initialize($)
{
my ($hash) = @_;
# Consumer
$hash->{DefFn} = "ALL4000T_Define";
$hash->{AttrList}= "model:ALL4000T delay loglevel:0,1,2,3,4,5,6";
}
#####################################
sub
ALL4000T_Define($$)
{
my ($hash, $def) = @_;
my $name=$hash->{NAME};
my @a = split("[ \t][ \t]*", $def);
Log 5, "ALL4000T Define: $a[0] $a[1] $a[2] $a[3] $a[4]";
return "Define the host as a parameter i.e. ALL4000T" if(@a < 4);
my $host = $a[2];
my $host_port = $a[3];
my $delay=$a[4];
$attr{$name}{delay}=$delay if $delay;
Log 1, "ALL4000T device is none, commands will be echoed only" if($host eq "none");
$hash->{Host} = $host;
$hash->{Host_Port} = $host_port;
$hash->{STATE} = "Initialized";
Log 4,"$name: Delay $delay";
InternalTimer(gettimeofday()+$delay, "ALL4000T_GetStatus", $hash, 0);
return undef;
}
#####################################
sub
ALL4000T_GetStatus($)
{
my ($hash) = @_;
my $buf;
if(!defined($hash->{Host_Port})) { return(""); }
Log 5, "ALL4000T_GetStatus";
my $name = $hash->{NAME};
my $host = $hash->{Host};
my $host_port = $hash->{Host_Port};
my $text='';
my $err_log='';
my $delay=$attr{$name}{delay}||300;
InternalTimer(gettimeofday()+$delay, "ALL4000T_GetStatus", $hash, 0);
my $xml = new XML::Simple;
my $URL="http://".$host."/xml";
my $agent = LWP::UserAgent->new(env_proxy => 1,keep_alive => 1, timeout => 3);
my $header = HTTP::Request->new(GET => $URL);
my $request = HTTP::Request->new('GET', $URL, $header);
my $response = $agent->request($request);
$err_log.= "Can't get $URL -- ".$response->status_line
unless $response->is_success;
if($err_log ne "")
{
Log GetLogLevel($name,2), "ALL4000T ".$err_log;
return("");
}
my $body = $response->content;
my $data = $xml->XMLin($body);
my $current=trim($data->{BODY}->{FORM}->{TEXTAREA}->{xml}->{data}->{$host_port});
$text="Temperature: ".$current;
my $sensor="temperature";
Log 4,"$name: $text";
if (!$hash->{local}){
$hash->{CHANGED}[0] = $text;
$hash->{READINGS}{$sensor}{TIME} = TimeNow();
$hash->{READINGS}{$sensor}{VAL} = $current." (Celsius)";;
DoTrigger($name, undef) if($init_done);
}
$hash->{STATE} = "T: ".$current;
return($text);
}
1;

150
fhem/FHEM/88_IPWE.pm
View File

@ -1,150 +0,0 @@
package main;
##############################################
# 88_IPWE.pm
# Modul for FHEM
#
# contributed by thomas dressler 2008
# $Id: 88_IPWE.pm,v 1.1 2008-05-18 12:05:24 tdressler Exp $
use strict;
use warnings;
use IO::Socket::INET;
use vars qw {%attr $init_done}; #make komodo happy
sub Log($$);
#####################################
sub
IPWE_Initialize($)
{
my ($hash) = @_;
# Consumer
$hash->{DefFn} = "IPWE_Define";
$hash->{GetFn} = "IPWE_Get";
$hash->{AttrList}= "model:ipwe delay loglevel:0,1,2,3,4,5,6";
}
#####################################
sub
IPWE_Define($$)
{
my ($hash, $def) = @_;
my $name=$hash->{NAME};
my @a = split("[ \t][ \t]*", $def);
Log 5, "IPWE Define: $a[0] $a[1] $a[2] $a[3]";
return "Define the host as a parameter i.e. ipwe" if(@a < 3);
my $host = $a[2];
my $delay=$a[3];
$attr{$name}{delay}=$delay if $delay;
Log 1, "ipwe device is none, commands will be echoed only" if($host eq "none");
my $socket = IO::Socket::INET->new(PeerAddr=>$host,
PeerPort=>80, #http
timeout=>2,
blocking=>1
);
if (!$socket) {
$hash->{STATE} = "error opening device";
Log 1,"$name: Error opening Connection to $host";
return "Can't Connect to $host -> $@ ( $!)\n";
}
$socket->close;
$hash->{Host} = $host;
$hash->{STATE} = "Initialized";
InternalTimer(gettimeofday()+$delay, "IPWE_GetStatus", $hash, 0);
return undef;
}
sub IPWE_Get($@)
{
my ($hash, @a) = @_;
return "argument is missing" if(int(@a) != 2);
my $msg;
$hash->{LOCAL} = 1;
my $v = IPWE_GetStatus($hash);
delete $hash->{LOCAL};
my @data=split (/\n/, $v);
if($a[1] eq "status") {
$msg= "$a[0] $a[1] =>".$/."$v";
}else {
my ($l)= grep {/$a[1]/}@data;
chop($l);
$msg="$a[0] $a[1] =>$l";
}
$msg="$a[0]: Unknown get command $a[1]" if (!$msg);
return $msg;
}
#####################################
sub
IPWE_GetStatus($)
{
my ($hash) = @_;
my $buf;
Log 5, "IPWE_GetStatus";
my $name = $hash->{NAME};
my $host = $hash->{Host};
my $text='';
my $alldata='';
my $delay=$attr{$name}{delay}||300;
InternalTimer(gettimeofday()+$delay, "IPWE_GetStatus", $hash, 0);
my $socket = IO::Socket::INET->new(PeerAddr=>$host,
PeerPort=>80, #http
timeout=>2,
blocking=>1
);
if (!$socket) {
$hash->{STATE} = "error opening device";
Log 1,"$name: Error opening Connection to $host";
return "Can't Connect to $host -> $@ ( $!)\n";
}
Log 5, "$name: Connected to $host";
$socket->autoflush(1);
$socket->write("GET /ipwe.cgi HTTP/1.0\r\n");
my @lines=$socket->getlines();
close $socket;
Log 5,"$name: Data received";
my $allines=join('',@lines);
my (@tables)= ($allines=~m#<tbody>(?:(?!<tbody>).)*</tbody>#sgi);
my ($datatable)=grep{/Sensortyp/} @tables;
my (@rows)=($datatable=~m#<tr>(?:(?!<tr>).)*</tr>#sgi);
foreach my $l(@rows) {
next if ($l=~/Sensortyp/); #headline
my ($typ,$id,$sensor,$temp,$hum,$wind,$rain)=($l=~m#<td.*?>(.*?)<br></td>#sgi);
next if ($typ=~/^\s+$/);
$text= "Typ: $typ, ID: $id, Name $sensor, T: $temp H: $hum";
if ($id == 8) {
$text.= ",W: $wind, R: $rain";
}
Log 5,"$name: $text";
if (!$hash->{local}){
$hash->{CHANGED}[0] = $text;
$hash->{READINGS}{$sensor}{TIME} = TimeNow();
$hash->{READINGS}{$sensor}{VAL} = $text;;
DoTrigger($name, undef) if($init_done);
}
$alldata.="$text\n";
}
return $alldata;
}
1;

261
fhem/FHEM/88_VantagePro2.pm
View File

@ -1,261 +0,0 @@
################################################################
#
# Copyright notice
#
# (c) 2010 Sacha Gloor (sacha@imp.ch)
#
# 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.
# 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!
#
################################################################
package main;
use strict;
use warnings;
use Data::Dumper;
use Net::Telnet;
sub Log($$);
#####################################
sub
VantagePro2_Initialize($)
{
my ($hash) = @_;
# Consumer
$hash->{DefFn} = "VantagePro2_Define";
$hash->{AttrList}= "model:VantagePro2 delay loglevel:0,1,2,3,4,5,6";
}
#####################################
sub
VantagePro2_Define($$)
{
my ($hash, $def) = @_;
my $name=$hash->{NAME};
my @a = split("[ \t][ \t]*", $def);
Log 5, "VantagePro2 Define: $a[0] $a[1] $a[2] $a[3]";
return "Define the host as a parameter i.e. VantagePro2" if(@a < 3);
my $host = $a[2];
my $port=$a[3];
my $delay=$a[4];
$attr{$name}{delay}=$delay if $delay;
Log 1, "VantagePro2 device is none, commands will be echoed only" if($host eq "none");
$hash->{Host} = $host;
$hash->{Port} = $port;
$hash->{STATE} = "Initialized";
InternalTimer(gettimeofday()+$delay, "VantagePro2_GetStatus", $hash, 0);
return undef;
}
#####################################
sub
VantagePro2_GetStatus($)
{
my ($hash) = @_;
my $buf;
Log 5, "VantagePro2_GetStatus";
my $name = $hash->{NAME};
my $host = $hash->{Host};
my $port = $hash->{Port};
my $text='';
my $err_log='';
my $answer;
my $sensor;
my $delay=$attr{$name}{delay}||300;
InternalTimer(gettimeofday()+$delay, "VantagePro2_GetStatus", $hash, 0);
my $tel=new Net::Telnet(Host => $host, Port => $port,Timeout => 3, Binmode => 1, Telnetmode => 0, Errmode => "return");
if(!defined($tel))
{
Log 4,"$name: Error connecting to $host:$port";
}
else
{
$tel->print("");
$answer=$tel->get();
$tel->print("TEST");
$answer=$tel->get();
$tel->print("LOOP 1");
$answer=$tel->get();
$tel->close();
my $offset=1;
my $t;
my $btrend="";
$t=substr($answer,$offset+3,1);
my ($bartrend)=unpack("c1",$t);
$t=substr($answer,$offset+7,2);
my ($barometer)=unpack("s2",$t);
$barometer=sprintf("%.02f",$barometer/1000*2.54);
$t=substr($answer,$offset+9,2);
my ($itemp)=unpack("s2",$t);
$t=substr($answer,$offset+11,1);
my ($ihum)=unpack("c1",$t);
$t=substr($answer,$offset+12,2);
my ($otemp)=unpack("s2",$t);
$t=substr($answer,$offset+33,1);
my ($ohum)=unpack("c1",$t);
$t=substr($answer,$offset+14,1);
my ($windspeed)=unpack("c1",$t);
$t=substr($answer,$offset+15,1);
my ($avgwindspeed)=unpack("c1",$t);
$t=substr($answer,$offset+16,2);
my ($winddir)=unpack("s1",$t);
$t=substr($answer,$offset+41,2);
my ($rainrate)=unpack("s2",$t);
$t=substr($answer,$offset+43,1);
my ($uv)=unpack("c1",$t);
$t=substr($answer,$offset+44,2);
my ($solar)=unpack("s2",$t);
$t=substr($answer,$offset+50,2);
my ($drain)=unpack("s2",$t);
$t=substr($answer,$offset+52,2);
my ($mrain)=unpack("s2",$t);
$t=substr($answer,$offset+54,2);
my ($yrain)=unpack("s2",$t);
$itemp=sprintf("%.02f",(($itemp/10)-32)*5/9);
$otemp=sprintf("%.02f",(($otemp/10)-32)*5/9);
$rainrate=sprintf("%.02f",$rainrate/5);
$windspeed=sprintf("%.02f",$windspeed*1.609);
$avgwindspeed=sprintf("%.02f",$avgwindspeed*1.609);
$uv=$uv/10;
if($bartrend==0) { $btrend="Steady"; }
elsif($bartrend==20) { $btrend="Rising Slowly"; }
elsif($bartrend==60) { $btrend="Rising Rapidly"; }
elsif($bartrend==-20) { $btrend="Falling Slowly"; }
elsif($bartrend==-60) { $btrend="Falling Rapidly"; }
$text="T-OUT: ".$otemp." T-IN: ".$itemp." H-OUT: ".$ohum." H-IN: ".$ihum." W: ".$windspeed." W-AV: ".$avgwindspeed." WD: ".$winddir." R: ".$rainrate." S: ".$solar." UV: ".$uv." RD: ".$drain." RM: ".$mrain. " RY: ".$yrain." BM: ".$barometer." BT: ".$btrend;
my $n=0;
Log 4,"$name: $text";
if (!$hash->{local}){
$sensor="temperature-outside";
$hash->{CHANGED}[$n++] = "Temperature Outside: ".$otemp;
$hash->{READINGS}{$sensor}{TIME} = TimeNow();
$hash->{READINGS}{$sensor}{VAL} = $otemp." (Celsius)";;
$sensor="temperature-inside";
$hash->{CHANGED}[$n++] = "Temperature Inside: ".$itemp;
$hash->{READINGS}{$sensor}{TIME} = TimeNow();
$hash->{READINGS}{$sensor}{VAL} = $itemp." (Celsius)";;
$sensor="humidity outside";
$hash->{CHANGED}[$n++] = "Humidity Outside: ".$ohum;
$hash->{READINGS}{$sensor}{TIME} = TimeNow();
$hash->{READINGS}{$sensor}{VAL} = $ohum." (%)";;
$sensor="humidity inside";
$hash->{CHANGED}[$n++] = "Humidity Inside: ".$ihum;
$hash->{READINGS}{$sensor}{TIME} = TimeNow();
$hash->{READINGS}{$sensor}{VAL} = $ihum." (%)";;
$sensor="windspeed";
$hash->{CHANGED}[$n++] = "Wind: ".$windspeed;
$hash->{READINGS}{$sensor}{TIME} = TimeNow();
$hash->{READINGS}{$sensor}{VAL} = $windspeed." (km/h)";;
$sensor="10 min. average windspeed";
$hash->{CHANGED}[$n++] = "10 Min. Wind: ".$avgwindspeed;
$hash->{READINGS}{$sensor}{TIME} = TimeNow();
$hash->{READINGS}{$sensor}{VAL} = $avgwindspeed." (km/h)";;
$sensor="wind direction";
$hash->{CHANGED}[$n++] = "Wind Direction: ".$winddir;
$hash->{READINGS}{$sensor}{TIME} = TimeNow();
$hash->{READINGS}{$sensor}{VAL} = $winddir." (Degrees)";;
$sensor="solar";
$hash->{CHANGED}[$n++] = "Solar: ".$solar;
$hash->{READINGS}{$sensor}{TIME} = TimeNow();
$hash->{READINGS}{$sensor}{VAL} = $solar." (Watt/m^2)";;
$sensor="UV";
$hash->{CHANGED}[$n++] = "UV: ".$uv;
$hash->{READINGS}{$sensor}{TIME} = TimeNow();
$hash->{READINGS}{$sensor}{VAL} = $uv." (UV/Index)";;
$sensor="rainrate";
$hash->{CHANGED}[$n++] = "Rainrate: ".$rainrate;
$hash->{READINGS}{$sensor}{TIME} = TimeNow();
$hash->{READINGS}{$sensor}{VAL} = $rainrate." (mm/h)";;
$sensor="day rain";
$hash->{CHANGED}[$n++] = "Dayrain: ".$drain;
$hash->{READINGS}{$sensor}{TIME} = TimeNow();
$hash->{READINGS}{$sensor}{VAL} = $drain." (mm/day)";;
$sensor="month rain";
$hash->{CHANGED}[$n++] = "Monthrain: ".$mrain;
$hash->{READINGS}{$sensor}{TIME} = TimeNow();
$hash->{READINGS}{$sensor}{VAL} = $mrain." (mm/month)";;
$sensor="year rain";
$hash->{CHANGED}[$n++] = "Yearrain: ".$yrain;
$hash->{READINGS}{$sensor}{TIME} = TimeNow();
$hash->{READINGS}{$sensor}{VAL} = $yrain." (mm/year)";;
$sensor="barometer";
$hash->{CHANGED}[$n++] = "Barometer: ".$barometer;
$hash->{READINGS}{$sensor}{TIME} = TimeNow();
$hash->{READINGS}{$sensor}{VAL} = $barometer." (Millimeters)";;
$sensor="barometer trend";
$hash->{CHANGED}[$n++] = "Barometer Trend: ".$btrend;
$hash->{READINGS}{$sensor}{TIME} = TimeNow();
$hash->{READINGS}{$sensor}{VAL} = $btrend;
DoTrigger($name, undef) if($init_done);
}
$hash->{STATE} = $text;
}
return($text);
}
1;

151
fhem/FHEM/90_at.pm
View File

@ -1,151 +0,0 @@
##############################################
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
#####################################
sub
at_Initialize($)
{
my ($hash) = @_;
$hash->{DefFn} = "at_Define";
$hash->{UndefFn} = "at_Undef";
$hash->{AttrFn} = "at_Attr";
$hash->{AttrList} = "disable:0,1 skip_next:0,1 loglevel:0,1,2,3,4,5,6";
}
my $at_tdiff;
#####################################
sub
at_Define($$)
{
my ($hash, $def) = @_;
my ($name, undef, $tm, $command) = split("[ \t]+", $def, 4);
if(!$command) {
if($hash->{OLDDEF}) { # Called from modify, where command is optional
RemoveInternalTimer($name);
(undef, $command) = split("[ \t]+", $hash->{OLDDEF}, 2);
$hash->{DEF} = "$tm $command";
} else {
return "Usage: define <name> at <timespec> <command>";
}
}
return "Wrong timespec, use \"[+][*[{count}]]<time or func>\""
if($tm !~ m/^(\+)?(\*({\d+})?)?(.*)$/);
my ($rel, $rep, $cnt, $tspec) = ($1, $2, $3, $4);
my ($err, $hr, $min, $sec, $fn) = GetTimeSpec($tspec);
return $err if($err);
$rel = "" if(!defined($rel));
$rep = "" if(!defined($rep));
$cnt = "" if(!defined($cnt));
my $ot = gettimeofday();
my @lt = localtime($ot);
my $nt = $ot;
$nt -= ($lt[2]*3600+$lt[1]*60+$lt[0]) # Midnight for absolute time
if($rel ne "+");
$nt += ($hr*3600+$min*60+$sec); # Plus relative time
$nt += SecondsTillTomorrow($ot) if($ot >= $nt); # Do it tomorrow...
$nt += $at_tdiff if(defined($at_tdiff));
@lt = localtime($nt);
my $ntm = sprintf("%02d:%02d:%02d", $lt[2], $lt[1], $lt[0]);
if($rep) { # Setting the number of repetitions
$cnt =~ s/[{}]//g;
return undef if($cnt eq "0");
$cnt = 0 if(!$cnt);
$cnt--;
$hash->{REP} = $cnt;
} else {
$hash->{VOLATILE} = 1; # Write these entries to the statefile
}
$hash->{NTM} = $ntm if($rel eq "+" || $fn);
$hash->{TRIGGERTIME} = $nt;
RemoveInternalTimer($name);
InternalTimer($nt, "at_Exec", $name, 0);
$hash->{STATE} = ("Next: " . FmtTime($nt))
if(!($attr{$name} && $attr{$name}{disable}));
return undef;
}
sub
at_Undef($$)
{
my ($hash, $name) = @_;
RemoveInternalTimer($name);
return undef;
}
sub
at_Exec($)
{
my ($name) = @_;
my ($skip, $disable) = ("","");
return if(!$defs{$name}); # Just deleted
Log GetLogLevel($name,5), "exec at command $name";
if(defined($attr{$name})) {
$skip = 1 if($attr{$name} && $attr{$name}{skip_next});
$disable = 1 if($attr{$name} && $attr{$name}{disable});
}
delete $attr{$name}{skip_next} if($skip);
my (undef, $command) = split("[ \t]+", $defs{$name}{DEF}, 2);
$command = SemicolonEscape($command);
my $ret = AnalyzeCommandChain(undef, $command) if(!$skip && !$disable);
Log GetLogLevel($name,3), $ret if($ret);
return if(!$defs{$name}); # Deleted in the Command
my $count = $defs{$name}{REP};
my $def = $defs{$name}{DEF};
my $oldattr = $attr{$name}; # delete removes the attributes too
# Correct drift when the timespec is relative
$at_tdiff = $defs{$name}{TRIGGERTIME}-gettimeofday() if($def =~ m/^\+/);
CommandDelete(undef, $name); # Recreate ourselves
if($count) {
$def =~ s/{\d+}/{$count}/ if($def =~ m/^\+?\*{\d+}/); # Replace the count
Log GetLogLevel($name,5), "redefine at command $name as $def";
$data{AT_RECOMPUTE} = 1; # Tell sunrise compute the next day
CommandDefine(undef, "$name at $def"); # Recompute the next TRIGGERTIME
delete($data{AT_RECOMPUTE});
$attr{$name} = $oldattr;
}
$at_tdiff = undef;
}
sub
at_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" :
"Next: " . FmtTime($defs{$a[1]}{TRIGGERTIME}));
return undef;
}
1;

96
fhem/FHEM/91_notify.pm
View File

@ -1,96 +0,0 @@
##############################################
package main;
use strict;
use warnings;
#####################################
sub
notify_Initialize($)
{
my ($hash) = @_;
$hash->{DefFn} = "notify_Define";
$hash->{NotifyFn} = "notify_Exec";
$hash->{AttrFn} = "notify_Attr";
$hash->{AttrList} = "disable:0,1";
}
#####################################
sub
notify_Define($$)
{
my ($hash, $def) = @_;
my ($name, $type, $re, $command) = split("[ \t]+", $def, 4);
if(!$command) {
if($hash->{OLDDEF}) { # Called from modify, where command is optional
(undef, $command) = split("[ \t]+", $hash->{OLDDEF}, 2);
$hash->{DEF} = "$re $command";
} else {
return "Usage: define <name> notify <regexp> <command>";
}
}
# Checking for misleading regexps
eval { "Hallo" =~ m/^$re$/ };
return "Bad regexp: $@" if($@);
$hash->{REGEXP} = $re;
$hash->{STATE} = "active";
return undef;
}
#####################################
sub
notify_Exec($$)
{
my ($ntfy, $dev) = @_;
my $ln = $ntfy->{NAME};
return "" if($attr{$ln} && $attr{$ln}{disable});
my $n = $dev->{NAME};
my $re = $ntfy->{REGEXP};
my $max = int(@{$dev->{CHANGED}});
my $t = $dev->{TYPE};
my $ret = "";
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 (undef, $exec) = split("[ \t]+", $ntfy->{DEF}, 2);
my %specials= (
"%NAME" => $n,
"%TYPE" => $t,
"%EVENT" => $s
);
$exec= EvalSpecials($exec, %specials);
my $r = AnalyzeCommandChain(undef, $exec);
Log 3, $r if($r);
$ret .= " $r" if($r);
}
}
return $ret;
}
sub
notify_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;
}
1;

117
fhem/FHEM/91_sequence.pm
View File

@ -1,117 +0,0 @@
##############################################
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
#####################################
sub
sequence_Initialize($)
{
my ($hash) = @_;
$hash->{DefFn} = "sequence_Define";
$hash->{UndefFn} = "sequence_Undef";
$hash->{NotifyFn} = "sequence_Notify";
$hash->{AttrList} = "disable:0,1 loglevel:0,1,2,3,4,5,6";
}
#####################################
# define sq1 sequence reg1 [timeout reg2]
sub
sequence_Define($$)
{
my ($hash, $def) = @_;
my @def = split("[ \t]+", $def);
my $name = shift(@def);
my $type = shift(@def);
return "Usage: define <name> sequence <re1> <timeout1> <re2> ".
"[<timeout2> <re3> ...]"
if(int(@def) % 2 == 0 || int(@def) < 3);
# "Syntax" checking
for(my $i = 0; $i < int(@def); $i += 2) {
my $re = $def[$i];
my $to = $def[$i+1];
eval { "Hallo" =~ m/^$re$/ };
return "Bad regexp 1: $@" if($@);
return "Bad timeout spec $to"
if(defined($to) && $to !~ m/^\d*.?\d$/);
}
$hash->{RE} = $def[0];
$hash->{IDX} = 0;
$hash->{MAX} = int(@def);
$hash->{STATE} = "initialized";
return undef;
}
#####################################
sub
sequence_Notify($$)
{
my ($hash, $dev) = @_;
my $ln = $hash->{NAME};
return "" if($attr{$ln} && $attr{$ln}{disable});
my $n = $dev->{NAME};
my $re = $hash->{RE};
my $max = int(@{$dev->{CHANGED}});
for (my $i = 0; $i < $max; $i++) {
my $s = $dev->{CHANGED}[$i];
$s = "" if(!defined($s));
next if($n !~ m/^$re$/ && "$n:$s" !~ m/^$re$/);
RemoveInternalTimer($ln);
my $idx = $hash->{IDX} + 2;
Log GetLogLevel($ln,5), "sequence $ln matched $idx";
my @d = split("[ \t]+", $hash->{DEF});
if($idx > $hash->{MAX}) { # Last element reached
Log GetLogLevel($ln,5), "sequence $ln triggered";
DoTrigger($ln, "trigger");
$idx = 0;
} else {
$hash->{RE} = $d[$idx];
my $nt = gettimeofday() + $d[$idx-1];
InternalTimer($nt, "sequence_Trigger", $ln, 0);
}
$hash->{IDX} = $idx;
$hash->{RE} = $d[$idx];
last;
}
return "";
}
sub
sequence_Trigger($)
{
my ($ln) = @_;
my $hash = $defs{$ln};
my @d = split("[ \t]+", $hash->{DEF});
$hash->{RE} = $d[0];
$hash->{IDX} = 0;
Log GetLogLevel($ln,5), "sequence $ln timeout";
}
sub
sequence_Undef($$)
{
my ($hash, $name) = @_;
RemoveInternalTimer($name);
return undef;
}
1;

122
fhem/FHEM/91_watchdog.pm
View File

@ -1,122 +0,0 @@
##############################################
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
#####################################
sub
watchdog_Initialize($)
{
my ($hash) = @_;
$hash->{DefFn} = "watchdog_Define";
$hash->{UndefFn} = "watchdog_Undef";
$hash->{NotifyFn} = "watchdog_Notify";
$hash->{AttrList} = "disable:0,1";
}
#####################################
# defined watchme watchdog reg1 timeout reg2 command
sub
watchdog_Define($$)
{
my ($ntfy, $def) = @_;
my ($name, $type, $re1, $to, $re2, $command) = split("[ \t]+", $def, 6);
return "Usage: define <name> watchdog <re1> <timeout> <re2> <command>"
if(!$command);
# Checking for misleading regexps
eval { "Hallo" =~ m/^$re1$/ };
return "Bad regexp 1: $@" if($@);
$re2 = $re1 if($re2 eq "SAME");
eval { "Hallo" =~ m/^$re2$/ };
return "Bad regexp 2: $@" if($@);
return "Wrong timespec, must be HH:MM[:SS]"
if($to !~ m/^(\d\d):(\d\d)(:\d\d)?$/);
$to = $1*3600+$2*60+($3 ? substr($3,1) : 0);
$ntfy->{RE1} = $re1;
$ntfy->{RE2} = $re2;
$ntfy->{TO} = $to;
$ntfy->{CMD} = $command;
$ntfy->{STATE} = ($re1 eq ".") ? "active" : "defined";
watchdog_Activate($ntfy) if($ntfy->{STATE} eq "active");
return undef;
}
#####################################
sub
watchdog_Notify($$)
{
my ($ntfy, $dev) = @_;
my $ln = $ntfy->{NAME};
return "" if($attr{$ln} && $attr{$ln}{disable});
return "" if($ntfy->{INWATCHDOG});
my $n = $dev->{NAME};
my $re1 = $ntfy->{RE1};
my $re2 = $ntfy->{RE2};
my $max = int(@{$dev->{CHANGED}});
for (my $i = 0; $i < $max; $i++) {
my $s = $dev->{CHANGED}[$i];
$s = "" if(!defined($s));
if($ntfy->{STATE} =~ m/Next:/) {
if($n =~ m/^$re2$/ || "$n:$s" =~ m/^$re2$/) {
RemoveInternalTimer($ntfy);
if($re1 eq $re2) {
watchdog_Activate($ntfy);
} else {
$ntfy->{STATE} = "defined";
}
}
} elsif($n =~ m/^$re1$/ || "$n:$s" =~ m/^$re1$/) {
watchdog_Activate($ntfy);
}
}
return "";
}
sub
watchdog_Trigger($)
{
my ($ntfy) = @_;
Log(3, "Watchdog $ntfy->{NAME} triggered");
my $exec = SemicolonEscape($ntfy->{CMD});;
$ntfy->{STATE} = "triggered";
$ntfy->{INWATCHDOG} = 1;
my $ret = AnalyzeCommandChain(undef, $exec);
Log 3, $ret if($ret);
$ntfy->{INWATCHDOG} = 0;
}
sub
watchdog_Activate($)
{
my ($ntfy) = @_;
my $nt = gettimeofday() + $ntfy->{TO};
$ntfy->{STATE} = "Next: " . FmtTime($nt);
RemoveInternalTimer($ntfy);
InternalTimer($nt, "watchdog_Trigger", $ntfy, 0)
}
sub
watchdog_Undef($$)
{
my ($hash, $name) = @_;
RemoveInternalTimer($hash);
return undef;
}
1;

433
fhem/FHEM/92_FileLog.pm
View File

@ -1,433 +0,0 @@
##############################################
package main;
use strict;
use warnings;
use IO::File;
#use Devel::Size qw(size total_size);
sub seekTo($$$$);
#####################################
sub
FileLog_Initialize($)
{
my ($hash) = @_;
$hash->{DefFn} = "FileLog_Define";
$hash->{SetFn} = "FileLog_Set";
$hash->{GetFn} = "FileLog_Get";
$hash->{UndefFn} = "FileLog_Undef";
$hash->{NotifyFn} = "FileLog_Log";
$hash->{AttrFn} = "FileLog_Attr";
# logtype is used by the frontend
$hash->{AttrList} = "disable:0,1 logtype nrarchive archivedir archivecmd";
}
#####################################
sub
FileLog_Define($@)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $fh;
return "wrong syntax: define <name> FileLog filename regexp" if(int(@a) != 4);
eval { "Hallo" =~ m/^$a[3]$/ };
return "Bad regexp: $@" if($@);
my @t = localtime;
my $f = ResolveDateWildcards($a[2], @t);
$fh = new IO::File ">>$f";
return "Can't open $f: $!" if(!defined($fh));
$hash->{FH} = $fh;
$hash->{REGEXP} = $a[3];
$hash->{logfile} = $a[2];
$hash->{currentlogfile} = $f;
$hash->{STATE} = "active";
return undef;
}
#####################################
sub
FileLog_Undef($$)
{
my ($hash, $name) = @_;
close($hash->{FH});
return undef;
}
#####################################
sub
FileLog_Log($$)
{
# Log is my entry, Dev is the entry of the changed device
my ($log, $dev) = @_;
my $ln = $log->{NAME};
return if($attr{$ln} && $attr{$ln}{disable});
my $n = $dev->{NAME};
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 $t = TimeNow();
$t = $dev->{CHANGETIME}[$i] if(defined($dev->{CHANGETIME}[$i]));
$t =~ s/ /_/o; # Makes it easier to parse with gnuplot
my $fh = $log->{FH};
my @t = localtime;
my $cn = ResolveDateWildcards($log->{logfile}, @t);
if($cn ne $log->{currentlogfile}) { # New logfile
$fh->close();
HandleArchiving($log);
$fh = new IO::File ">>$cn";
if(!defined($fh)) {
Log(0, "Can't open $cn");
return;
}
$log->{currentlogfile} = $cn;
$log->{FH} = $fh;
}
print $fh "$t $n $s\n";
$fh->flush;
$fh->sync if !($^O eq 'MSWin32'); #not implemented in Windows
}
}
return "";
}
###################################
sub
FileLog_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
FileLog_Set($@)
{
my ($hash, @a) = @_;
return "no set argument specified" if(int(@a) != 2);
return "Unknown argument $a[1], choose one of reopen"
if($a[1] ne "reopen");
my $fh = $hash->{FH};
my $cn = $hash->{currentlogfile};
$fh->close();
$fh = new IO::File ">>$cn";
return "Can't open $cn" if(!defined($fh));
$hash->{FH} = $fh;
return undef;
}
###################################
# We use this function to be able to scroll/zoom in the plots created from the
# logfile. When outfile is specified, it is used with gnuplot post-processing,
# when outfile is "-" it is used to create SVG graphics
#
# Up till now following functions are impemented:
# - int (to cut off % from a number, as for the actuator)
# - delta-h / delta-d to get rain/h and rain/d values from continuous data.
#
# It will set the %data values
# min<x>, max<x>, avg<x>, cnt<x>, lastd<x>, lastv<x>, sum<x>
# for each requested column, beggining with <x> = 1
sub
FileLog_Get($@)
{
my ($hash, @a) = @_;
return "Usage: get $a[0] <infile> <outfile> <from> <to> <column_spec>...\n".
" where column_spec is <col>:<regexp>:<default>:<fn>\n" .
" see the FileLogGrep entries in he .gplot files\n" .
" <infile> is without direcory, - means the current file\n" .
" <outfile> is a prefix, - means stdout\n"
if(int(@a) < 5);
shift @a;
my $inf = shift @a;
my $outf = shift @a;
my $from = shift @a;
my $to = shift @a; # Now @a contains the list of column_specs
my $internal;
if($outf eq "INT") {
$outf = "-";
$internal = 1;
}
if($inf eq "-") {
$inf = $hash->{currentlogfile};
} else {
my $linf = "$1/$inf" if($hash->{currentlogfile} =~ m,^(.*)/[^/]*$,o);
if(!-f $linf) {
$linf = $attr{$hash->{NAME}}{archivedir} . "/" . $inf;
return "Error: cannot access $linf" if(!-f $linf);
}
$inf = $linf;
}
my $ifh = new IO::File $inf;
seekTo($inf, $ifh, $hash, $from);
#############
# Digest the input.
# last1: first delta value after d/h change
# last2: last delta value recorded (for the very last entry)
# last3: last delta timestamp (d or h)
my (@d, @fname);
my (@min, @max, @sum, @cnt, @lastv, @lastd);
for(my $i = 0; $i < int(@a); $i++) {
my @fld = split(":", $a[$i], 4);
my %h;
if($outf ne "-") {
$fname[$i] = "$outf.$i";
$h{fh} = new IO::File "> $fname[$i]";
}
$h{re} = $fld[1]; # Filter: regexp
$h{df} = defined($fld[2]) ? $fld[2] : ""; # default value
$h{fn} = $fld[3]; # function
$h{didx} = 10 if($fld[3] && $fld[3] eq "delta-d"); # delta idx, substr len
$h{didx} = 13 if($fld[3] && $fld[3] eq "delta-h");
if($fld[0] =~ m/"(.*)"/o) {
$h{col} = $1;
$h{type} = 0;
} else {
$h{col} = $fld[0]-1;
$h{type} = 1;
}
if($h{fn}) {
$h{type} = 4;
$h{type} = 2 if($h{didx});
$h{type} = 3 if($h{fn} eq "int");
}
$h{ret} = "";
$d[$i] = \%h;
$min[$i] = 999999;
$max[$i] = -999999;
$sum[$i] = 0;
$cnt[$i] = 0;
$lastv[$i] = 0;
$lastd[$i] = "undef";
}
my %lastdate;
my $d; # Used by eval functions
while(my $l = <$ifh>) {
next if($l lt $from);
last if($l gt $to);
my @fld = split("[ \r\n]+", $l); # 40%
for my $i (0..int(@a)-1) { # Process each req. field
my $h = $d[$i];
my @missingvals;
next if($h->{re} && $l !~ m/$h->{re}/); # 20%
my $col = $h->{col};
my $t = $h->{type};
my $val = undef;
my $dte = $fld[0];
if($t == 0) { # Fixed text
$val = $col;
} elsif($t == 1) { # The column
$val = $fld[$col] if(defined($fld[$col]));
} elsif($t == 2) { # delta-h or delta-d
my $hd = $h->{didx}; # TimeStamp-Length
my $ld = substr($fld[0],0,$hd); # TimeStamp-Part (hour or date)
if(!defined($h->{last1}) || $h->{last3} ne $ld) {
if(defined($h->{last1})) {
my @lda = split("[_:]", $lastdate{$hd});
my $ts = "12:00:00"; # middle timestamp
$ts = "$lda[1]:30:00" if($hd == 13);
my $v = $fld[$col]-$h->{last1};
$v = 0 if($v < 0); # Skip negative delta
$dte = "$lda[0]_$ts";
$val = sprintf("%0.1f", $v);
if($hd == 13) { # Generate missing 0 values / hour
my @cda = split("[_:]", $ld);
for(my $mi = $lda[1]+1; $mi < $cda[1]; $mi++) {
push @missingvals, sprintf("%s_%02d:30:00 0\n", $lda[0], $mi);
}
}
}
$h->{last1} = $fld[$col];
$h->{last3} = $ld;
}
$h->{last2} = $fld[$col];
$lastdate{$hd} = $fld[0];
} elsif($t == 3) { # int function
$val = $1 if($fld[$col] =~ m/^(\d+).*/o);
} else { # evaluate
$val = eval($h->{fn});
}
next if(!defined($val) || $val !~ m/^[-\.\d]+$/o);
$min[$i] = $val if($val < $min[$i]);
$max[$i] = $val if($val > $max[$i]);
$sum[$i] += $val;
$cnt[$i]++;
$lastv[$i] = $val;
$lastd[$i] = $dte;
foreach my $mval (@missingvals) {
$cnt[$i]++;
$min[$i] = 0 if(0 < $min[$i]);
}
if($outf eq "-") {
$h->{ret} .= "$dte $val\n";
foreach my $mval (@missingvals) { $h->{ret} .= $mval }
} else {
my $fh = $h->{fh}; # cannot use $h->{fh} in print directly
print $fh "$dte $val\n";
foreach my $mval (@missingvals) { print $fh $mval }
$h->{count}++;
}
}
}
$ifh->close();
my $ret = "";
for(my $i = 0; $i < int(@a); $i++) {
my $h = $d[$i];
my $hd = $h->{didx};
if($hd && $lastdate{$hd}) {
my $val = defined($h->{last1}) ? $h->{last2}-$h->{last1} : 0;
$min[$i] = $val if($min[$i] == 999999);
$max[$i] = $val if($max[$i] == -999999);
$lastv[$i] = $val if(!$lastv[$i]);
$sum[$i] = ($sum[$i] ? $sum[$i] + $val : $val);
$cnt[$i]++;
my @lda = split("[_:]", $lastdate{$hd});
my $ts = "12:00:00"; # middle timestamp
$ts = "$lda[1]:30:00" if($hd == 13);
my $line = sprintf("%s_%s %0.1f\n", $lda[0],$ts, $h->{last2}-$h->{last1});
if($outf eq "-") {
$h->{ret} .= $line;
} else {
my $fh = $h->{fh};
print $fh $line;
$h->{count}++;
}
}
if($outf eq "-") {
$h->{ret} .= "$from $h->{df}\n" if(!$h->{ret} && $h->{df} ne "");
$ret .= $h->{ret} if($h->{ret});
$ret .= "#$a[$i]\n";
} else {
my $fh = $h->{fh};
if(!$h->{count} && $h->{df} ne "") {
print $fh "$from $h->{df}\n";
}
$fh->close();
}
my $j = $i+1;
$data{"min$j"} = $min[$i] == 999999 ? "undef" : $min[$i];
$data{"max$j"} = $max[$i] == -999999 ? "undef" : $max[$i];
$data{"avg$j"} = $cnt[$i] ? sprintf("%0.1f", $sum[$i]/$cnt[$i]) : "undef";
$data{"sum$j"} = $sum[$i];
$data{"cnt$j"} = $cnt[$i] ? $cnt[$i] : "undef";
$data{"currval$j"} = $lastv[$i];
$data{"currdate$j"} = $lastd[$i];
}
if($internal) {
$internal_data = \$ret;
return undef;
}
return ($outf eq "-") ? $ret : join(" ", @fname);
}
###################################
sub
seekTo($$$$)
{
my ($fname, $fh, $hash, $ts) = @_;
# If its cached
if($hash->{pos} && $hash->{pos}{"$fname:$ts"}) {
$fh->seek($hash->{pos}{"$fname:$ts"}, 0);
return;
}
$fh->seek(0, 2); # Go to the end
my $upper = $fh->tell;
my ($lower, $next, $last) = (0, $upper/2, 0);
my $div = 2;
while() { # Binary search
$fh->seek($next, 0);
my $data = <$fh>;
if(!$data) {
$last = $next;
last;
}
if($data !~ m/^\d\d\d\d-\d\d-\d\d_\d\d:\d\d:\d\d /o) {
$next = $fh->tell;
$data = <$fh>;
if(!$data) {
$last = $next;
last;
}
# If the second line is longer then the first,
# binary search will never get it:
if($next eq $last && $data ge $ts && $div < 8192 && $next < 1024) {
$last = 0;
$div *= 2;
}
}
if($next eq $last) {
$fh->seek($next, 0);
last;
}
$last = $next;
if(!$data || $data lt $ts) {
($lower, $next) = ($next, int(($next+$upper)/$div));
} else {
($upper, $next) = ($next, int(($lower+$next)/$div));
}
}
$hash->{pos}{"$fname:$ts"} = $last;
}
1;

269
fhem/FHEM/93_FHEM2FHEM.pm
View File

@ -1,269 +0,0 @@
##############################################
package main;
use strict;
use warnings;
use Time::HiRes qw(gettimeofday);
sub FHEM2FHEM_Read($);
sub FHEM2FHEM_Ready($);
sub FHEM2FHEM_OpenDev($$);
sub FHEM2FHEM_CloseDev($);
sub FHEM2FHEM_Disconnected($);
sub FHEM2FHEM_Define($$);
sub FHEM2FHEM_Undef($$);
sub
FHEM2FHEM_Initialize($)
{
my ($hash) = @_;
# Provider
$hash->{ReadFn} = "FHEM2FHEM_Read";
$hash->{WriteFn} = "FHEM2FHEM_Write";
$hash->{ReadyFn} = "FHEM2FHEM_Ready";
$hash->{noRawInform} = 1;
# Normal devices
$hash->{DefFn} = "FHEM2FHEM_Define";
$hash->{UndefFn} = "FHEM2FHEM_Undef";
$hash->{AttrList}= "dummy:1,0 " .
"loglevel:0,1,2,3,4,5,6 ";
}
#####################################
sub
FHEM2FHEM_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
if(@a != 4 || !($a[3] =~ m/^(LOG|RAW)(:.*)$/)) {
my $msg =
"wrong syntax: define <name> FHEM2FHEM host[:port] [LOG:regexp|RAW:device]";
Log 2, $msg;
return $msg;
}
$hash->{informType} = $1;
if($1 eq "LOG") {
$hash->{regexp} = $2;
$hash->{regexp} =~ s/^://;
} else {
$hash->{remoteDevice} = $2;
$hash->{remoteDevice} =~ s/^://;
$hash->{regexpClients} = ".*";
}
my $dev = $a[2];
if($dev !~ m/^.+:[0-9]+$/) { # host:port
$dev = "$dev:2323";
$hash->{Host} = $dev;
}
$hash->{Host} = $dev;
FHEM2FHEM_CloseDev($hash); # Modify...
return FHEM2FHEM_OpenDev($hash, 0);
}
#####################################
sub
FHEM2FHEM_Undef($$)
{
my ($hash, $arg) = @_;
FHEM2FHEM_CloseDev($hash);
return undef;
}
sub
FHEM2FHEM_Write($$)
{
my ($hash,$fn,$msg) = @_;
my $dev = $hash->{Host};
if(!$hash->{TCPDev2}) {
my $conn = IO::Socket::INET->new(PeerAddr => $dev);
return if(!$conn); # Hopefuly it is reported elsewhere
$hash->{TCPDev2} = $conn;
}
my $rdev = $hash->{remoteDevice};
syswrite($hash->{TCPDev2}, "iowrite $rdev $fn $msg\n");
}
#####################################
# called from the global loop, when the select for hash->{FD} reports data
sub
FHEM2FHEM_Read($)
{
my ($hash) = @_;
my $buf = FHEM2FHEM_SimpleRead($hash);
my $name = $hash->{NAME};
###########
# Lets' try again: Some drivers return len(0) on the first read...
if(defined($buf) && length($buf) == 0) {
$buf = FHEM2FHEM_SimpleRead($hash);
}
if(!defined($buf) || length($buf) == 0) {
FHEM2FHEM_Disconnected($hash);
return "";
}
my $data = $hash->{PARTIAL};
Log 5, "FHEM2FHEM/RAW: $data/$buf";
$data .= $buf;
while($data =~ m/\n/) {
my $rmsg;
($rmsg,$data) = split("\n", $data, 2);
$rmsg =~ s/\r//;
Log GetLogLevel($name,4), "$name: $rmsg";
if($hash->{informType} eq "LOG") {
my ($type, $name, $msg) = split(" ", $rmsg, 3);
my $re = $hash->{regexp};
next if($re && !($name =~ m/^$re$/ || "$name:$msg" =~ m/^$re$/));
if(!$defs{$name}) {
LoadModule($type);
$defs{$name}{NAME} = $name;
$defs{$name}{TYPE} = $type;
$defs{$name}{READINGS}{STATE} = 'fake';
DoTrigger($name, $msg);
delete($defs{$name});
} else {
DoTrigger($name, $msg);
}
} else { # RAW
my ($type, $rname, $msg) = split(" ", $rmsg, 3);
next if($rname ne $hash->{remoteDevice});
LoadModule($type);
my %fake;
$fake{NAME} = $name;
$fake{TYPE} = $type;
Dispatch(\%fake, $msg, undef);
}
}
$hash->{PARTIAL} = $data;
}
#####################################
sub
FHEM2FHEM_Ready($)
{
my ($hash) = @_;
return FHEM2FHEM_OpenDev($hash, 1);
}
########################
sub
FHEM2FHEM_CloseDev($)
{
my ($hash) = @_;
my $name = $hash->{NAME};
my $dev = $hash->{Host};
return if(!$dev);
$hash->{TCPDev}->close() if($hash->{TCPDev});
$hash->{TCPDev2}->close() if($hash->{TCPDev2});
delete($hash->{TCPDev});
delete($hash->{TCPDev2});
delete($selectlist{"$name.$dev"});
delete($readyfnlist{"$name.$dev"});
delete($hash->{FD});
}
########################
sub
FHEM2FHEM_OpenDev($$)
{
my ($hash, $reopen) = @_;
my $dev = $hash->{Host};
my $name = $hash->{NAME};
$hash->{PARTIAL} = "";
Log 3, "FHEM2FHEM opening $name at $dev"
if(!$reopen);
# 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 $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;
if($reopen) {
Log 1, "FHEM2FHEM $dev reappeared ($name)";
} else {
Log 3, "FHEM2FHEM device opened ($name)";
}
$hash->{STATE}= "connected";
DoTrigger($name, "CONNECTED") if($reopen);
my $msg = $hash->{informType} eq "LOG" ? "inform on" : "inform raw";
syswrite($hash->{TCPDev}, $msg . "\n");
return undef;
}
sub
FHEM2FHEM_Disconnected($)
{
my $hash = shift;
my $dev = $hash->{Host};
my $name = $hash->{NAME};
return if(!defined($hash->{FD})); # Already deleted
Log 1, "$dev disconnected, waiting to reappear";
FHEM2FHEM_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");
}
########################
sub
FHEM2FHEM_SimpleRead($)
{
my ($hash) = @_;
my $buf;
if(!defined(sysread($hash->{TCPDev}, $buf, 256))) {
FHEM2FHEM_Disconnected($hash);
return undef;
}
return $buf;
}
1;

286
fhem/FHEM/95_PachLog.pm
View File

@ -1,286 +0,0 @@
#######################################################################
#
# 95_PachLog.pm
#
# Logging to www.pachube.com
# Autor: a[PUNKT]r[BEI]oo2p[PUNKT]net
# Stand: 09.09.2009
# Version: 0.9
#######################################################################
# Vorausetzung: Account bei www.pachube.com mit API-Key
#######################################################################
#
# FHEM: Neues Pachube-Device erstelle: define <NAME> PachLog API-Key
# "define PACH001 PachLog 1234kliceee77hgtzuippkk99"
#
# PACHUBE: FEED erstellen -> FEED-NR: DATASTREAM-ID:TAGS
# Beispiel: HMS_TF (Temperatur und Feuchte Sensor)
# FEED-NR: 1234
# ID 0 => Temperatur (temperature)
# ID 1 => rel. Luftfeuchte (humidity)
#
# FHEM: PachLog-Devices: PACH01
# HMS_DEVICE: HMS_TF01
# FEED-NR: 1234
# ID 0 => Temperatur (temperature)
# ID 1 => rel. Luftfeuchte (humidity)
# "set PACH01 ADD HMS_TF01 1234:0:temperature:1:humidity"
#
# Hinweise:
# Ein FEED kann nur komplett upgedated werden:
# FEED 3456 -> ID 0 -> DEVICE A
# FEED 3456 -> ID 1 -> DEVICE B
# => geht nicht
#
# Es werden nur READINGS mit einfach Werten und Zahlen unterst?tzt.
# Beispiele: NICHT unterst?tze READINGS
# cum_month => CUM_MONTH: 37.173 CUM: 108.090 COST: 0.00
# cum_day => 2009-09-09 00:03:19 T: 1511725.6 H: 4409616 W: 609.4 R: 150.4
# israining no => (yes/no)
#######################################################################
package main;
use strict;
use warnings;
use POSIX;
use Data::Dumper;
use LWP;
use LWP::UserAgent;
use HTTP::Request::Common;
#######################################################################
sub
PachLog_Initialize($)
{
my ($hash) = @_;
$hash->{DefFn} = "PachLog_Define";
$hash->{SetFn} = "PachLog_Set";
$hash->{GetFn} = "PachLog_Get";
$hash->{NotifyFn} = "PachLog_Notify";
$hash->{AttrList} = "do_not_notify:0,1 loglevel:0,5 disable:0,1";
}
#######################################################################
sub PachLog_Define($@)
{
# define <NAME> PachLog Pachube-X-API-Key
my ($hash, @a) = @_;
# X-API-Key steht im DEF %defs{<NAME>}{DEF}
# Alternativ nach $defs{<NAME>}{XAPIKEY}
my($package, $filename, $line, $subroutine) = caller(3);
Log 0 , "PachLog_Define => $package: $filename LINE: $line SUB: $subroutine \n";
Log 5, Dumper(@_) . "\n";
return "Unknown argument count " . int(@a) . " , usage set <name> dataset value or set <name> delete dataset" if(int(@a) != 1);
return undef;
}
#######################################################################
sub PachLog_Set($@)
{
# set <NAME> ADD/DEL <DEVICENAME> FEED:STREAM:VALUE:STREAM:VALUE&FEED-2:STEAM,VALUE
my ($hash, @a) = @_ ;
# FHEMWEB Frage....Auswahliste
return "Unknown argument $a[1], choose one of ". join(" ",sort keys %{$hash->{READINGS}}) if($a[1] eq "?");
# Pruefen Uebergabeparameter
# @a => a[0]:<NAME>; a[1]=ADD oder DEL; a[2]= DeviceName;
# a[3]=FEED:STREAM:VALUE:STREAM:VALUE&FEED-2:STREAM,VALUE
# READINGS setzten oder l?schen
if($a[1] eq "DEL")
{
GetLogLevel($a[0],2),"PACHLOG -> DELETE: A0= ". $a[0] . " A1= " . $a[1] . " A2=" . $a[2];
if(defined($hash->{READINGS}{$a[2]}))
{
delete($hash->{READINGS}{$a[2]})
}
}
if($a[1] eq "ADD")
{
if(!defined($defs{$a[2]})) {return "PACHLOG[". $a[2] . "] => Unkown Device";}
# Mindestens 3 Parameter
my @b = split(/:/, $a[3]);
return "PACHLOG[". $a[2] . "] => Argumenete: " . $a[3] . " nicht eindeutig => mind. 3 => FEED-NR:DATASTREAM:READING" if(int(@b) < 3);
my $feednr = shift(@b);
#FEED-Nr darf nur Zahlen enthalten
if($feednr !~ /^\d+$/) {return "PACHLOG[". $a[2] . "] => FEED-Nr >" . $feednr . "< ist ungueltig";}
# ??? Pruefen ob READING vorhanden ???
my ($i,$j);
for ($i=0;$i<@b;$i++)
{
#Stream nur Zahlen
if($b[$i] !~ /^\d+$/) {return "PACHLOG => FEED-Nr[" . $feednr ."] Stream-ID >" . $b[$i] . "< ungueltig";}
# Reading existiert
$j = $i + 1;
if(!defined($defs{$a[2]}{READINGS}{$b[$j]})) {return "PACHLOG[". $a[2] . "] => Unkown READING >" . $b[$j] . "<";}
# READING-Value validieren
my $r = $defs{$a[2]}{READINGS}{$b[$j]}{VAL};
my $rn = &ReadingToNumber($r);
if(!defined($rn)) {return "PACHLOG[". $a[$i] . "] => READING not supported >" . $b[$j] . "<";}
$i = $j;
}
$hash->{READINGS}{$a[2]}{TIME} = TimeNow();
$hash->{READINGS}{$a[2]}{VAL} = $a[3];
}
$hash->{CHANGED}[0] = $a[1];
$hash->{STATE} = $a[1];
return undef;
return "Unknown argument count " . int(@a) . " , usage set <name> ADD/DEL <DEVICE-NAME> FEED:STREAM:VALUE:STREAM:VALUE&FEED-2:STREAM,VALUE" if(int(@a) != 4);
}
#######################################################################
sub PachLog_Get()
{
# OHNE FUNKTION ....
my ($name, $x_key) = @_;
my($package, $filename, $line, $subroutine) = caller(3);
Log 5, "PachLog_Get => $package: $filename LINE: $line SUB: $subroutine \n";
Log 5, Dumper(@_) . "\n";
}
#######################################################################
sub PachLog_Notify ($$)
{
my ($me, $trigger) = @_;
my $d = $me->{NAME};
return "" if($attr{$d} && $attr{$d}{disable});
my $t = $trigger->{NAME};
#LogLevel
my $ll;
if(defined($attr{$d}{'loglevel'})){$ll = $attr{$d}{'loglevel'};}
else {$ll = 5;}
# Eintrag fuer Trigger-Device vorhanden
if(!defined($defs{$d}{READINGS}{$t}))
{
Log $ll, ("PACHLOG[INFO] => " . $t . " => Nicht definiert");
return undef;}
# Umwandeln 1234:0:temperature:1:humidity => %feed
# Struktur:
# %feed{FEED-NR}{READING}{VAL}
# %feed{FEED-NR}{READING}{DATASTREAM}
my ($dat,@a,$feednr,$i,$j);
my %feed = ();
$dat = $defs{$d}{READINGS}{$t}{VAL};
@a = split(/:/, $dat);
$feednr = shift(@a);
for ($i=0;$i<@a;$i++)
{
$j = $i + 1;
$feed{$feednr}{$a[$j]}{STREAM} = $a[$i];
$i = $j;
}
# Werte aus Trigger-Device
foreach my $r (keys %{$feed{$feednr}})
{
$i = $defs{$t}{READINGS}{$r}{VAL};
# Werte Normalisieren
# Einheit -> 21,1 (celsius) -> 21,1
# FS20: VAL = on => 1 && VAL = off => 0
# @a = split(' ', $i);
# $feed{$feednr}{$r}{VAL} = &ReadingToNumber($a[0]) ;
$feed{$feednr}{$r}{VAL} = &ReadingToNumber($i,$ll) ;
}
# Log $ll, "PACHLOG => dumper(FEED) => " .Dumper(%feed);
# CVS-Data
my @cvs = ();
foreach my $r (keys %{$feed{$feednr}}) {
$cvs[$feed{$feednr}{$r}{STREAM}] = $feed{$feednr}{$r}{VAL};
}
my $cvs_data = join(',',@cvs);
Log $ll, "PACHLOG[CVSDATA] => $cvs_data";
# Aufbereiten %feed als EEML-Data
my $eeml = "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
$eeml .= "<eeml xmlns=\"http://www.eeml.org/xsd/005\">\n";
$eeml .= "<environment>\n";
foreach my $r (keys %{$feed{$feednr}})
{
$eeml .= "<data id=\"" . $feed{$feednr}{$r}{STREAM} . "\">\n";
$eeml .= "<value>" . $feed{$feednr}{$r}{VAL} . "</value>\n";
# Unit fuer EEML: <unit symbol="C" type="derivedSI">Celsius</unit>
my ($u_name,$u_symbol,$u_type,$u_tag) = split(',',&PachLog_ReadingToUnit($r,$ll));
if(defined($u_name)) {
$eeml .= "<tag>". $u_tag . "</tag>\n";
$eeml .= "<unit symbol=\"" . $u_symbol. "\" type=\"" . $u_type. "\">" . $u_name . "<\/unit>\n";
}
$eeml .= "</data>\n";
}
$eeml .= "</environment>\n";
$eeml .= "</eeml>\n";
Log $ll, "PACHLOG -> " . $t . " EEML => " . $eeml;
# Pachube-Update per EEML -> XML
my ($res,$ret,$ua,$apiKey,$url);
$apiKey = $defs{$d}{DEF};
$url = "http://www.pachube.com/api/feeds/" . $feednr . ".xml";
$ua = new LWP::UserAgent;
$ua->default_header('X-PachubeApiKey' => $apiKey);
#Timeout 3 sec ... default 180sec
$ua->timeout(3);
$res = $ua->request(PUT $url,'Content' => $eeml);
# Ueberpruefen wir, ob alles okay war:
if ($res->is_success())
{
Log 0,("PACHLOG => Update[" . $t ."]: " . $cvs_data . " >> SUCCESS\n");
# Time setzten
$defs{$d}{READINGS}{$t}{TIME} = TimeNow();
}
else {Log 0,("PACHLOG => Update[" . $t ."] ERROR: " . ($res->as_string) . "\n");}
}
################################################################################
sub PachLog_ReadingToUnit($$)
{
# Unit fuer EEML: <unit symbol="C" type="derivedSI">Celsius</unit>
# Input: READING z.B. temperature
# Output: Name,symbol,Type,Tag z.B. Celsius,C,derivedSI
# weiters => www.eeml.org
# No Match = undef
my ($in,$ll) = @_;
my %unit = ();
%unit = (
'temperature' => "Celsius,C,derivedSI,Temperature",
'dewpoint' => "Celsius,C,derivedSI,Temperature",
'current' => "Power,kW,derivedSI,EnergyConsumption",
'humidity' => "Humidity,rel%,contextDependentUnits,Humidity",
'rain' => "Rain,l/m2,contextDependentUnits,Rain",
'rain_now' => "Rain,l/m2,contextDependentUnits,Rain",
'wind' => "Wind,m/s,contextDependentUnits,Wind",
);
if(defined($unit{$in})) {
Log $ll ,("PACHLOG[ReadingToUnit] " . $in . " >> " . $unit{$in} );
return $unit{$in};}
else {return undef;}
}
################################################################################
sub ReadingToNumber($$)
{
# Input: reading z.B. 21.1 (Celsius) oder dim10%, on-for-oldtimer etc.
# Output: 21.1 oder 10
# ERROR = undef
# Alles au?er Nummern loeschen $t =~ s/[^0123456789.-]//g;
my ($in,$ll) = @_;
Log $ll, "PACHLOG[ReadingToNumber] => in => $in";
# Bekannte READINGS FS20 Devices oder FHT
if($in =~ /^on|Switch.*on/i) {$in = 1;}
if($in =~ /^off|Switch.*off|lime-protection/i) {$in = 0;}
# Keine Zahl vorhanden
if($in !~ /\d{1}/) {
Log $ll, "PACHLOG[ReadingToNumber] No Number: $in";
return undef;}
# Mehrfachwerte in READING z.B. CUM_DAY: 5.040 CUM: 334.420 COST: 0.00
my @b = split(' ', $in);
if(int(@b) gt 2) {
Log $ll, "PACHLOG[ReadingToNumber] Not Supportet Reading: $in";
return undef;}
# Nur noch Zahlen z.B. dim10% = 10 oder 21.1 (Celsius) = 21.1
if (int(@b) eq 2){
Log $ll, "PACHLOG[ReadingToNumber] Split:WhiteSpace-0- $b[0]";
$in = $b[0];
}
$in =~ s/[^0123456789.-]//g;
Log $ll, "PACHLOG[ReadingToNumber] => out => $in";
return $in
}
1;

203
fhem/FHEM/95_holiday.pm
View File

@ -1,203 +0,0 @@
package main;
use strict;
use warnings;
use POSIX;
sub holiday_refresh($$);
#####################################
sub
holiday_Initialize($)
{
my ($hash) = @_;
$hash->{DefFn} = "holiday_Define";
$hash->{GetFn} = "holiday_Get";
$hash->{UndefFn} = "holiday_Undef";
}
#####################################
sub
holiday_Define($$)
{
my ($hash, $def) = @_;
return holiday_refresh($hash->{NAME}, undef) if($init_done);
InternalTimer(gettimeofday()+1, "holiday_refresh", $hash->{NAME}, 0);
return undef;
}
sub
holiday_Undef($$)
{
my ($hash, $name) = @_;
RemoveInternalTimer($name);
return undef;
}
sub
holiday_refresh($$)
{
my ($name, $fordate) = (@_);
my $hash = $defs{$name};
my $internal;
return if(!$hash); # Just deleted
my $nt = gettimeofday();
my @lt = localtime($nt);
my @fd;
if(!$fordate) {
$internal = 1;
$fordate = sprintf("%02d-%02d", $lt[4]+1, $lt[3]);
@fd = @lt;
} else {
my ($m,$d) = split("-", $fordate);
@fd = localtime(mktime(1,1,1,$d,$m-1,$lt[5],0,0,-1));
}
my $fname = $attr{global}{modpath} . "/FHEM/" . $hash->{NAME} . ".holiday";
return "Can't open $fname: $!" if(!open(FH, $fname));
my $found = "none";
while(my $l = <FH>) {
next if($l =~ m/^\s*#/);
next if($l =~ m/^\s*$/);
chomp($l);
if($l =~ m/^1/) { # Exact date: 1 MM-DD Holiday
my @args = split(" +", $l, 3);
if($args[1] eq $fordate) {
$found = $args[2];
last;
}
} elsif($l =~ m/^2/) { # Easter date: 2 +1 Ostermontag
eval { require DateTime::Event::Easter } ;
if( $@) {
Log 1, "$@";
} else {
my @a = split(" +", $l, 3);
my $dt = DateTime::Event::Easter->new(day=>$a[1])
->following(DateTime->new(year=>(1900+$lt[5])));
next if($dt->day != $fd[3] || $dt->month != $fd[4]+1);
$found = $a[2];
last;
}
} elsif($l =~ m/^3/) { # Relative date: 3 -1 Mon 03 Holiday
my @a = split(" +", $l, 5);
my %wd = ("Sun"=>0, "Mon"=>1, "Tue"=>2, "Wed"=>3,
"Thu"=>4, "Fri"=>5, "Sat"=>6);
my @md = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
$md[1]=29 if(schaltjahr($fd[5]+1900) && $fd[4] == 1);
my $wd = $wd{$a[2]};
if(!defined($wd)) {
Log 1, "Wrong timespec: $l";
next;
}
next if($wd != $fd[6]); # Weekday
next if($a[3] != ($fd[4]+1)); # Month
if($a[1] > 0) { # N'th day from the start
my $d = $fd[3] - ($a[1]-1)*7;
next if($d < 1 || $d > 7);
} elsif($a[1] < 0) { # N'th day from the end
my $d = $fd[3] - ($a[1]+1)*7;
my $md = $md[$fd[4]];
next if($d > $md || $d < $md-6);
}
$found = $a[4];
last;
} elsif($l =~ m/^4/) { # Interval: 4 MM-DD MM-DD Holiday
my @args = split(" +", $l, 4);
if($args[1] le $fordate && $args[2] ge $fordate) {
$found = $args[3];
last;
}
} elsif($l =~ m/^5/) { # nth weekday since MM-DD / before MM-DD
my @a = split(" +", $l, 6);
# arguments: 5 <distance> <weekday> <day> <month> <name>
my %wd = ("Sun"=>0, "Mon"=>1, "Tue"=>2, "Wed"=>3,
"Thu"=>4, "Fri"=>5, "Sat"=>6);
my $wd = $wd{$a[2]};
if(!defined($wd)) {
Log 1, "Wrong weekday spec: $l";
next;
}
next if $wd != $fd[6]; # check wether weekday matches today
my $yday=$fd[7];
# create time object of target date - mktime counts months and their
# days from 0 instead of 1, so subtract 1 from each
my $tgt=mktime(0,0,1,$a[3]-1,$a[4]-1,$fd[5],0,0,-1);
my $tgtmin=$tgt;
my $tgtmax=$tgt;
my $weeksecs=7*24*60*60; # 7 days, 24 hours, 60 minutes, 60seconds each
my $cd=mktime(0,0,1,$fd[3],$fd[4],$fd[5],0,0,-1);
if ( $a[1] =~ /^-([0-9])*$/ ) {
$tgtmin -= $1*$weeksecs; # Minimum: target date minus $1 weeks
$tgtmax = $tgtmin+$weeksecs; # Maximum: one week after minimum
# needs to be lower than max and greater than or equal to min
if ( ($cd ge $tgtmin) && ( $cd lt $tgtmax) ) {
$found=$a[5];
last;
}
} elsif ( $a[1] =~ /^\+?([0-9])*$/ ) {
$tgtmin += ($1-1)*$weeksecs; # Minimum: target date plus $1-1 weeks
$tgtmax = $tgtmin+$weeksecs; # Maximum: one week after minimum
# needs to be lower than or equal to max and greater min
if ( ($cd gt $tgtmin) && ( $cd le $tgtmax) ) {
$found=$a[5];
last;
}
} else {
Log 1, "Wrong distance spec: $l";
next;
}
}
}
close(FH);
RemoveInternalTimer($name);
$nt -= ($lt[2]*3600+$lt[1]*60+$lt[0]); # Midnight
$nt += 86400 + 2; # Tomorrow
$hash->{TRIGGERTIME} = $nt;
InternalTimer($nt, "holiday_refresh", $name, 0);
if($internal) {
$hash->{STATE} = $found;
return undef;
} else {
return $found;
}
}
sub
holiday_Get($@)
{
my ($hash, @a) = @_;
return "argument is missing" if(int(@a) != 2);
return "wrong argument: need MM-DD" if($a[1] !~ m/^[01]\d-[0-3]\d$/);
return holiday_refresh($hash->{NAME}, $a[1]);
}
sub
schaltjahr($)
{
my($jahr) = @_;
return 0 if $jahr % 4; # 2009
return 1 unless $jahr % 400; # 2000
return 0 unless $jahr % 100; # 2100
return 1; # 2012
}
1;

233
fhem/FHEM/98_PID.pm
View File

@ -1,233 +0,0 @@
##############################################
# This module is derived from the contrib/99_PID by Alexander Titzel.
package main;
use strict;
use warnings;
sub PID_sv($$$);
sub PID_setValue($);
##########################
sub
PID_Initialize($)
{
my ($hash) = @_;
$hash->{DefFn} = "PID_Define";
$hash->{SetFn} = "PID_Set";
$hash->{NotifyFn} = "PID_Notify";
$hash->{AttrList} = "disable:0,1 loglevel:0,1,2,3,4,5,6";
}
##########################
sub
PID_Define($$$)
{
my ($pid, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $n = $a[0];
if(@a < 4 || @a > 7) {
my $msg = "wrong syntax: define <name> PID " .
"<sensor>[:reading:regexp] <actor>[:cmd:min:max] [p i d]";
Log 2, $msg;
return $msg;
}
###################
# Sensor
my ($sensor, $reading, $regexp) = split(":", $a[2], 3);
if(!$defs{$sensor}) {
my $msg = "$n: Unknown sensor device $sensor specified";
Log 2, $msg;
return $msg;
}
$pid->{sensor} = $sensor;
if(!$regexp) {
my $t = $defs{$sensor}{TYPE};
if($t eq "HMS" || $t eq "CUL_WS") {
$reading = "temperature";
$regexp = '([\\d\\.]*)';
} else {
my $msg = "$n: Unknown sensor type $t, specify regexp";
Log 2, $msg;
return $msg;
}
}
$pid->{reading} = $reading;
$pid->{regexp} = $regexp;
###################
# Actor
my ($actor, $cmd, $min, $max) = split(":", $a[3], 4);
my ($p_p, $p_i, $p_d) = (0, 0, 0);
if(!$defs{$actor}) {
my $msg = "$n: Unknown actor device $actor specified";
Log 2, $msg;
return $msg;
}
$pid->{actor} = $actor;
if(!$max) {
my $t = $defs{$actor}{TYPE};
if($t eq "FHT8V") {
$cmd = "valve";
$min = 0;
$max = 100;
$p_p = 65.0/2.55;
$p_i = 7.8/2.55;
$p_d = 15.0/2.55;
} else {
my $msg = "$n: Unknown actor type $t, specify command:min:max";
Log 2, $msg;
return $msg;
}
}
$pid->{command} = $cmd;
$pid->{pFactor} = (@a > 4 ? $a[4] : $p_p);
$pid->{iFactor} = (@a > 5 ? $a[5] : $p_i);
$pid->{dFactor} = (@a > 6 ? $a[6] : $p_d);
$pid->{satMin} = $min;
$pid->{satMax} = $max;
PID_sv($pid, 'delta', 0.0);
PID_sv($pid, 'actuation', 0.0);
PID_sv($pid, 'integrator', 0.0);
$pid->{STATE} = 'initialized';
return undef;
}
##########################
sub
PID_Set($@)
{
my ($pid, @a) = @_;
my $n = $pid->{NAME};
return "Need a parameter for set" if(@a < 2);
my $arg = $a[1];
if($arg eq "factors" ) {
return "Set factors needs 3 parameters (p i d)" if(@a != 5);
$pid->{pFactor} = $a[2];
$pid->{iFactor} = $a[3];
$pid->{dFactor} = $a[4];
# modify DEF, alse save won't work.
my @d = split(' ', $pid->{DEF});
$pid->{DEF} = "$d[0] $d[1] $a[2] $a[3] $a[4]";
} elsif ($arg eq "desired" ) {
return "Set desired needs a numeric parameter"
if(@a != 3 || $a[2] !~ m/^[\d\.]*$/);
Log GetLogLevel($n,3), "PID set $n $arg $a[2]";
PID_sv($pid, 'desired', $a[2]);
PID_setValue($pid);
} else {
return "Unknown argument $a[1], choose one of factors desired"
}
return "";
}
##########################
sub
PID_Notify($$)
{
my ($pid, $dev) = @_;
my $pn = $pid->{NAME};
return "" if($attr{$pn} && $attr{$pn}{disable});
return if($dev->{NAME} ne $pid->{sensor});
my $reading = $pid->{reading};
my $max = int(@{$dev->{CHANGED}});
for (my $i = 0; $i < $max; $i++) {
my $s = $dev->{CHANGED}[$i];
$s = "" if(!defined($s));
next if($s !~ m/$reading/);
PID_setValue($pid);
last;
}
return "";
}
##########################
sub
PID_saturate($$)
{
my ($pid, $v) = @_;
return $pid->{satMax} if($v > $pid->{satMax});
return $pid->{satMin} if($v < $pid->{satMin});
return $v;
}
sub
PID_sv($$$)
{
my ($pid,$name,$val) = @_;
$pid->{READINGS}{$name}{VAL} = $val;
$pid->{READINGS}{$name}{TIME} = TimeNow();
}
sub
PID_gv($$)
{
my ($pid,$name) = @_;
return $pid->{READINGS}{$name}{VAL}
if($pid->{READINGS} && $pid->{READINGS}{$name});
return undef;
}
sub
PID_setValue($)
{
my ($pid) = @_;
my $n = $pid->{NAME};
my $sensor = $pid->{sensor};
my $reading = $pid->{reading};
my $re = $pid->{regexp};
# Get the value from the READING
my $inStr;
$inStr = $defs{$sensor}{READINGS}{$reading}{VAL}
if($defs{$sensor}{READINGS} && $defs{$sensor}{READINGS}{$reading});
if(!$inStr) {
Log GetLogLevel($n,4), "PID $n: no $reading yet for $sensor";
return;
}
$inStr =~ m/$re/;
my $in = $1;
my $desired = PID_gv($pid, 'desired');
return if(!defined($desired));
my $delta = $desired - $in;
my $p = $delta * $pid->{pFactor};
my $i = PID_saturate($pid, PID_gv($pid,'integrator')+$delta*$pid->{iFactor});
PID_sv($pid, 'integrator', $i);
my $d = ($delta - PID_gv($pid,'delta')) * $pid->{dFactor};
PID_sv($pid, 'delta', $delta);
my $a = PID_saturate($pid, $p + $i + $d);
PID_sv($pid, 'actuation', $a);
Log GetLogLevel($n,4), sprintf("PID $n: p:%.2f i:%.2f d:%.2f", $p, $i, $d);
# Hack to round.
$a = int($a) if(($pid->{satMax} - $pid->{satMin}) >= 100);
my $ret = fhem sprintf("set %s %s %g", $pid->{actor}, $pid->{command}, $a);
Log GetLogLevel($n,1), "output of $n command: $ret" if($ret);
$pid->{STATE} = "$in (delta $delta)";
}
1;

275
fhem/FHEM/98_autocreate.pm
View File

@ -1,275 +0,0 @@
##############################################
package main;
use strict;
use warnings;
# Problems:
# - Not all CUL_EM devices return a power
# - Not all CUL_WS devices return a temperature
# - No plot files for BS/CUL_FHTTK/USF1000/X10/WS300
# - check "UNDEFINED" parameters for BS/USF1000/X10
my %flogpar = (
"CUL_EM.*"
=> { GPLOT => "cul_em:Power,", FILTER => "%NAME" },
"CUL_WS.*"
=> { GPLOT => "hms:Temp/Hum,", FILTER => "%NAME" },
"CUL_FHTTK.*"
=> { GPLOT => "fht80tf:Window,", FILTER => "%NAME" },
"FHT.*"
=> { GPLOT => "fht:Temp/Act,", FILTER => "%NAME" },
"HMS100TFK_.*"
=> { GPLOT => "fht80tf:Contact,", FILTER => "%NAME" },
"HMS100T._.*"
=> { GPLOT => "hms:Temp/Hum,", FILTER => "%NAME:T:.*" },
"KS300.*"
=> { GPLOT => "ks300:Temp/Rain,ks300_2:Wind/Hum,",
FILTER => "%NAME:T:.*" },
# Oregon sensors:
# * temperature
"(THR128|THWR288A|THN132N).*"
=> { GPLOT => "oregon_hms_t:Temp,", FILTER => "%NAME" },
# * temperature, humidity
"(THGR228N|THGR810|THGR918|THGR328N|RTGR328N|WTGR800_T).*"
=> { GPLOT => "oregon_hms:Temp/Hum,", FILTER => "%NAME" },
# * temperature, humidity, pressure
"(BTHR918N|BTHR918|BTHR918N).*"
=> { GPLOT => "oregon_temp_press:Temp/Press,oregon_hms:Temp/Hum,",
FILTER => "%NAME" },
# * anenometer
"(WGR800|WGR918|WTGR800_A).*"
=> { GPLOT => "oregon_wind:WindDir/WindSpeed,", FILTER => "%NAME" },
# * Oregon sensors: Rain gauge
"(PCR800|RGR918).*"
=> { GPLOT => "oregon_rain:RainRate", FILTER => "%NAME" },
# X10 sensors received by RFXCOM
"RFXX10SEC.*"
=> { GPLOT => "fht80tf:Window,", FILTER => "%NAME" },
# USB-WDE1
"USBWX_[0-8]"
=> { GPLOT => "hms:Temp/Hum,", FILTER => "%NAME" },
"USBWX_ks300"
=> { GPLOT => "hms:Temp/Hum,ks300:Temp/Rain,ks300_2:Wind/Hum,",
FILTER => "%NAME:T:.*" },
# HomeMatic
"CUL_HM_THSensor.*"
=> { GPLOT => "hms:Temp/Hum,",
FILTER => "%NAME:T:.*" },
"CUL_HM_KS550.*"
=> { GPLOT => "ks300:Temp/Rain,ks300_2:Wind/Hum,",
FILTER => "%NAME:T:.*" },
"CUL_HM_HM-CC-TC.*"
=> { GPLOT => "hms:Temp/Hum,",
FILTER => "%NAME:T:.*" },
);
# Do not create FileLog for the following devices.
my @flog_blacklist = (
"CUL_RFR.*"
);
#####################################
sub
autocreate_Initialize($)
{
my ($hash) = @_;
$hash->{DefFn} = "autocreate_Define";
$hash->{NotifyFn} = "autocreate_Notify";
$hash->{AttrList}= "loglevel:0,1,2,3,4,5,6 " .
"autosave filelog device_room weblink weblink_room " .
"disable ignoreTypes";
my %ahash = ( Fn=>"CommandCreateLog",
Hlp=>"<device>,create log/weblink for <device>" );
$cmds{createlog} = \%ahash;
}
#####################################
sub
autocreate_Define($$)
{
my ($hash, $def) = @_;
my $name = $hash->{NAME};
$hash->{STATE} = "active";
$attr{global}{autoload_undefined_devices} = 1; # Make sure we work correctly
return undef;
}
sub
replace_wildcards($$)
{
my ($hash, $str) = @_;
return "" if(!$str);
my $t = $hash->{TYPE}; $str =~ s/%TYPE/$t/g;
my $n = $hash->{NAME}; $str =~ s/%NAME/$n/g;
return $str;
}
#####################################
sub
autocreate_Notify($$)
{
my ($ntfy, $dev) = @_;
my $me = $ntfy->{NAME};
my ($ll1, $ll2) = (GetLogLevel($me,1), GetLogLevel($me,2));
my $max = int(@{$dev->{CHANGED}});
my $ret = "";
my $nrcreated;
for (my $i = 0; $i < $max; $i++) {
my $s = $dev->{CHANGED}[$i];
$s = "" if(!defined($s));
################
if($s =~ m/^UNDEFINED ([^ ]*) ([^ ]*) (.*)$/) {
my ($name, $type, $arg) = ($1, $2, $3);
next if(AttrVal($me, "disable", undef));
my $it = AttrVal($me, "ignoreTypes", undef);
next if($it && $name =~ m/$it/i);
my ($cmd, $ret);
my $hash = $defs{$name}; # Called from createlog
####################
if(!$hash) {
$cmd = "$name $type $arg";
Log $ll2, "autocreate: define $cmd";
$ret = CommandDefine(undef, $cmd);
if($ret) {
Log $ll1, "ERROR: $ret";
last;
}
}
$hash = $defs{$name};
$nrcreated++;
my $room = replace_wildcards($hash, $attr{$me}{device_room});
$attr{$name}{room} = $room if($room);
# BlackList processing
my $blfound;
foreach my $bl (@flog_blacklist) {
$blfound = 1 if($name =~ m/^$bl$/);
}
last if($blfound);
####################
my $fl = replace_wildcards($hash, $attr{$me}{filelog});
next if(!$fl);
my $flname = "FileLog_$name";
delete($defs{$flname}); # If we are re-creating it with createlog.
my ($gplot, $filter) = ("", $name);
foreach my $k (keys %flogpar) {
next if($name !~ m/^$k$/);
$gplot = $flogpar{$k}{GPLOT};
$filter = replace_wildcards($hash, $flogpar{$k}{FILTER});
}
$cmd = "$flname FileLog $fl $filter";
Log $ll2, "autocreate: define $cmd";
$ret = CommandDefine(undef, $cmd);
if($ret) {
Log $ll1, "ERROR: $ret";
last;
}
$attr{$flname}{room} = $room if($room);
$attr{$flname}{logtype} = "${gplot}text";
####################
next if(!$attr{$me}{weblink} || !$gplot);
$room = replace_wildcards($hash, $attr{$me}{weblink_room});
my $wnr = 1;
foreach my $wdef (split(/,/, $gplot)) {
next if(!$wdef);
my ($gplotfile, $stuff) = split(/:/, $wdef);
next if(!$gplotfile);
my $wlname = "weblink_$name";
$wlname .= "_$wnr" if($wnr > 1);
$wnr++;
delete($defs{$wlname}); # If we are re-creating it with createlog.
$cmd = "$wlname weblink fileplot $flname:$gplotfile:CURRENT";
Log $ll2, "autocreate: define $cmd";
$ret = CommandDefine(undef, $cmd);
if($ret) {
Log $ll1, "ERROR: $ret";
last;
}
$attr{$wlname}{room} = $room if($room);
$attr{$wlname}{label} = '"' . $name .
' Min $data{min1}, Max $data{max1}, Last $data{currval1}"';
}
}
################
if($s =~ m/^RENAMED ([^ ]*) ([^ ]*)$/) {
my ($old, $new) = ($1, $2);
if($defs{"FileLog_$old"}) {
CommandRename(undef, "FileLog_$old FileLog_$new");
my $hash = $defs{"FileLog_$new"};
my $oldlogfile = $hash->{currentlogfile};
$hash->{REGEXP} =~ s/$old/$new/g;
$hash->{logfile} =~ s/$old/$new/g;
$hash->{currentlogfile} =~ s/$old/$new/g;
$hash->{DEF} =~ s/$old/$new/g;
rename($oldlogfile, $hash->{currentlogfile});
Log $ll2, "autocreate: renamed FileLog_$old to FileLog_$new";
$nrcreated++;
}
if($defs{"weblink_$old"}) {
CommandRename(undef, "weblink_$old weblink_$new");
my $hash = $defs{"weblink_$new"};
$hash->{LINK} =~ s/$old/$new/g;
$hash->{DEF} =~ s/$old/$new/g;
$attr{"weblink_$new"}{label} =~ s/$old/$new/g;
Log $ll2, "autocreate: renamed weblink_$old to weblink_$new";
$nrcreated++;
}
}
}
CommandSave(undef, undef) if(!$ret && $nrcreated && $attr{$me}{autosave});
return $ret;
}
# TODO: fix it if the device is renamed.
sub
CommandCreateLog($$)
{
my ($cl, $n) = @_;
my $ac;
foreach my $d (keys %defs) {
next if($defs{$d}{TYPE} ne "autocreate");
$ac = $d;
last;
}
return "Please define an autocreate device with attributes first " .
"(it may be disabled)" if(!$ac);
return "No device named $n found" if(!$defs{$n});
my $acd = $defs{$ac};
my $disabled = AttrVal($ac, "disable", undef);
delete $attr{$ac}{disable} if($disabled);
$acd->{CHANGED}[0] = "UNDEFINED $n $defs{$n}{TYPE} none";
autocreate_Notify($acd, $acd);
delete $acd->{CHANGED};
$attr{$ac}{disable} = 1 if($disabled);
}
1;

48
fhem/FHEM/98_dummy.pm
View File

@ -1,48 +0,0 @@
##############################################
package main;
use strict;
use warnings;
sub
dummy_Initialize($)
{
my ($hash) = @_;
$hash->{SetFn} = "dummy_Set";
$hash->{DefFn} = "dummy_Define";
$hash->{AttrList} = "loglevel:0,1,2,3,4,5,6";
}
###################################
sub
dummy_Set($@)
{
my ($hash, @a) = @_;
return "no set value specified" if(int(@a) != 2);
return "Unknown argument $a[1], choose one of *" if($a[1] eq "?");
my $v = $a[1];
Log GetLogLevel($a[0],2), "dummy set @a";
$hash->{CHANGED}[0] = $v;
$hash->{STATE} = $v;
$hash->{READINGS}{state}{TIME} = TimeNow();
$hash->{READINGS}{state}{VAL} = $v;
return undef;
}
sub
dummy_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
return "Wrong syntax: use define <name> dummy" if(int(@a) != 2);
return undef;
}
1;

200
fhem/FHEM/98_structure.pm
View File

@ -1,200 +0,0 @@
##############################################
package main;
use strict;
use warnings;
#####################################
sub
structure_Initialize($)
{
my ($hash) = @_;
$hash->{DefFn} = "structure_Define";
$hash->{UndefFn} = "structure_Undef";
$hash->{SetFn} = "structure_Set";
$hash->{AttrFn} = "structure_Attr";
addToAttrList("structexclude");
my %ahash = ( Fn=>"CommandAddStruct",
Hlp=>"<structure> <devspec>,add <devspec> to <structure>" );
$cmds{addstruct} = \%ahash;
my %dhash = ( Fn=>"CommandDelStruct",
Hlp=>"<structure> <devspec>,delete <devspec> from <structure>");
$cmds{delstruct} = \%dhash;
}
#############################
sub
structure_Define($$)
{
my ($hash, $def) = @_;
my @a = split("[ \t][ \t]*", $def);
my $u = "wrong syntax: define <name> structure <struct-type> [device ...]";
return $u if(int(@a) < 4);
my $devname = shift(@a);
my $modname = shift(@a);
my $stype = shift(@a);
addToAttrList($stype);
$hash->{ATTR} = $stype;
my %list;
foreach my $a (@a) {
foreach my $d (devspec2array($a)) {
$list{$d} = 1;
}
}
$hash->{CONTENT} = \%list;
$hash->{STATE} = join(" ", sort(keys %{$hash->{CONTENT}}));
@a = ( "set", $devname, $stype, $devname );
structure_Attr(@a);
return undef;
}
#############################
sub
structure_Undef($$)
{
my ($hash, $def) = @_;
my @a = ( "del", $hash->{NAME}, $hash->{ATTR} );
structure_Attr(@a);
return undef;
}
#####################################
sub
CommandAddStruct($)
{
my ($cl, $param) = @_;
my @a = split(" ", $param);
if(int(@a) != 2) {
return "Usage: addstruct <structure_device> <devspec>";
}
my $name = shift(@a);
my $hash = $defs{$name};
if(!$hash || $hash->{TYPE} ne "structure") {
return "$a is not a structure device";
}
foreach my $d (devspec2array($a[0])) {
$hash->{CONTENT}{$d} = 1;
}
$hash->{STATE} = join(" ", sort(keys %{$hash->{CONTENT}}));
@a = ( "set", $hash->{NAME}, $hash->{ATTR}, $hash->{NAME} );
structure_Attr(@a);
return undef;
}
#####################################
sub
CommandDelStruct($)
{
my ($cl, $param) = @_;
my @a = split(" ", $param);
if(int(@a) != 2) {
return "Usage: delstruct <structure_device> <devspec>";
}
my $name = shift(@a);
my $hash = $defs{$name};
if(!$hash || $hash->{TYPE} ne "structure") {
return "$a is not a structure device";
}
foreach my $d (devspec2array($a[0])) {
delete($hash->{CONTENT}{$d});
}
$hash->{STATE} = join(" ", sort(keys %{$hash->{CONTENT}}));
@a = ( "del", $hash->{NAME}, $hash->{ATTR} );
structure_Attr(@a);
return undef;
}
###################################
sub
structure_Set($@)
{
my ($hash, @list) = @_;
my $ret = "";
my %pars;
$hash->{INSET} = 1;
foreach my $d (sort keys %{ $hash->{CONTENT} }) {
next if(!$defs{$d});
if($defs{$d}{INSET}) {
Log 1, "ERROR: endless loop detected for $d in " . $hash->{NAME};
next;
}
if($attr{$d} && $attr{$d}{structexclude}) {
my $se = $attr{$d}{structexclude};
next if($hash->{NAME} =~ m/$se/);
}
$list[0] = $d;
my $sret .= CommandSet(undef, join(" ", @list));
if($sret) {
$ret .= "\n" if($ret);
$ret .= $sret;
if($list[1] eq "?") {
$sret =~ s/.*one of //;
map { $pars{$_} = 1 } split(" ", $sret);
}
}
}
delete($hash->{INSET});
Log 5, "SET: $ret" if($ret);
return $list[1] eq "?"
? "Unknown argument ?, choose one of " . join(" ", sort keys(%pars))
: undef;
}
###################################
sub
structure_Attr($@)
{
my ($type, @list) = @_;
my $hash = $defs{$list[0]};
$hash->{INATTR} = 1;
my $ret = "";
foreach my $d (sort keys %{ $hash->{CONTENT} }) {
next if(!$defs{$d});
if($defs{$d}{INATTR}) {
Log 1, "ERROR: endless loop detected for $d in " . $hash->{NAME};
next;
}
$list[0] = $d;
my $sret;
if($type eq "del") {
$sret .= CommandDeleteAttr(undef, join(" ", @list));
} else {
$sret .= CommandAttr(undef, join(" ", @list));
}
if($sret) {
$ret .= "\n" if($ret);
$ret .= $sret;
}
}
delete($hash->{INATTR});
Log 5, "ATTR: $ret" if($ret);
return undef;
}
1;

344
fhem/FHEM/99_SUNRISE_EL.pm
View File

@ -1,344 +0,0 @@
##############################################
# This code is derived from DateTime::Event::Sunrise, version 0.0501.
# Simplified and removed further package # dependency (DateTime,
# Params::Validate, etc). For comments see the original code.
#
package main;
use strict;
use warnings;
use Math::Trig;
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 = ""; # will be overwritten
my $altit = "-6"; # Civil twilight
my $RADEG = ( 180 / 3.1415926 );
my $DEGRAD = ( 3.1415926 / 180 );
my $INV360 = ( 1.0 / 360.0 );
sub
SUNRISE_EL_Initialize($)
{
my ($hash) = @_;
}
##########################
# Compute the _next_ event
# rise: 1: event is sunrise (else sunset)
# isrel: 1: relative times
# 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, $min, $max) = @_;
my $needrise = ($rise || $daycheck) ? 1 : 0;
my $needset = (!$rise || $daycheck) ? 1 : 0;
$seconds = 0 if(!$seconds);
my $nt = time;
my @lt = localtime($nt);
my $gmtoff = _calctz($nt,@lt); # in hour
my ($rt,$st) = _sr($needrise,$needset, $lt[5]+1900,$lt[4]+1,$lt[3], $gmtoff);
my $sst = ($rise ? $rt : $st) + ($seconds/3600);
my $nh = $lt[2] + $lt[1]/60 + $lt[0]/3600; # Current hour since midnight
if($daycheck) {
return 0 if($nh < $rt || $nh > $st);
return 1;
}
my $diff = 0;
if($data{AT_RECOMPUTE} || # compute it for tommorow
int(($nh-$sst)*3600) >= 0) { # if called a subsec earlier
$nt += 86400;
@lt = localtime($nt);
my $ngmtoff = _calctz($nt,@lt); # in hour
$diff = 24+$gmtoff-$ngmtoff;
($rt,$st) = _sr($needrise,$needset, $lt[5]+1900,$lt[4]+1,$lt[3], $ngmtoff);
$sst = ($rise ? $rt : $st) + ($seconds/3600);
}
$sst = hms2h($min) if(defined($min) && (hms2h($min) > $sst));
$sst = hms2h($max) if(defined($max) && (hms2h($max) < $sst));
$sst += $diff if($isrel);
$sst -= $nh if($isrel == 1);
return h2hms_fmt($sst);
}
sub
_sr($$$$$$)
{
my ($needrise, $needset, $y, $m, $dy, $offset) = @_;
my $d = _days_since_2000_Jan_0($y,$m,$dy) + 0.5 - $long / 360.0;
my ( $tmp_rise_1, $tmp_set_1 ) =
_sunrise_sunset( $d, $long, $lat, $altit, 15.04107 );
my ($tmp_rise_2, $tmp_rise_3) = (0,0);
if($needrise) {
$tmp_rise_2 = 9; $tmp_rise_3 = 0;
until ( _equal( $tmp_rise_2, $tmp_rise_3, 8 ) ) {
my $d_sunrise_1 = $d + $tmp_rise_1 / 24.0;
( $tmp_rise_2, undef ) =
_sunrise_sunset( $d_sunrise_1, $long, $lat, $altit, 15.04107 );
$tmp_rise_1 = $tmp_rise_3;
my $d_sunrise_2 = $d + $tmp_rise_2 / 24.0;
( $tmp_rise_3, undef ) =
_sunrise_sunset( $d_sunrise_2, $long, $lat, $altit, 15.04107 );
}
}
my ($tmp_set_2, $tmp_set_3) = (0,0);
if($needset) {
$tmp_set_2 = 9; $tmp_set_3 = 0;
until ( _equal( $tmp_set_2, $tmp_set_3, 8 ) ) {
my $d_sunset_1 = $d + $tmp_set_1 / 24.0;
( undef, $tmp_set_2 ) =
_sunrise_sunset( $d_sunset_1, $long, $lat, $altit, 15.04107 );
$tmp_set_1 = $tmp_set_3;
my $d_sunset_2 = $d + $tmp_set_2 / 24.0;
( undef, $tmp_set_3 ) =
_sunrise_sunset( $d_sunset_2, $long, $lat, $altit, 15.04107 );
}
}
return $tmp_rise_3+$offset, $tmp_set_3+$offset;
}
sub
_sunrise_sunset($$$$$)
{
my ( $d, $lon, $lat, $altit, $h ) = @_;
my $sidtime = _revolution( _GMST0($d) + 180.0 + $lon );
# Compute Sun's RA + Decl + distance at this moment
my ( $sRA, $sdec, $sr ) = _sun_RA_dec($d);
# Compute time when Sun is at south - in hours UT
my $tsouth = 12.0 - _rev180( $sidtime - $sRA ) / $h;
# Compute the Sun's apparent radius, degrees
my $sradius = 0.2666 / $sr;
# Do correction to upper limb, if necessary
$altit -= $sradius;
# Compute the diurnal arc that the Sun traverses to reach
# the specified altitude altit:
my $cost =
( sind($altit) - sind($lat) * sind($sdec) ) /
( cosd($lat) * cosd($sdec) );
my $t;
if ( $cost >= 1.0 ) {
$t = 0.0; # Sun always below altit
}
elsif ( $cost <= -1.0 ) {
$t = 12.0; # Sun always above altit
}
else {
$t = acosd($cost) / 15.0; # The diurnal arc, hours
}
# Store rise and set times - in hours UT
my $hour_rise_ut = $tsouth - $t;
my $hour_set_ut = $tsouth + $t;
return ( $hour_rise_ut, $hour_set_ut );
}
sub
_GMST0($)
{
my ($d) = @_;
my $sidtim0 =
_revolution( ( 180.0 + 356.0470 + 282.9404 ) +
( 0.9856002585 + 4.70935E-5 ) * $d );
return $sidtim0;
}
sub
_sunpos($)
{
my ($d) = @_;
my $Mean_anomaly_of_sun = _revolution( 356.0470 + 0.9856002585 * $d );
my $Mean_longitude_of_perihelion = 282.9404 + 4.70935E-5 * $d;
my $Eccentricity_of_Earth_orbit = 0.016709 - 1.151E-9 * $d;
# Compute true longitude and radius vector
my $Eccentric_anomaly =
$Mean_anomaly_of_sun + $Eccentricity_of_Earth_orbit * $RADEG *
sind($Mean_anomaly_of_sun) *
( 1.0 + $Eccentricity_of_Earth_orbit * cosd($Mean_anomaly_of_sun) );
my $x = cosd($Eccentric_anomaly) - $Eccentricity_of_Earth_orbit;
my $y =
sqrt( 1.0 - $Eccentricity_of_Earth_orbit * $Eccentricity_of_Earth_orbit )
* sind($Eccentric_anomaly);
my $Solar_distance = sqrt( $x * $x + $y * $y ); # Solar distance
my $True_anomaly = atan2d( $y, $x ); # True anomaly
my $True_solar_longitude =
$True_anomaly + $Mean_longitude_of_perihelion; # True solar longitude
if ( $True_solar_longitude >= 360.0 ) {
$True_solar_longitude -= 360.0; # Make it 0..360 degrees
}
return ( $Solar_distance, $True_solar_longitude );
}
# Sun's Right Ascension (RA), Declination (dec) and distance (r)
sub
_sun_RA_dec($)
{
my ($d) = @_;
my ( $r, $lon ) = _sunpos($d);
my $x = $r * cosd($lon);
my $y = $r * sind($lon);
my $obl_ecl = 23.4393 - 3.563E-7 * $d;
my $z = $y * sind($obl_ecl);
$y = $y * cosd($obl_ecl);
my $RA = atan2d( $y, $x );
my $dec = atan2d( $z, sqrt( $x * $x + $y * $y ) );
return ( $RA, $dec, $r );
}
sub
_days_since_2000_Jan_0($$$)
{
my ($y, $m, $d) = @_;
my @mn = (31,28,31,30,31,30,31,31,30,31,30,31);
my $ms = 0;
for(my $i = 0; $i < $m-1; $i++) {
$ms += $mn[$i];
}
my $x = ($y-2000)*365.25 + $ms + $d;
$x++ if($m > 2 && ($y%4) == 0);
return int($x);
}
sub sind($) { sin( ( $_[0] ) * $DEGRAD ); }
sub cosd($) { cos( ( $_[0] ) * $DEGRAD ); }
sub tand($) { tan( ( $_[0] ) * $DEGRAD ); }
sub atand($) { ( $RADEG * atan( $_[0] ) ); }
sub asind($) { ( $RADEG * asin( $_[0] ) ); }
sub acosd($) { ( $RADEG * acos( $_[0] ) ); }
sub atan2d($$) { ( $RADEG * atan2( $_[0], $_[1] ) ); }
sub
_revolution($)
{
my $x = $_[0];
return ( $x - 360.0 * int( $x * $INV360 ) );
}
sub
_rev180($)
{
my ($x) = @_;
return ( $x - 360.0 * int( $x * $INV360 + 0.5 ) );
}
sub
_equal($$$)
{
my ( $A, $B, $dp ) = @_;
return sprintf( "%.${dp}g", $A ) eq sprintf( "%.${dp}g", $B );
}
sub
_calctz($@)
{
my ($nt,@lt) = @_;
my $off = $lt[2]*3600+$lt[1]*60+$lt[0];
$off = 12*3600-$off;
$nt += $off; # This is noon, localtime
my @gt = gmtime($nt);
return (12-$gt[2]);
}
sub
hms2h($)
{
my $in = shift;
my @a = split(":", $in);
return 0 if(int(@a) < 2 || $in !~ m/^[\d:]*$/);
return $a[0]+$a[1]/60 + ($a[2] ? $a[2]/3600 : 0);
}
sub
h2hms($)
{
my ($in) = @_;
my ($h,$m,$s);
$h = int($in);
$m = int(60*($in-$h));
$s = int(3600*($in-$h)-60*$m);
return ($h, $m, $s);
}
sub
h2hms_fmt($)
{
my ($in) = @_;
my ($h,$m,$s) = h2hms($in);
return sprintf("%02d:%02d:%02d", $h, $m, $s);
}
sub sunrise_rel(@) { return sr(1, shift, 1, 0, shift, shift) }
sub sunset_rel(@) { return sr(0, shift, 1, 0, shift, shift) }
sub sunrise_abs(@) { return sr(1, shift, 0, 0, shift, shift) }
sub sunset_abs(@) { return sr(0, shift, 0, 0, shift, shift) }
sub sunrise(@) { return sr(1, shift, 2, 0, shift, shift) }
sub sunset(@) { return sr(0, shift, 2, 0, shift, shift) }
sub isday() { return sr(1, 0, 0, 1, undef, undef) }
sub sunrise_coord($$$) { ($long, $lat, $tz) = @_; return undef; }
1;

52
fhem/FHEM/99_Utils.pm
View File

@ -1,52 +0,0 @@
package main;
use strict;
use warnings;
use POSIX;
sub
Utils_Initialize($$)
{
my ($hash) = @_;
}
sub
time_str2num($)
{
my ($str) = @_;
my @a = split("[- :]", $str);
return mktime($a[5],$a[4],$a[3],$a[2],$a[1]-1,$a[0]-1900,0,0,-1);
}
sub
min($$)
{
my ($a,$b) = @_;
return $a if($a lt $b);
return $b;
}
sub
max($$)
{
my ($a,$b) = @_;
return $a if($a gt $b);
return $b;
}
sub
abstime2rel($)
{
my ($h,$m,$s) = split(":", shift);
$m = 0 if(!$m);
$s = 0 if(!$s);
my $t1 = 3600*$h+60*$m+$s;
my @now = localtime;
my $t2 = 3600*$now[2]+60*$now[1]+$now[0];
my $diff = $t1-$t2;
$diff += 86400 if($diff <= 0);
return sprintf("%02d:%02d:%02d", $diff/3600, ($diff/60)%60, $diff%60);
}
1;

94
fhem/FHEM/99_XmlList.pm
View File

@ -1,94 +0,0 @@
package main;
use strict;
use warnings;
use POSIX;
sub CommandXmlList($$);
sub XmlEscape($);
#####################################
sub
XmlList_Initialize($$)
{
my %lhash = ( Fn=>"CommandXmlList",
Hlp=>",list definitions and status info as xml" );
$cmds{xmllist} = \%lhash;
}
#####################################
sub
XmlEscape($)
{
my $a = shift;
return "" if(!defined($a));
$a =~ s/\\\n/<br>/g; # Multi-line
$a =~ s/&/&amp;/g;
$a =~ s/"/&quot;/g;
$a =~ s/</&lt;/g;
$a =~ s/>/&gt;/g;
$a =~ s/([^ -~])/sprintf("#%02x;", ord($1))/ge;
return $a;
}
#####################################
sub
CommandXmlList($$)
{
my ($cl, $param) = @_;
my $str = "<FHZINFO>\n";
my $lt = "";
delete($modules{""}) if(defined($modules{""}));
for my $d (sort { my $x = $modules{$defs{$a}{TYPE}}{ORDER}.$defs{$a}{TYPE} cmp
$modules{$defs{$b}{TYPE}}{ORDER}.$defs{$b}{TYPE};
$x = ($a cmp $b) if($x == 0); $x; } keys %defs) {
next if(IsIgnored($d));
my $p = $defs{$d};
my $t = $p->{TYPE};
if($t ne $lt) {
$str .= "\t</${lt}_LIST>\n" if($lt);
$str .= "\t<${t}_LIST>\n";
}
$lt = $t;
my $a1 = XmlEscape($p->{STATE});
my $a2 = XmlEscape(getAllSets($d));
my $a3 = XmlEscape(getAllAttr($d));
$str .= "\t\t<$t name=\"$d\" state=\"$a1\" sets=\"$a2\" attrs=\"$a3\">\n";
foreach my $c (sort keys %{$p}) {
next if(ref($p->{$c}));
$str .= sprintf("\t\t\t<INT key=\"%s\" value=\"%s\"/>\n",
XmlEscape($c), XmlEscape($p->{$c}));
}
$str .= sprintf("\t\t\t<INT key=\"IODev\" value=\"%s\"/>\n",
$p->{IODev}{NAME}) if($p->{IODev});
foreach my $c (sort keys %{$attr{$d}}) {
$str .= sprintf("\t\t\t<ATTR key=\"%s\" value=\"%s\"/>\n",
XmlEscape($c), XmlEscape($attr{$d}{$c}));
}
my $r = $p->{READINGS};
if($r) {
foreach my $c (sort keys %{$r}) {
my $h = $r->{$c};
next if(!defined($h->{VAL}) || !defined($h->{TIME}));
$str .=
sprintf("\t\t\t<STATE key=\"%s\" value=\"%s\" measured=\"%s\"/>\n",
XmlEscape($c), XmlEscape($h->{VAL}), $h->{TIME});
}
}
$str .= "\t\t</$t>\n";
}
$str .= "\t</${lt}_LIST>\n" if($lt);
$str .= "</FHZINFO>\n";
return $str;
}
1;

194
fhem/FHEM/99_updatefhem.pm
View File

@ -1,194 +0,0 @@
package main;
use strict;
use warnings;
use IO::Socket;
sub CommandUpdatefhem($$);
sub CommandCULflash($$);
my $server = "fhem.de:80";
my $sdir = "/fhemupdate";
my $ftime = "filetimes.txt";
my $dfu = "dfu-programmer";
#####################################
sub
updatefhem_Initialize($$)
{
my %fhash = ( Fn=>"CommandUpdatefhem",
Hlp=>",update fhem from the nightly CVS" );
$cmds{updatefhem} = \%fhash;
my %chash = ( Fn=>"CommandCULflash",
Hlp=>"<cul> <type>,flash the CUL from the nightly CVS" );
$cmds{CULflash} = \%chash;
}
#####################################
sub
CommandUpdatefhem($$)
{
my ($cl, $param) = @_;
my $lt = "";
my $ret = "";
my $moddir = "$attr{global}{modpath}/FHEM";
#my $moddir = "XXX";
# Read in the OLD filetimes.txt
my %oldtime;
if(open FH, "$moddir/$ftime") {
while(my $l = <FH>) {
chomp($l);
my ($ts, $fs, $file) = split(" ", $l, 3);
$oldtime{$file} = $ts;
}
close(FH);
}
my $filetimes = GetHttpFile($server, "$sdir/$ftime");
return "Can't get $ftime from $server" if(!$filetimes);
my (%filetime, %filesize);
foreach my $l (split("[\r\n]", $filetimes)) {
chomp($l);
return "Corrupted filetimes.txt file"
if($l !~ m/^20\d\d-\d\d-\d\d_\d\d:\d\d:\d\d /);
my ($ts, $fs, $file) = split(" ", $l, 3);
$filetime{$file} = $ts;
$filesize{$file} = $fs;
}
my @reload;
my $newfhem = 0;
foreach my $f (sort keys %filetime) {
if($param) {
next if($f ne $param);
} else {
next if($oldtime{$f} && $filetime{$f} eq $oldtime{$f});
next if($f =~ m/.hex$/); # skip firmware files
}
my $localfile = "$moddir/$f";
my $remfile = $f;
if($f eq "fhem.pl") {
$ret .= "updated fhem.pl, restart of fhem is required\n";
$newfhem = 1;
$localfile = $0;
$remfile = "$f.txt";
}
if($f =~ m/^(\d\d_)(.*).pm$/) {
my $m = $2;
push @reload, $f if($modules{$m} && $modules{$m}{LOADED});
}
my $content = GetHttpFile($server, "$sdir/$remfile");
return "File size for $f does not correspond to filetimes.txt entry"
if(length($content) ne $filesize{$f});
open(FH,">$localfile") || return "Can't write $localfile";
print FH $content;
close(FH)
}
return "Can't write $moddir/$ftime" if(!open(FH, ">$moddir/$ftime"));
print FH $filetimes;
close(FH);
if(!$newfhem) {
foreach my $m (@reload) {
$ret .= "reloading module $m\n";
my $cret = CommandReload($cl, $m);
return "$ret$cret" if($cret);
}
}
return $ret;
}
sub
CommandCULflash($$)
{
my ($cl, $param) = @_;
my $moddir = "$attr{global}{modpath}/FHEM";
#my $moddir = "XXX";
my %ctypes = (
CUL_V2 => "at90usb162",
CUL_V2_HM => "at90usb162",
CUL_V3 => "atmega32u4",
CUL_V4 => "atmega32u2",
);
my @a = split("[ \t]+", $param);
return "Usage: CULflash <Fhem-CUL-Device> <CUL-type>, ".
"where <CUL-type> is one of ". join(" ", sort keys %ctypes)
if(int(@a) != 2 ||
!$defs{$a[0]} ||
$defs{$a[0]}{TYPE} ne "CUL" ||
!$ctypes{$a[1]});
my $cul = $a[0];
my $target = $a[1];
################################
# First get the index file to prove the file size
my $filetimes = GetHttpFile($server, "$sdir/$ftime");
return "Can't get $ftime from $server" if(!$filetimes);
my (%filetime, %filesize);
foreach my $l (split("[\r\n]", $filetimes)) {
chomp($l);
return "Corrupted filetimes.txt file"
if($l !~ m/^20\d\d-\d\d-\d\d_\d\d:\d\d:\d\d /);
my ($ts, $fs, $file) = split(" ", $l, 3);
$filetime{$file} = $ts;
$filesize{$file} = $fs;
}
################################
# Now get the firmware file:
my $content = GetHttpFile($server, "$sdir/$target.hex");
return "File size for $target.hex does not correspond to filetimes.txt entry"
if(length($content) ne $filesize{"$target.hex"});
my $localfile = "$moddir/$target.hex";
open(FH,">$localfile") || return "Can't write $localfile";
print FH $content;
close(FH);
my $cmd = "($dfu MCU erase && $dfu MCU flash TARGET && $dfu MCU start) 2>&1";
my $mcu = $ctypes{$target};
$cmd =~ s/MCU/$mcu/g;
$cmd =~ s/TARGET/$localfile/g;
CUL_SimpleWrite($defs{CUL}, "B01");
sleep(4); # B01 needs 2 seconds for the reset
Log 1, $cmd;
my $result = `$cmd`;
Log 1, $result;
return $result;
}
sub
GetHttpFile($$)
{
my ($host, $filename) = @_;
my $server = IO::Socket::INET->new(PeerAddr => $server);
if(!$server) {
Log 1, "Can't connect to $server\n";
return undef;
}
$host =~ s/:.*//;
my $req = "GET $filename HTTP/1.0\r\nHost: $host\r\n\r\n\r\n";
syswrite $server, $req;
my ($buf, $ret);
while(sysread($server, $buf, 65536) > 0) {
$ret .= $buf;
}
$ret=~ s/.*?\r\n\r\n//s;
Log 1, "Got http://$host$filename, length: ".length($ret);
return $ret;
}
1;

480
fhem/HISTORY
View File

@ -1,480 +0,0 @@
- Rudi, Thu Feb 1 13:27:15 MET 2007
Created the file HISTORY and the file README.DEV
- Pest, Thu Feb 1 20:45 MET 2007
Added description for attribute ,
- Rudi, Sun Feb 11 18:56:05 MET 2007
- showtime added for pgm2 (useful for FS20 piri display)
- defattr command added, it makes easier to assign room, type, etc for a group
of devices.
- em1010.pl added to the contrib directory. It seems that we are able
to read out the EM1010PC. Not verified with multiple devices.
- Pest, Thu Feb 11 23:35 MET 2007
- Added doc/linux.html (multiple USDB devices, udev links)
- Linked fhem.html and commandref.html to linux.html
- Martin Haas, Fri Feb 23 10:18 MET 2007
- ARM-Section (NSLU2) added to doc/linux.html
- Pest, Sat Feb 24 18:30 MET 2007
- doc/linux.html: Module build re-written.
- Rudi, Sun Mar 4 11:18:10 MET 2007
Reorganization. Goal: making attribute adding/deleting more uniform
(,
possible (i.e. saving the configfile, list of possible devices etc).
Internal changes:
- %logmods,%devmods moved to %modules. Makes things more uniform
- %logs merged into %defs
- local state info (%readings) changed to global ($defs{$d}{READINGS})
-> No need for the listfn function in each module
-> User written scripts can more easily analyze device states
User visible changes:
- at/notify ,
modules. Now it is possible
- to have a further ,
(notify & filelog use the same interface)
- to have more than one notify for the same event
- to delete at commands without strange escapes.
The delete syntax changed (no more def/at/ntfy needed)
- at/notify can have attributes
Drawback: each at and notify must have a name, which is strange first.
- logfile/modpath/pidfile/port/verbose ,
Dumping and extending these attributes is easier, no special handling
required in the web-frontend.
- savefile renamed to ,
- configfile global attribute added.
- save command added, it writes the statefile and then the configfile.
- delattr added to delete single attributes
- list/xmllist format changed, they contain more information.
- ,
in the same format. This data is contained in the xmllist.
- disable attribute for at/notify/filelog
- rename added
- Rudi, Tue Mar 27 20:43:15 MEST 2007
fhemweb.pl (webpgm2) changes:
- adopted to the new syntax
- better commandline support (return <pre> formatted)
- FileLog attribute logtype added, and 4 logtypes (== gnuplot files)
defined: fs20, fht, ks300_1, ks300_2
- links in the commandref.html file added
- device dependent attribute and set support
- Pest, Sun Apr 08 17:55:15 MEST 2007
em1010.pl:
- Make difference between sensors 1..4 and 5..
- Checked values for sensor 5 (cur.energy + cur.power) - ok
- Checked values for sensor 5 cur.energy is ok, cur.power still off.
Correction factor needs to be determined.
- setTime: Without argument, now the current time of the PC is used.
- setRperKW: Factor of 10 required, 75 U/kWh -> 750.
- Pest, Tue Apr 10 20:31:22 MEST 2007
em1010.pl:
- Introduced new double-word function (dw)
- getDevStatus: energy values kWh/h, kWh/d, total.
- Rudi Sat Apr 14 10:34:36 MEST 2007
final documentations, release 4.0. Tagged as FHEM_4_0
- Pest, Sat Apr 14 14:21:00 MEST 2007
- doc: linux.html (private udev-rules, not 50-..., ATTRS)
- Pest, Sun Apr 15 14:54:30 MEST 2007
- doc: fhem.pl and commandref.html (notifyon -> notify, correction of examples)
- Rudi, Tue Apr 24 08:10:43 MEST 2007
- feature: modify command added. It helps change e.g. only the time component
for an at command, without deleting and creating it again and then
reapplying all the attributes.
- feature: the ,
instead. The - is used to separate ranges in the set command.
- Rudi, Sun May 27 12:51:52 MEST 2007
- Archiving FileLogs. Added fhemweb.pl (pgm2) code, to show logs from the
archive directory. See the attributes archivedir/archivecmd.
- Added EM1010PC suppoort (right now only with EM1000WZ). Support added
for displaying logs in the fhemweb.pl (webfrontends/pgm2)
- Pest, Mon May 28 19:39:22 MEST 2007
- Added 62_EMEM.pm to support EM1000-EM devices.
- doc: Update of commandref.htm (typos and EMEM).
- Pest, Mon May 29 00:07:00 MEST 2007
- check-in changes of 60_EM.pm to make EMEM work.
- Mon Jun 4 08:23:43 MEST 2007
- Small changes for EM logging
- Pest Jun 10, 23:16:23 MEST 2007
- Set wrong values in 62_EMEM to -1
- Pest Jun 12, 21:33:00 MEST 2007
- in 62_EMEM.pm: added energy_today and energy_total
- Pest Jun 18, 20:06:23 MEST 2007
- in 62_EMEM.pm: Power units removed from value content added to name.
- Rudi Sun Aug 5 10:59:51 MEST 2007
- WS300 Loglevel changed for KS300 device (from 2 to GetLogLevel or 5)
- First version of the FritzBox port:
- Perl binary/ftdi_sio module
- EM: added setTime, reset
- docs/fritzbox.html. Note: The fb_fhem_0.1.tar.gz won't be part of CVS
as it contains largee binaries (swapfile, perl mipsel executable, etc).
- Rudi Mon Aug 6 20:15:00 MEST 2007
- archiving added to the main logs.
NOTE: The FileLog filename (INT attribute) is now also called logfile.
- Rudi Wed Aug 29 08:28:34 MEST 2007
- archive attributes clarified in the doc
- Rudi Mon Sep 3 15:47:59 MEST 2007
- 99_Sunrise_EL.pm checked in. Replaces 99_Sunrise.pm, and does not need
any Date module.
- Rudi Sun Sep 9 08:43:03 MEST 2007
- mode holiday_short added + documentation. Not tested.
any Date module.
- Rudi Wed Oct 3 18:21:36 MEST 2007
- weblinks added. Used by webpgm2 to display more than one plot at once
- webpgm2 output reformatted. Using CSS to divide the screen area in 3
parts: command line, room-list and rest
- Dirk Wed Oct 7 12:45:09 MEST 2007
- FHT lime-protection code discovered
- Dirk Wed Oct 18 23:28:00 MEST 2007
- Softwarebuffer for FHT devices with queuing unsent commands and
repeating commands by transmission failure
- FHT low temperatur warning and setting for lowtemp-offset
- Change naming for state into warnings
Tagged as dirkh_20071019_0
- Martin Fri Dec 21 13:39:17 CET 2007
- voip2fhem added (contrib/)
- Peter Sun Dec 23 19:59:00 MEST 2007
- linux.html: Introduction refinement.
- Rudi Sat Dec 29 16:27:14 MET 2007
- delattr renamed to deleteattr, as del should complete to delete and not to
delattr
- defattr renamed to setdefaultattr (same as before for def)
- devicespec introduced:
it may contain a list of devices, a range of devices, or multiple devices
identified by regexp. Following commands take a devicespec as argument:
attr, deleteattr, delete, get, list, set, setstate, trigger
- Boris Sat Dec 29 16:56:00 CET 2007
- %NAME, %EVENT, %TYPE parameters in notify definition, commandref.html update
- Boris Sun Dec 30 22:35:00 CET 2007
- added dblog/93_DbLog.pm and samples in contrib directory, commandref.html
update
- Rudi Mon Dec 31 15:37:19 MET 2007
- feature: webfrontend/pgm2 converted to a FHEM module
No more need for a webserver for basic WEB administration. For HTTPS or
password you still need apache or the like.
One step closer for complete fhem on the FritzBox.
- Boris Sun Jan 06 13:35:00 CET 2008
- bugfix: 62_EMEM.pm: changed reading energy_total_kWh to energy_kWh_w,
added energy_kWh (formerly energy_total_kWh)
- changed em1010.pl accordingly, added em1000em doc for getDevStatus reply
from device
- minor changes in fhem.html
- Rudi Tue Jan 8 21:13:08 MET 2008
- feature: attr global allowfrom <ip-adresses/hostnames>
If set, only connects from these addresses are allowed. This is to
"simulate" a little bit of security.
- Rudi Sat Jan 19 18:04:12 MET 2008
- FHT: multiple commands
Up to 8 commands in one set, these are transmitted at once to the FHT
- softbuffer changes
minfhtbuffer attribute, as otherwise nearly everything will be sent to
the FHT buffer, so ordering won't take effect.
- cmd rename
report1,report2. refreshvalues changed to report1 and report2. refreshvalues
won't be advertized but still replaced with "report1 255 report2 255"
- extensive documentation update for the FHT
- lime-protection changed, as it is an actuator subcommand. Further actuator
commands added.
- Rudi Sun Jan 27 18:12:42 MET 2008
- em1010PC: sending a "67" after a reset skips the manual interaction:
automatic reset is now possible.
- Peter S. Sat Feb 16 22:22:21 MET 2008
- linux.html: Note on kernel 2.6.24.2 (includes our changes)
- Peter S. Wed Mar 19 08:24:00 MET 2008
- 00_FHZ.pm: DoTriger -> DoTrigger
- Rudi Fri May 9 20:00:00 MEST 2008
- feature: FHEM modules may live on a filesystem with "ignorant" casing (FAT)
If you install FHEM on a USB-Stick (e.g. for the FritzBox) it may happen
that the filename casing is different from the function names inside the
file.
-> Fhem won't find the <module>_Initialize function. Fixed by searching all
function-names for a match with "ignore-case"
- feature: FileLog function "set reopen" impemented. In case you want to
delete some wrong entries from a current logfile, you must tell fhem to
reopen the file again
- feature: multiline commands are supported through the command line
Up till now multiline commands were supported only by "include". Now they
are supprted from the (tcp/ip) connection too, so they can be used by the
web frontends.
- feature: pgm2 installation changes, multiple instances, external css
pgm2 (FHEMWEB) is now a "real" fhem module:
- the configuration takes place via attributes
- the css file is external, and each FHEMWEB instance can use its own set
- the default location for pictures, gnuplot scripts and css is the FHEM
module directory
- multiline support for notify and at scripts.
- feature: FileLog "set reopen" for manual tweaking of logfiles.
- feature: multiline commands are supported through the command line
- feature: pgm2 installation changes, multiple instances, external css
-tdressler Sa May 10 23:00:00 MEST 2008
- feature:add WS2000 Support new modul 87_ws2000.pm and standalone
reader/server ws2000_reader.pl
- doc: modified fhem.html/commandref.html reflectiing ws2000 device and
added windows support (tagged:before tdressler_20080510_1, after
tdressler_20080510_2)
-tdressler So May 11 19:30:00 MEST 2008
- feature: add ReadyFn to fhem.pl in main loop to have an alternative for
select, which is not working on windows (thomas 11.05)
- feature: set timeout to 0.2s, if HandleTimeout returns undef=forever
(tagged tdressler_20080511_1/2)
- bugfix : WS2000:fixed serial port access on windows by replacing FD with
ReadyFn
- bugfix : FileLog: dont use FH->sync on windows (not implemented there)
- feature: EM, WS300, FHZ:Add Switch for Device::SerialPort and
Win32::SerialPort to get it running in Windows (sorry, untestet)
-tdressler So May 11 23:30:00 MEST 2008
- bugfix: FileLog undefined $data in FileLog_Get
- feature: fhem.pl check modules for compiletime errors and do not initialize
them if any
- bugfix: EM, WS300, FHZ scope of portobj variable
-tdressler Mo May 12 14:00:00 MEST 2008
- bugfix: FHZ with windows, use there ReadyFn if windows; small cosmetic
changes
- doc: add hint to virtual com port driver, modification for FHZ to use
default FTDI driver
-tdressler Mo May 12 19:00:00 MEST 2008
- feature : add windows support to M232
-tdressler So May 18 13:30:00 MEST 2008
- feature : add ELV IPWE1 support
- Peter S. Mon Jun 02 00:39 MET 2008
- linux.html: openSUSE 11 contains our changes.
- Thu Jun 12 07:15:03 MEST 2008
- feature: FileLog get to read logfiles / webpgm2: gnuplot-scroll mode to
navigate/zoom in logfiles
webpgm2 uses the FileLog get to grep data for a given data range from a
logfile. Using this grep scrolling to a different date range / zooming
to another resolution (day/week/month/year) can be implemented.
The logfiles should be large, as scrolling across logfiles is not
implemented. To speed up the grep, a binary search with seek is used, and
seek positions are cached.
- Thu Jul 11 07:15:03 MEST 2008
- feature: 99_SVG.pm for webpgm2: generates SVG from the logfile.
Generating SVG is configurable, the "old" gnuplot mode is still there.
Downside of the SVG: the browser must support SVG (Firefox/Opera does,
I.E. with the Adobe plugin), and the browsesr consumes more memory.
Upside: no gnuplot needed on the server, faster(?), less data to transfer
for daily data.
Tested with Firefox 3.0.
Todo: Test with IE+Adobe Plugin/Opera.
- feature: HOWTO for webpgm2 (first chapter)
- Fri Jul 25 18:14:26 MEST 2008
- Autoloading modules. In order to make module installation easier and
to optimize memory usage, modules are loaded when the first device of a
certain category is defined. Exceptions are the modules prefixed with 99,
these are considered "utility" modules and are loaded at the beginning.
Some of the older 99_x modules were renamed (99_SVG, 99_dummy), and most
contrib modules were moved to the main FHEM directory.
- Boris Sat Nov 01 CET 2008
- feature: new commands fullinit and reopen for FHZ, commandref.html update
- bugfix: avoid access to undefined NotifyFn in hash in fhem.pl
- Boris Sun Nov 02 CET 2008
- feature: new modules 00_CM11.pm and 20_X10.pm for integration of X10
devices in fhem
- feature: X10 support for pgm3
- Sat Nov 15 10:23:56 MET 2008 (Rudi)
- Watchdog crash fixed: watchdog could insert itself more than once in the
internal timer queue. The first one deletes all occurances from the list,
but the loop over the list works on the cached keys -> the function/arg for
the second key is already removed.
- feature: X10 support for pgm3
- Boris Sat Nov 15 CET 2008
- bugfix: correct correction factors for EMEM in 15_CUL_EM.pm
- Wed Dec 3 18:36:56 MET 2008 (Rudi)
- reorder commandref.html, so that all aspects of a device
(define/set/get/attributes) are in one block. This makes possible to
"outsource" device documentation
- added "mobile" flag to the CUL definition, intended for a CUR, which is
a remote with a battery, so it is not connected all the time to fhem.
Without the flag fhem will block when the CUR is disconnected.
Note: we have to sleep after disconnect for 5 seconds, else the Linux
kernel sends us a SIGSEGV, and the USB device is gone till the next reboot.
- the fhem CUL part documented
- Sun Dec 7 21:09 (Boris)
- reworked 15_CUL_EM.pm to account for timer wraparounds, more readings added
- speed gain through disabled refreshvalues query to all FHTs at definition;
if you want it back at a "set myFHT report1 255 report2 255" command to the
config file.
- Mon Dec 8 21:26 MET 2008 (Rudi)
- Modules can now modify the cmds hash, i.e. modules can add / overwrite /
delete internal fhem commands. See 99_XmlList.pm for an example. Since this
modules is called 99_xxx, it will be always loaded, but user of webpgm2 do
not need it.
- Wed Dec 17 19:48 (Boris)
- attribute rainadjustment for KS300 in 13_KS300.pm to account for random
switches in the rain counter (see commandref.html)
- Fri Jan 2 10:29 2009 (Rudi)
- 00_CUL responds to CUR request. These are sent as long FS20 messages, with
a housecode stored in CUR_id_list attribute of the CUL device. If the ID
matches, the message is analyzed, and an FS20 message to the same address
is sent back. The CUR must have reception enabled.
Right now status/set time/set FHT desired temp are implemented.
- Fri Jan 6 (Boris)
- daily/monthly cumulated values for EMWZ/EMGZ/EMWM with 15_CUL_EM by Klaus
- Fri Jan 9
- Added a unified dispatch for CUL/FHZ and CM11, since all of them used the
same code.
- Addedd IODev attribute to FS20/FHT/HMS/KS300/CUL_WS/CUL/EMWZ/EMGZ/EMEM
- Sun Jan 11 (Klaus)
- Added fixedrange option day|week|month|year (for pgm2)
e.g.: attr wlEnergiemonat fixedrange month
- Added multiple room assignments for one device (for pgm2):
e.g.: attr Heizvorlauftemp room Energie,Heizung
- Added attr title and label(s) for more flexible .gplot files (for pgm2)
e.g.: attr wl_KF title "Fenster:".$value{KellerFenster}.", Entfeuchter: ".$value{Entfeuchter}
.gplot: <TL> (is almost there!)
attr wl_KF label "Fenster":"Entfeuchter"
.gplot: <L0> ... <L9> (constant text is to be replaced individually)
- Added attr global logdir, used by wildcard %ld in perl.pm
e.g.: attr global logdir /var/tmp
define emGaslog FileLog %ld/emGas.log emGas:.*CNT.*
- Sat Feb 15 2009 (Boris)
- added counter differential per time in 81_M232Counter.pm, commandref.html
updated
- Thu Mar 29 2009 (MartinH)
- pgm3: bugfix, format table for userdef
- pgm3: feature X10_support, taillogorder optional with date
- pgm3: HMS100CO added, fhem.html relating pgm3 updated
- Sat May 30 2009 (Rudi)
- 99_SUNRISE_EL: sunrise/sunset called in "at" computes correctly the next
event. New "sunrise()/sunset()" calls added, min max optional parameter.
- Sun May 31 2009 (Boris)
- 81_M232Counter.pm: counter stops at 65536; workaround makes counter wraparound
- Mon Jun 01 2009 (Boris)
- 59_Weather.pm: new virtual device for weather forecasts, documentation
updated.
- Tue Jun 09 2009 (Boris)
- 11_FHT.pm: lazy attribute for FHT devices
- Sun Jun 14 2009 (Rudi)
- 11_FHT.pm: tmpcorr attribute for FHT devices
- Sat Jun 20 2009 (Boris)
- 09_USF1000.pm: new module to support USF1000S devices.
- Fri Aug 08 2009 (Boris)
- 09_USF1000.pm: suppress inplausible readings from USF1000
- Sat Sep 12 2009 (Boris)
- 00_CM11.pm: feature: get time, fwrev, set reopen for CM11 (Boris 2009-09-12)
- Sun Sep 20 2009 (Boris)
- Module 09_BS.pm for brightness sensor added (Boris 2009-09-20)
- Sat Oct 03 2009 (Boris)
- bugfix: missing blank in attribute list for FHT; exclude report from lazy
- typos and anchors in documentation corrected
- Sun Oct 11 2009 (Boris)
- finalized 09_BS.pm and documentation
- Tue Nov 10 2009 (Martin Haas)
- Bugfix: pgm3: Pulldown-Menu without selected FHTDEV not possible any more
- Thu Nov 12 2009 (Rudi)
- The duplicate pool added. The check routine is called from the Dispatch
routine (so it will affecc CUL/FHZ and CM11), and for FS20 calls from
the CUL and FHZ Write function.
Duplicates within 0.5 seconds are filtered if they are not reported by the
same IO Unit. Existing check for IODev removed from BS USF1000 FS20 FHT HMS
KS300 CUL_WS CUL_EM X10.
- Mon Nov 16 2009 (MartinH)
- pgm3: Google-Weather-Api added. Display of all Logs including the
FS20-devices (grep on fhem.log) The status of the batteries of FHT and HMS
are shown in the graphics. php4 disabled. Now only php5 is supported. A
lot of examples of the UserDefs are added. The pgm3-section of fhem.html was
changed.
- Sat Dec 19 2009 (MartinH)
- pgm3: Automatic support for CUL_WS (S300TH) added
- Mon Dec 21 2009 (Rudi)
- In order to support automatic device creation (coming 98_autocreate.pm),
the return value in case of an undefined device should contain parameters
for a correct define statement.
- Fri Jan 1 2010
- my %defptr is no $modules{modname}{defptr} in order for CommandReload to
work. There is also a second parameter $modules{modname}{ldata} which will
be saved over a Reload, used by the FS20 for the follow feature.
- ignore attribute added to ignore devices of the neighbour
- Fri Jan 8 2010 (MartinH)
Interface to fhem changes to stream_socket_client. Table-format on
Android-Browser optimized. Optimized for smartphones. Rooms possible for
Webcam and Google-Weather. Output of html better formated and skinable --
change the colors.
- Sat Feb 6 2010 (Boris)
- feature: on-for-timer added for X10 modules and bug fixed for overlapping
on-till and on-for-timer commands (Boris)
- Thu Jun 30 2011 (Maz Rashid)
- Introducing 00_TUL.pm and 10_EIB.pm modules for connecting FHEM on EIB.

91
fhem/Makefile
View File

@ -1,91 +0,0 @@
BINDIR=/usr/bin
MODDIR=/usr/share/fhem
VARDIR=/var/log/fhem
DOCDIR=/usr/share/doc/fhem
MANDIR=/usr/share/man/man1
ETCDIR=/etc
# Used for .deb package creation
RBINDIR=$(ROOT)$(BINDIR)
RMODDIR=$(ROOT)$(MODDIR)
RVARDIR=$(ROOT)$(VARDIR)
RDOCDIR=$(ROOT)$(DOCDIR)
RMANDIR=$(ROOT)$(MANDIR)
RETCDIR=$(ROOT)$(ETCDIR)
VERS=5.1
DATE=2011-07-08
DESTDIR=fhem-$(VERS)
all:
@echo Nothing to do for all.
@echo To install, check the Makefile, and then \'make install\'
@echo or \'make install-pgm2\' to install a web frontend too.
install:install-pgm2
install-pgm2:install-base
cp -r webfrontend/pgm2/* $(RMODDIR)/FHEM
cp docs/commandref.html docs/faq.html docs/HOWTO.html $(RMODDIR)/FHEM
cp docs/*.png docs/*.jpg $(RMODDIR)/FHEM
cd examples_changed; for i in *; do cp -r $$i $(RMODDIR)/FHEM/example.$$i; done
cp examples_changed/sample_pgm2 $(RETCDIR)/fhem.cfg
install-base:
@echo After installation start fhem with
@echo perl $(BINDIR)/fhem.pl $(ETCDIR)/fhem.cfg
@echo
@echo
mkdir -p $(RBINDIR) $(RMODDIR) $(RVARDIR)
mkdir -p $(RDOCDIR) $(RETCDIR) $(RMANDIR)
cp fhem.pl $(RBINDIR)
cp -r FHEM $(RMODDIR)
rm -rf examples_changed
cp -r examples examples_changed
perl -pi -e 's,modpath \.,modpath $(MODDIR),' examples_changed/[a-z]*
perl -pi -e 's,([^h]) /tmp,$$1 $(VARDIR),' examples_changed/[a-z]*
-mv $(RETCDIR)/fhem.cfg $(RETCDIR)/fhem.cfg.`date "+%Y-%m-%d_%H:%M:%S"`
cp examples_changed/sample_fhem $(RETCDIR)/fhem.cfg
cp -rp contrib $(RMODDIR)
cp -rp docs/* $(RDOCDIR)
cp docs/fhem.man $(RMANDIR)/fhem.pl.1
gzip -f -9 $(RMANDIR)/fhem.pl.1
dist:
@echo Version is $(VERS), Date is $(DATE)
mkdir .f
cp -r CHANGED FHEM HISTORY Makefile README.CVS\
TODO contrib docs examples fhem.pl webfrontend .f
find .f -name CVS -print | xargs rm -rf
find .f -name example.CVS -print | xargs rm -rf
find .f -name \*.orig -print | xargs rm -f
find .f -name .#\* -print | xargs rm -f
find .f -type f -print |\
xargs perl -pi -e 's/=VERS=/$(VERS)/g;s/=DATE=/$(DATE)/g'
mv .f $(DESTDIR)
tar cf - $(DESTDIR) | gzip > $(DESTDIR).tar.gz
mv $(DESTDIR)/docs/*.html .
rm -rf $(DESTDIR)
deb:
echo $(PWD)
rm -rf .f
make ROOT=`pwd`/.f install
cp -r contrib/DEBIAN .f
find .f -name CVS -print | xargs rm -rf
find .f -name example.CVS -print | xargs rm -rf
find .f -name \*.orig -print | xargs rm -f
find .f -name .#\* -print | xargs rm -f
find .f -type f -print |\
xargs perl -pi -e 's/=VERS=/$(VERS)/g;s/=DATE=/$(DATE)/g'
find .f -type f | xargs chmod 644
find .f -type d | xargs chmod 755
chmod 755 `cat contrib/executables`
gzip -9 .f/$(DOCDIR)/changelog
chown -R root:root .f
mv .f $(DESTDIR)
dpkg-deb --build $(DESTDIR)
rm -rf $(DESTDIR)
fb7390:
cd contrib/FB7390 && ./makeimage $(DESTDIR)

65
fhem/README.CVS
View File

@ -1,65 +0,0 @@
The source of this project is hosted on Berlios, if you wish you can get
the latest version with the following commands:
cvs -d:pserver:anonymous@cvs.fhem.berlios.de:/cvsroot/fhem login
cvs -z3 -d:pserver:anonymous@cvs.fhem.berlios.de:/cvsroot/fhem co fhem
If you wish to contribute to the project, then
- create a berlios account
- send an email to the project manager to add you as developer to the project
(right know this is r dot koenig at koeniglich dot de)
- check out the source with
% cvs -z3 -d<berlios-uid>@cvs.berlios.de:/cvsroot/fhem co fhem
- if it is already checked out, it makes sense to do an update before
implementing your changes:
% cvs update
- make your changes
- test if it is working (Really !!!)
- make an entry in the CHANGED file, giving your changes a "title".
- describe your changes in the file HISTORY, and dont forget to mention your
name and the date of change
- it makes sense to do a "cvs diff" before checking in the stuff with
cvs commit
- if you do complex/nontrivial changes affecting more than one file, then
please tag the whole software before and after the change with:
- before: % cvs tag <berlios-uid>_<date_as_YYYYMMDD>_0
- after: % cvs tag <berlios-uid>_<date_as_YYYYMMDD>_1
You can increase the counter for bugfixing. Dont forget to mention the
tagname in the HISTORY file. Tagging helps to remove more complex changes or
to merge them in other releases/branches.
Some useful CVS commands/flags for the beginner:
# Get the newest stuff from the server and merge it into your changes.
# Watch out for lines beginning with C (collisions), edit them immediately
# after check out, and look for ====
# Without -d new directories won't be checked out
cvs update -d .
# Before checking in, make sure you changed only what you intended:
cvs diff filename
# Add new file. "-kb" adds binary files. Forgetting -kb will cause
# problems if somebody is checking out on a different OS (windows)
# Note: it is complicated to rename files in CVS, so think twice about
# filenames before adding them. e.g. do not use version names in them.
cvs add [-kb] filename
# Look at the change history
cvs log <filename>
# Commit changes. Set the EDITOR environment variable to use your editor.
cvs commit .
# Check which files were changed. Type ^C when it asks you to really release it.
# (is there a more elegant way?)
cvs release .
# We recommend to set some options in our ~/.cvsrc file:
cvs -q
update -d
# The 'cvs -q' option will suppress some output e.g. during update
# only the updated and unknown files etc. are displayed (not every
# folder etc.).
# The 'update -d' will automatically create folders as required.

15
fhem/TODO
View File

@ -1,15 +0,0 @@
FHEM:
- uniform .gplot "set title" and naming (ks300_1.gplot -> tempRain.gplot)
- HomeMatic set log 2
- mergelog
- autodetect physical hardware
- RFR: Error message for uncomplete last message
- implement wiki decisions
Webpgm2
- setting the dummy state via dropdown is not possible
- click on the graph only correct for the day zoom
- integrate weblink details in the SVG
- autocreate: multiple plots
- fancy webkit tranformations

247
fhem/contrib/11_FHT8V.pm
View File

@ -1,247 +0,0 @@
#############################################
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
fhem/contrib/21_OWTEMP.pm.fork
View File

@ -1,531 +0,0 @@
################################################################
#
# 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
fhem/contrib/64_ESA.pm
View File

@ -1,160 +0,0 @@
##############################################
# (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;

166
fhem/contrib/86_FS10.pm
View File

@ -1,166 +0,0 @@
##############################################
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
fhem/contrib/90_EIBUPDOWN.pm
View File

@ -1,211 +0,0 @@
##############################################
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
fhem/contrib/91_DbLog.pm
View File

@ -1,97 +0,0 @@
##############################################
# 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;

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