##############################################
# $Id$
package main;

use strict;
use warnings;
use Time::HiRes qw(gettimeofday);

sub HMLAN_Parse($$);
sub HMLAN_Read($);
sub HMLAN_Write($$$);
sub HMLAN_ReadAnswer($$$);
sub HMLAN_uptime($);
sub HMLAN_secSince2000();

sub HMLAN_SimpleWrite(@);

my %sets = (
  "hmPairForSec" => "HomeMatic",
  "hmPairSerial" => "HomeMatic",
);

sub
HMLAN_Initialize($)
{
  my ($hash) = @_;

  require "$attr{global}{modpath}/FHEM/DevIo.pm";

# Provider
  $hash->{ReadFn}  = "HMLAN_Read";
  $hash->{WriteFn} = "HMLAN_Write";
  $hash->{ReadyFn} = "HMLAN_Ready";
  $hash->{SetFn}   = "HMLAN_Set";
  $hash->{Clients} = ":CUL_HM:";
  my %mc = (
    "1:CUL_HM" => "^A......................",
  );
  $hash->{MatchList} = \%mc;

# Normal devices
  $hash->{DefFn}   = "HMLAN_Define";
  $hash->{UndefFn} = "HMLAN_Undef";
  $hash->{AttrList}= "do_not_notify:1,0 dummy:1,0 " .
                     "loglevel:0,1,2,3,4,5,6 addvaltrigger " . 
                     "hmId hmKey " .
					 "hmProtocolEvents:0_off,1_dump,2_dumpFull,3_dumpTrigger";
}

#####################################
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;
  }
  DevIo_CloseDev($hash);

  my $name = $a[0];
  my $dev = $a[2];
  $dev .= ":1000" if($dev !~ m/:/ && $dev ne "none" && $dev !~ m/\@/);
  $attr{$name}{hmId} = sprintf("%06X", time() % 0xffffff); # Will be overwritten

  if($dev eq "none") {
    Log 1, "$name device is none, commands will be echoed only";
    $attr{$name}{dummy} = 1;
    return undef;
  }
  $hash->{DeviceName} = $dev;
  my $ret = DevIo_OpenDev($hash, 0, "HMLAN_DoInit");
  return $ret;
}


#####################################
sub
HMLAN_Undef($$)
{
  my ($hash, $arg) = @_;
  my $name = $hash->{NAME};

  foreach my $d (sort keys %defs) {
    if(defined($defs{$d}) &&
       defined($defs{$d}{IODev}) &&
       $defs{$d}{IODev} == $hash)
      {
        my $lev = ($reread_active ? 4 : 2);
        Log GetLogLevel($name,$lev), "deleting port for $d";
        delete $defs{$d}{IODev};
      }
  }

  DevIo_CloseDev($hash); 
  return undef;
}

#####################################
sub
HMLAN_RemoveHMPair($)
{
  my $hash = shift;
  delete($hash->{hmPair});
}


#####################################
sub
HMLAN_Set($@)
{
  my ($hash, @a) = @_;

  return "\"set HMLAN\" needs at least one parameter" if(@a < 2);
  return "Unknown argument $a[1], choose one of " . join(" ", sort keys %sets)
  	if(!defined($sets{$a[1]}));

  my $name = shift @a;
  my $type = shift @a;
  my $arg = join("", @a);
  my $ll = GetLogLevel($name,3);

  if($type eq "hmPairForSec") { ####################################
    return "Usage: set $name hmPairForSec <seconds_active>"
        if(!$arg || $arg !~ m/^\d+$/);
    $hash->{hmPair} = 1;
    InternalTimer(gettimeofday()+$arg, "HMLAN_RemoveHMPair", $hash, 1);

  } elsif($type eq "hmPairSerial") { ################################
    return "Usage: set $name hmPairSerial <10-character-serialnumber>"
        if(!$arg || $arg !~ m/^.{10}$/);

    my $id = AttrVal($hash->{NAME}, "hmId", "123456");
    $hash->{HM_CMDNR} = $hash->{HM_CMDNR} ? ($hash->{HM_CMDNR}+1)%256 : 1;

    HMLAN_Write($hash, undef, sprintf("As15%02X8401%s000000010A%s",
                    $hash->{HM_CMDNR}, $id, unpack('H*', $arg)));
    $hash->{hmPairSerial} = $arg;

  }
  return undef;
}


