mirror of
https://github.com/fhem/fhem-mirror.git
synced 2025-04-29 17:37:09 +00:00
New version
git-svn-id: https://svn.fhem.de/fhem/trunk@737 2b470e98-0d58-463d-a4d8-8e2adae1ed80
This commit is contained in:
rudolfkoenig
parent
7cb932b0ce
commit
9b12953efa
269
fhem/FHEM/93_FHEM2FHEM.pm
Executable file
269
fhem/FHEM/93_FHEM2FHEM.pm
Executable file
@ -0,0 +1,269 @@
|
|||||||
|
##############################################
|
||||||
|
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;
|
||||||
|
$hash->{regexpClients} = ".*";
|
||||||
|
|
||||||
|
# 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/^://;
|
||||||
|
}
|
||||||
|
|
||||||
|
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;
|
||||||
Loading…
x
Reference in New Issue
Block a user