#####################################
# This is a direct read for commands like get
sub
HMLAN_ReadAnswer($$$)
{
  my ($hash, $arg, $regexp) = @_;
  my $type = $hash->{TYPE};

  return ("No FD", undef)
        if(!$hash && !defined($hash->{FD}));

  my ($mdata, $rin) = ("", '');
  my $buf;
  my $to = 3;                                         # 3 seconds timeout
  $to = $hash->{RA_Timeout} if($hash->{RA_Timeout});  # ...or less
  for(;;) {

    return ("Device lost when reading answer for get $arg", undef)
      if(!$hash->{FD});
    vec($rin, $hash->{FD}, 1) = 1;
    my $nfound = select($rin, undef, undef, $to);
    if($nfound < 0) {
      next if ($! == EAGAIN() || $! == EINTR() || $! == 0);
      my $err = $!;
      DevIo_Disconnected($hash);
      return("HMLAN_ReadAnswer $arg: $err", undef);
    }
    return ("Timeout reading answer for get $arg", undef)
      if($nfound == 0);
    $buf = DevIo_SimpleRead($hash);
    return ("No data", undef) if(!defined($buf));

    if($buf) {
      Log 5, "HMLAN/RAW (ReadAnswer): $buf";
      $mdata .= $buf;
    }
    if($mdata =~ m/\r\n/) {
      if($regexp && $mdata !~ m/$regexp/) {
        HMLAN_Parse($hash, $mdata);
      } else {
        return (undef, $mdata)
      }
    }
  }
}

my %lhash;

#####################################
sub
HMLAN_Write($$$)
{
  my ($hash,$fn,$msg) = @_;
  my $dst = substr($msg, 16, 6);

#  my $IDHM  = '+'.$dst.',01,00,F1EF'; #used by HMconfig - meanning??
  my $IDadd = '+'.$dst.',00,00,';     # guess: add ID?                                     
  my $IDsub = '-'.$dst;               # guess: ID remove?
#  my $IDact = '+'.$dst;               # guess: ID recover? Different to IDadd?
#  my $IDack = '+'.$dst.',02,00,';     # guess: ID acknowledge
    
  HMLAN_SimpleWrite($hash, $IDadd) if (!$lhash{$dst});
  $lhash{$dst} = 1;
   
  if(hex(substr($msg, 6, 2))&0x01){   # wakeup sequence for TC... hmmm
    HMLAN_SimpleWrite($hash, $IDadd);
    HMLAN_SimpleWrite($hash, $IDadd);
    HMLAN_SimpleWrite($hash, $IDadd);
    HMLAN_SimpleWrite($hash, $IDsub);
    HMLAN_SimpleWrite($hash, $IDadd);
    HMLAN_SimpleWrite($hash, $IDadd);
    HMLAN_SimpleWrite($hash, $IDadd);
    HMLAN_SimpleWrite($hash, $IDadd);
    #HMLAN_SimpleWrite($hash, "+$dst,01,00,F1EF\x0d\x0a");
  }
  my $tm = int(gettimeofday()*1000) % 0xffffffff;
  $msg = sprintf("S%08X,00,00000000,01,%08X,%s",$tm, $tm, substr($msg, 4));
  HMLAN_SimpleWrite($hash, $msg);

  # Avoid problems with structure set
  # TODO: rewrite it to use a queue+internaltimer like the CUL
}

#####################################
# called from the global loop, when the select for hash->{FD} reports data
sub
HMLAN_Read($)
{
  my ($hash) = @_;

  my $buf = DevIo_SimpleRead($hash);
  return "" if(!defined($buf));
  my $name = $hash->{NAME};

  my $hmdata = $hash->{PARTIAL};
#  Log 5, "HMLAN/RAW: $hmdata/$buf";
  $hmdata .= $buf;

  while($hmdata =~ m/\n/) {
    my $rmsg;
    ($rmsg,$hmdata) = split("\n", $hmdata, 2);
    $rmsg =~ s/\r//;
    HMLAN_Parse($hash, $rmsg) if($rmsg);
  }
  $hash->{PARTIAL} = $hmdata;
}

sub
HMLAN_uptime($)
{
  my $msec = shift;

  $msec = hex($msec);
  my $sec = int($msec/1000);
  return sprintf("%03d %02d:%02d:%02d.%03d",
                  int($msec/86400000), int($sec/3600),
                  int(($sec%3600)/60), $sec%60, $msec % 1000);
}

sub
HMLAN_Parse($$)
{
  my ($hash, $rmsg) = @_;
  my $name = $hash->{NAME};
  my $ll5 = GetLogLevel($name,5);
  my @mFld = split(',', $rmsg);
  my $letter = substr($mFld[0],0,1); # get leading char
  
  if ($letter =~ m/^[ER]/){#@mFld=($src, $status, $msec, $d2, $rssi, $msg)
    Log $ll5, 'HMLAN_Parse: '.$name.' S:'.$mFld[0]
#	                               .(if($mFld[0] =~ m/^E/)?'  ':'')
	                               .' stat:'.$mFld[1]
	                               .' t:'.$mFld[2].' d:'.$mFld[3]
								   .' r:'.$mFld[4]. 
 								  'm:'.$mFld[5];
#                                  '     m:'.substr($mFld[5],0,2). 
#                                  ' '.substr($mFld[5],2,4).
#                                  ' '.substr($mFld[5],6,6).
#                                  ' '.substr($mFld[5],12,6). 
#                                  ' '.substr($mFld[5],18);
								  
    my $dmsg = sprintf("A%02X%s", length($mFld[5])/2, uc($mFld[5]));
	
	my $src = substr($mFld[5],6,6);
	my $dst = substr($mFld[5],12,6);
	my $flg = hex(substr($mFld[5],2,2));
    # handle status. 1-ack,8=nack,21=?,02=? 81=open

    HMLAN_SimpleWrite($hash, '+'.$src) if (($letter eq 'R'));          #ok

    if (!($flg & 0x25)){#rule out other messages 
	  HMLAN_SimpleWrite($hash, '-'.$src);
	  HMLAN_SimpleWrite($hash, '+'.$src);
	}
    $dmsg .= "NACK" if($mFld[1] !~ m/00(01|02|21)/ && $letter eq 'R');	

    $hash->{uptime} = HMLAN_uptime($mFld[2]);
	$hash->{RSSI}   = hex($mFld[4]);
    $hash->{RAWMSG} = $rmsg;
    $hash->{"${name}_MSGCNT"}++;
    $hash->{"${name}_TIME"} = TimeNow();
    my %addvals = (RAWMSG => $rmsg, RSSI => hex($mFld[4]));
    Dispatch($hash, $dmsg, \%addvals);
  }
  elsif($mFld[0] eq 'HHM-LAN-IF'){#@mFld=(undef,$vers,$serno,$d1,$owner,$msec,$d2)
    $hash->{serialNr} = $mFld[2];
    $hash->{firmware} = sprintf("%d.%d", (hex($mFld[1])>>12)&0xf, hex($mFld[1]) & 0xffff);
    $hash->{owner} = $mFld[4];
    $hash->{uptime} = HMLAN_uptime($mFld[5]);
    Log $ll5, 'HMLAN_Parse: '.$name.                 ' V:'.$mFld[1]
	                               .' sNo:'.$mFld[2].' d:'.$mFld[3]
								   .' O:'  .$mFld[4].' m:'.$mFld[5].' d2:'.$mFld[6];
    my $myId = AttrVal($name, "hmId", $mFld[4]);
    if(lc($mFld[4]) ne lc($myId) && !AttrVal($name, "dummy", 0)) {
      Log 1, 'HMLAN setting owner to '.$myId.' from '.$mFld[4];
      HMLAN_SimpleWrite($hash, "A$myId");
    }
  }
  elsif($rmsg =~ m/^I00.*/) {;
    # Ack from the HMLAN
  } 
  else {
    Log $ll5, "$name Unknown msg >$rmsg<";
  }
}


#####################################
sub
HMLAN_Ready($)
{
  my ($hash) = @_;

  return DevIo_OpenDev($hash, 1, "HMLAN_DoInit");
}

########################
sub
HMLAN_SimpleWrite(@)
{
  my ($hash, $msg, $nonl) = @_;
  my $name = $hash->{NAME};
  return if(!$hash || AttrVal($hash->{NAME}, "dummy", undef));

  select(undef, undef, undef, 0.01); #  todo check necessity
#---------- confort trace--------------
#  Log GetLogLevel($name,5), 'HMLAN_Send:         S:'.
#                                        substr($msg,0,9).
#                            ' stat:  '.substr($msg,10,2).
#                            ' t:'      .substr($msg,13,8).
#                            ' d:'      .substr($msg,22,2).
#                            ' r:'      .substr($msg,25,8).
# 							 ' m:'      .substr($msg,34)

#                            ' m:'      .substr($msg,34,2).
#                            ' '        .substr($msg,36,4). 
#                            ' '        .substr($msg,40,6).
#                            ' '        .substr($msg,46,6). 
#                            ' '        .substr($msg,52)     
#							if (length($msg )>19);
#  Log GetLogLevel($name,5), 'HMLAN_Send:  '.$msg     if (length($msg) <=19); 
#----------- normal trace,better speed-----------
  Log GetLogLevel($name,5), 'HMLAN_Send:  '.$msg; #normal trace
  
  $msg .= "\r\n" unless($nonl);
  syswrite($hash->{TCPDev}, $msg)     if($hash->{TCPDev});
}

########################
sub
HMLAN_DoInit($)
{
  my ($hash) = @_;
  my $name = $hash->{NAME};

  my $id  = AttrVal($name, "hmId", undef);
  my $key = AttrVal($name, "hmKey", "");        # 36(!) hex digits

  my $s2000 = sprintf("%02X", HMLAN_secSince2000());

  HMLAN_SimpleWrite($hash, "A$id") if($id);
  HMLAN_SimpleWrite($hash, "C");
  HMLAN_SimpleWrite($hash, "Y01,01,$key");
  HMLAN_SimpleWrite($hash, "Y02,00,");
  HMLAN_SimpleWrite($hash, "Y03,00,");
  HMLAN_SimpleWrite($hash, "Y03,00,");
  HMLAN_SimpleWrite($hash, "T$s2000,04,00,00000000");

  InternalTimer(gettimeofday()+25, "HMLAN_KeepAlive", $hash, 0);
  return undef;
}

#####################################
sub
HMLAN_KeepAlive($)
{
  my $hash = shift;
  return if(!$hash->{FD});
  HMLAN_SimpleWrite($hash, "K");
  InternalTimer(gettimeofday()+25, "HMLAN_KeepAlive", $hash, 1);
}

sub
HMLAN_secSince2000()
{
  # Calculate the local time in seconds from 2000.
  my $t = time();
  my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($t);
  $t -= 946684800; # seconds between 01.01.2000, 00:00 and THE EPOCH (1970)
  $t -= 7200;   # HM Special
  $t += fhemTzOffset($t);
  return $t;
}

1;
