#!/usr/bin/perl
#use strict;

use vars qw( $OS_win );
use Getopt::Std;
use Socket;
use Sys::Syslog;
use sigtrap;

BEGIN {
        $OS_win = ($^O eq "MSWin32") ? 1 : 0;
        if ($OS_win) {
            eval "use Win32::SerialPort 0.11";
	    die2("$@\n") if ($@);
        }
        else {
            eval "use Device::SerialPort";
	    die2("$@\n") if ($@);
        }
} 
#End BEGIN
$SIG{TERM} = sub{&die2('Sig Terminate.')};
$SIG{INT} = sub{&die2('Sig Interupt.')};
$SIG{HUP} = sub{&conf_load;syslog('notice', 'Znovu nactena konfigurace');};
$SIG{CHLD} = 'IGNORE';      #\&reaper;
$SIG{PIPE} = \&pipe;

my ($dev_man) = "/dev/ttyS0";
my ($dev_out)= "/dev/ttyS1";
my ($port) = 8766;
my ($conf_file) = "$ENV{HOME}/.ircontrol.cfg";
my ($sock_file) = "/dev/lircd";

my ($code, %conf, %conf_act, $ser, $val);
my ($share_key);
my ($ident)='ircontrol';

 &getopts("divslo:c:");

openlog($ident, '', 'daemon');

if ($opt_c =~ m|^/[\w\-\=\+\/\.]+$|){$conf_file = $opt_c;}

if ($opt_d && &init_ir && &init_out()){
   &conf_load(); 
   &daemon();   
      
}elsif ($opt_i && &init_ir()){
    &conf_load(); 
    &activ();
}else{
   die "Usege: -[d|i] [-l] [-s] [-o i|r] [-c /cesta/k/souboru/irxxx.cfg
	\t -d  - daemon mode
        \t -c  - Konfiguracni soubor
        \t -s  - Nasloucha na unix soketu $sock_file
	\t -i  - interaktiv mod
	\t -l  - listen on port $port
	\t -o dev - povoli vystupni zarizeni - kde dev je 'r'-reg or 'i'-i2c 
	\t -v  - debug mode
	\t verze 0.1.alpha\n";
}

&die2("konec programu\n");


################### --------------------- ###################
################### funkce a podprogramy  ###################
################### --------------------- ###################

########################### D AE M O N     M O D E #########################
sub daemon {
 my ($code, $val, $sock, $pid, $proto);

###vytvori novy proces a puvodni ukonci
 $pid = fork;
 exit 1 if $pid;
 die2("Couldn't fork: $!") unless defined($pid);

#   if ($opt_l){
#       &tcp_out;
#   }
   if ($opt_s){
       &socket_init();
   }
 syslog('notice', 'Ircontrol inicializovan');
#    $lir_sock = pack_sockaddr_un ($lir_dev);   
#    socket(OUT, PF_UNIX, SOCK_STREAM, ) || die2("nelze otevrit unix soket $!");
#    bind(OUT,/tmp/irman.sock) || die2("nelze pojmenovat soket $!");
#    unlink ('$lir_dev');    
#    $con_stat = connect(OUT,$lir_sock) || die2("no connect $!");
#    print "$con_stat\n";
     
#========= hlavni pracovni smycka programu ===========
  while(1){
    $code = rxd(); 					
    if ($opt_v){print "RXd - $code\n";} #debug
    foreach $val (keys(%conf)){ 		    	
     if ($conf{$val} eq $code){&exe($val)};
    }
  }

}


################ S U B rutiny #############################
###########################################################
############### ke konfiguraci programu  ##################
sub conf_save{
my $key;
open(CONF,">$conf_file") || print("Nelze zapsat do $conf_file !!\n") && return (0);
 foreach $key(@conf_full){
  print(CONF"$key");
 }
close(CONF);
syslog('notice', 'Konfigurace ulozena do %s',$conf_file);
}

sub conf_load{
my ($key, $value, $radek, $action);
 open(CONF,"$conf_file") || print("Nelze otevrit $conf_file !!\n") && return (0);
 @conf_full = <CONF>;
 close(CONF);
 foreach $radek (@conf_full){
  next if ($radek =~ /^\s*#/);
  ($key,$value,$action) = $radek =~ /\s*(\w+)\s*-\s*([\da-f]*)\s*-\s*(.*)$/;
  if ($key){
    $conf{$key}=$value;
    $conf_act{$key}= $action ? $action : "ext";
  }
 }
}
sub test_conf{
#test stejnych kodu
    my $key;
    foreach $key(keys(%conf)){
	if ($conf{$key} =~/\s*/){next;}
	foreach $key2(keys(%conf)){
	    if ($conf{$key} eq $conf{$key2} and $key ne $key2){
print "****** POZOR ******\n$key ma stejny kod jako $key2\n"
	    }
	}
    }
    print "Enter:>";
    <>;

}
########################## uceni kodu  #############################
sub learnig{
my ($key, $i,$k);

system ("clear");
  foreach $i (sort keys %conf){
      print "\n\n\n\nZadani pro:$i\tnyni:";
      print $conf{$i} ? $conf{$i} : ' -----';
      print "\n";
      print "n - Next\n";
      print "e - erase (vymazat kod)\n";
      print "q - Exit\n";
      print "enter - pokracovat zadavanim kodu\n";
      print "###>";
      $key=<STDIN>;
      chomp($key);
      if ($key eq 'q'){
	  &test_conf;return;
      }elsif ($key eq 'e'){
	  $conf{$i}='';
      }elsif ($key eq 'n'){
	  next;
      }else{
	  print "Stisknete tlacitko na ovladaci\n";
	  $new_kode = &rxd();
	  $conf{$i}=$new_kode;
	  for($k=0;$k<@conf_full;$k++){
	      if ($conf_full[$k] =~ s/^\s*($i)\s*-\s*[\da-f]*\s*-/$i - $new_kode -/){
		  system ("clear");
		  print ("\n\nK $i prirazen kod: $new_kode\n");
	      }
	  }

     }
  }
}
########################## ukazat nastaveni #########################
sub show{
my $key;
 print ("vypis nastaveni\n");
 foreach $key(sort keys(%conf)){
 print ("$key - $conf{$key} - $conf_act{$key}\n");
 }
print "Enter pro pokracovani\n";
<>;
}

##########################
## sub k interaktiv modu #
## cteni peikazu #########
sub activ{
my $key;
while(1){
 $key=menu();
 if($key eq "1"){
  learnig();
 }elsif($key eq "2"){
  show();
 }elsif($key eq "3"){
  daemon();
 }elsif($key eq "4"){
  conf_load();
 }elsif($key eq "5"){
  conf_save();
 }elsif($key eq "q"){
  last;
 }
}
}
##### interaktiv menu 
sub menu{
 my $key;
 system ("clear");
 print ("1 - Naucit\n");
 print ("2 - Ukazat nastaveni \n");
 print ("3 - prejit do deamon modu \n");
 print ("4 - nacist konfiguraci \n");
 print ("5 - ulizit konfikuraci \n");
 print ("q - Ukoncit \n");
 print ("Volba>");
 $key=<STDIN>;
 chomp($key);
 return $key;
}

########################## ------------------------------ ##########
########################## inicializace zarizeni $dev_man ##########
########################## -------  pro prijem IR  ------ ##########
sub die2{

    undef $ir_dev;
    undef $io_dev;
    syslog('notice', 'Ukoncuji: %s',@_);
    closelog;
    die "@_";
}
sub init_ir{
my $status;

  if ($OS_win) {
    $ir_dev = Win32::SerialPort->new ($dev_man, 0, 0);
  }else {
    $ir_dev = Device::SerialPort->new ($dev_man, 0, 0);
  }
    die2("Can't open serial port from $dev_man: $^E\n") unless ($ir_dev);

 $ir_dev->rts_active(0);
 $ir_dev->dtr_active(0);
 $ir_dev->baudrate(9600);
 $ir_dev->parity("none");
 $ir_dev->databits(8);
 $ir_dev->stopbits(1);
 $ir_dev->handshake("none");
 $ir_dev->rts_active(1);
 $ir_dev->dtr_active(1);
 &delay(0.3);
 $ir_dev->purge_all;
 $status = $ir_dev->write(I);
 &delay(0.1);
 $status = $ir_dev->write(R);
 &delay(0.1);
 $status = $ir_dev->input;
 print ("precteno $status\n") if ($opt_v);
 if($status eq 'OK'){return 1};
 print "Inicializace Irman selhala\n";
0;
}

########################## prijem z irmanu  ##################################
sub rxd{
my ($count, $code);
 $ir_dev->purge_rx;
   while(1){
    ($count,$code) = $ir_dev->read(6);
    if ($count){ 
     $code = unpack("h*",$code);
#     print ("code - $code \t delka - $count\n");
     last;
    }
    &delay(0.05);
   }
 return $code;  
 }
#####
##### funkce vyhodnocuje prijaty kod a vykonava akce podle configu
##### nebo posila externim programum (pres local_soket jako lircd nebo pres TCP spojeni)
#####
#####
sub exe {
my ($key)=@_;
my ($out_val, $mode, $addres, $value, $do, $mess,$prikaz);
if($opt_v){print ("volam exe klic: $key\t hodnota:$conf_act{$key}\n");}

  if ($conf_act{$key} =~ m|^(\/[\w\-\=\+\.\s\/]+$)|){
      print "Predavam prikaz $1 systemu\n" if ($opt_v);
#predani prikazu z configu operacnimu systemu
# velice nebezpecne !!!!!!!!!!!!!!
      system "$1";

##posilani na soket
  }elsif ($conf_act{$key} eq "ext"){
      if (defined($count) && $count <= '34'){$count++;
      }else{
	  $count = '1';
      }
      $mess = unpack(B16,$count). " 0 $key rc-5_whit_irman\n";
      print "Zapisuji do share variable: $mess" if ($opt_v);
      shmwrite($share_key, $mess, 0, 60 ) or die2("shmwrite: $!");
      &delay(0.1);
# <code> <repeat count> <button name> <remote control name>

#reg
  }elsif($conf_act{$key} eq /out/){
      print "volam out_reg comand\n" if ($opt_v);
      if ($opt_o ne 'r'){print "Neni pripojen odpovidajici Hw\nNutno spustit parametrem '-o r'\n";return 0;}
      &out_reg($conf_act{$key});
#i2c
  }elsif(($mode,$addres,$value,$do) = $conf_act{$key} =~ /^i2c\s+(\d)\s+(\d+)\s+(\d+)\s*(on|off)?\s*$/){
#####/^i2c\s+(\d)\s+([0-255])\s+([0-255])\s+(on|off)/){
#      print ("mode:$mode\t addres: $addres\tvalue:$value\tdelat:$do\n") if ($opt_v);
      if ($opt_o ne "i"){print "Neni pripojen odpovidajici Hw\nNutno spustit parametrem '-o i'\n";return 0;}
#     print ("i2c prikaz: $mode, $addres, $value\n") if ($opt_v);
      if ($mode == 0){
	  #po nastaveni vynuluje aby nebyla neustale vnucovana rele urcita poloha (pro zachovani rucniho ovladani)
	  &out_i2c($addres,$value);
	  &delay(0.1);     #pokud se rele nestihne prepnou, prodlouzit cas
	  &out_i2c($addres,0);
      }elsif ($mode == 1){
	  unless(defined($mode_1_mem[$addres])){$mode_1_mem[$addres]='255';}
	  if ($do eq 'off'){
	      $mode_1_mem[$addres] = $mode_1_mem[$addres] | $value;

	  }elsif($do eq 'on'){
#	      print "nexorovana $value\t";
	      $value = $value^255;      #xor hodnoty value
#	      print "xorovana $value\n";
	      $mode_1_mem[$addres] = $mode_1_mem[$addres] & $value;
	  }else{
	      print "Chyba configu i2c mode_1 chybny parametr: $do muze byt pouze [on/off]\n";return 0;
	  }
	  print "volam out_i2c s adres:$addres \tvalue: $mode_1_mem[$addres]\n" if ($opt_v);
	  &out_i2c($addres, $mode_1_mem[$addres]);

      }else{print "Neznamy I2C mod (typ zarizeni viz. 'irman.cfg')\n";return 0;}
  }

}

#################################### ------------------  ####################################
#################################### I O   V y s t u p y #####################################
#### inicializece vystupniho zarizeni na portu $dev_out 
sub init_out{

if ($opt_o eq 'r' || $opt_o eq 'i'){
    if ($OS_win) {
      $io_dev = Win32::SerialPort->new ($dev_out, 0, 0);
    }else {
      $io_dev = Device::SerialPort->new ($dev_out, 0, 0);
    }
    die2("Can't open serial port from $dev_out: $^E\n") unless ($io_dev);
    $io_dev->rts_active(0);
    $io_dev->dtr_active(0);

}elsif($opt_o){ die2("Chybny parametr -o $opt_o\n");
}else{ return 1;}

if($opt_o eq 'i'){
# dev out is i2c
    &test_i2c();
    &init_i2c();
  }
}



#### vystup na posuvny registr pripojeny k RS232<->8bite_paralelne
sub out_reg{
my ($zadani) = @_;
my ($i, $k)=128;
my ($bite);
while ($i >= 1){
 $bite = $zadani & $i;
 if ($opt_v){ print  ("Bite = $bite\n");}
 if ($bite){
  $io_dev->rts_active(1);
  $io_dev->pulse_dtr_on(0.1);
  $io_dev->rts_active(0);       
  if ($opt_v){ print  "\|";} 
 }else{
  $io_dev->rts_active(0);
  $io_dev->pulse_dtr_on(0.1);
  if ($opt_v){ print  ".";}
 }
$i = $i/2;
}
if ($opt_v){ print  "\n";}
$io_dev->write(1);

select (undef, undef, undef, 0.2);
  $io_dev->rts_active(0);
for($k=1; $k<=8; $k++){
  if ($opt_v){ print  ".";}
  $io_dev->pulse_dtr_on(0.1);
  }
$io_dev->write(1);
if ($opt_v){ print  "\n";}
}

##### vystup na posuvny registr pripojeny na RS232<->I2C
##### ostatni funkce pro I2C
sub out_i2c{
 my ($adr, $data)=@_;
    &start_i2c();
    &data_i2c($adr);
    &read_ack() || &stop_i2c() && return 0;
    &data_i2c($data);
    &read_ack() || &stop_i2c() && return 0;
    &stop_i2c();
return 1
}

sub init_i2c{
 &scl(1);   
# &delay(0.1);
 &sda(1);
}
sub start_i2c{
 &sda(0);    
# &delay(0.1);
 &scl(0);
}
#stop
sub stop_i2c{
    &scl(0);
# &delay(0.1);
    &sda(0);
# &delay(0.1);
    &scl(1);
# &delay(0.1);
    &sda(1);
}
# vysilani dat
sub data_i2c{
my ($zadani) = @_;
my ($i)=128;
my ($bite);
 while ($i >= 1){
#  if ($opt_v){ print  ("i = $i\n");}
  $bite = $zadani & $i;
#  if ($opt_v){ print  ("Bite = $bite\n");}
  if ($bite){
# vysilani log 1.
   &sda(1);
#   &delay(0.1);
   &scl(1);
#   &delay(0.1);
   &scl(0);
   &sda(0);
   if ($opt_v){ print  "\|";} 
 }else{
# vysilani log 0.
   &scl(1);
#   &delay(0.1);
   &scl(0);
   if ($opt_v){ print  ".";}
 }
 $i = $i/2;
 }
if ($opt_v){ print  "\n";}
}

sub read_ack{
 my($modstat, $ret);
    &sda(1);
 #   &delay(0.1);
    &scl(1);
 #  &delay(0.1);
     #cteni CTS pro ack od obvodu
   $modstat = $io_dev->modemlines;  
   if ($modstat & $io_dev->MS_CTS_ON){$ret = 0; #na sda je log.1 = neni ack
   }else{$ret = 1;}                         #na sda je log.0 = je ack
   &scl(0);
   &sda(0);
 print "ACK error - Node neodpovedel\n" if ($opt_v && not $ret);
return $ret;    
}

sub test_i2c{
my $modstat;
  &sda(0);
  $modstat = $io_dev->modemlines;
  if ($modstat & $io_dev->MS_CTS_ON) {die2("Neni pripojen I2C hardware na portu $dev_out\n"); }

  &sda(1);
  $modstat = $io_dev->modemlines;
  if (not $modstat & $io_dev->MS_CTS_ON) {die2("Neni pripojen I2C hardware na portu $dev_out\n"); }
}

sub sda{
  $io_dev->dtr_active(@_);
}
sub scl{
  $io_dev->rts_active(@_);
}
sub delay{
    my ($num)=@_;
    select(undef, undef, undef, $num);
}

################################ sit a komunikace s daemonem ###########
################################ tcp komunikace s lirc #################

sub socket_init{
my $uaddr = sockaddr_un($sock_file);
my $proto = getprotobyname('tcp');
my ($paddr);
my ($pid1,$pid);
$IPC_PRIVATE = 0;
$IPC_RMID = 0;
$size = 200;

$share_key = shmget($IPC_PRIVATE, $size , 0777 );
die unless defined $share_key;
shmwrite($share_key, 'null', 0, 60 ) or die2("shmwrite: $!");

socket(SERV,PF_UNIX,SOCK_STREAM,0)      or die2("socket: $!");
unlink($sock_file);
bind  (SERV, $uaddr)                    or die2("bind: $!");
listen(SERV,128)                  or die2("listen: $!");
#SOMAXCONN

print "server started on $sock_file\n" if ($opt_v);
syslog('notice', 'Server started on %s',$sock_file);
chmod 0777, $sock_file;

        if (!defined($pid1=fork)){die2("fork error $!\n");}
	if (!$pid1){
		while ($paddr = accept(Client,SERV)){
		    print "Any Conect on $sock_file \n" if ($opt_v); 
		    syslog('notice', 'Any conect on %s', $sock_file);
		    if (!defined($pid=fork)){
			die2("Nezdareny fork $!\n");
		    }elsif($pid){
			close Client;
		        #next;
		    }else{
		## novy proces pro obsluhu klienta na $sock_dev     
			close SERV;
			eval child();
		    }
	       }
		print ("deleting $share_key\n") if ($opt_v); 
		shmctl($share_key ,$IPC_RMID, 0) or die2("shmctl: $!");
		die("deamon z /dev/lircd die\n")
	 }

}

sub child { 

my $share_var;
  shmread($share_key,$share_var,0,60) or die2("shmread: $!");
#print "prvni cteni:$share_var\n";
my ($old_val)=$share_var;
  while (1){
      shmread($share_key,$share_var,0,60) or die2("shmread: $!");
#      print "porovnani: $share_var ne $old_val\n";
      if ($share_var ne $old_val){ 
#	  print "child say:\n";
	  #ast unless defined(
	  syswrite Client, $share_var, length($share_var);
	  #;
	  $old_val = $share_var;
      }
      &delay(0.1);
  }
}


#sub reaper{
#syslog('notice', 'sig CHLD');
# while ($pid = waitpid(-1, WNOHANG)){
#     if($pid ne -1){
#     print "pid k zabiti $pid\n";
#     kill $pid;    
#     }else{last;}
# $SIG{CHLD} = \&reaper; 
# }
#}

sub pipe {
syslog('notice', 'Child killed');
exit;	
}
	









##################################3 NEPOUZIVANE
sub tcp_out{

my ($sockaddr, $addr, $name, $aliases, $proto, $af, $in, $pid, $this, $sock, $inetaddr);
my (@inetaddr);
if ($pid = fork){
 $sockaddr = 'S n a4 x8';
 ($name, $aliases, $proto) = getprotobyname('tcp');
 ($name, $aliases, $port) = getservbyname($port, 'tcp')
    unless $port =~ /^\d+$/;
    $this = pack($sockaddr, AF_INET, $port, "\0\0\0\0");
    socket(S, PF_INET, SOCK_STREAM, $proto) || die2("socket: $!");
    bind(S, $this) || die2("bind: $!");
    listen(S, 5) || die2("connect: $!");
  ########################################## local socket ipc
   socket(IN, AF_UNIX, SOCK_STREAM, $proto) || die2("nelze otevrit unix soket $!");
   $sock = pack_sockaddr_un('/tmp/irman.sock');
   bind(IN, $sock) || die2("nelze pojmenovat soket $!");
   listen(IN, 6) || die2("ne naspucha $!");
   accept(NIN,IN) || die2($!);
########################################### vyrizovani pozadavku
   for (;;) {
     #print "Listening again\n";
     ($addr = accept(NS,S)) || die2($!);
     print "accept ok\n";
     ($af,$port,$inetaddr) = unpack($sockaddr,$addr);
     @inetaddr = unpack('C4',$inetaddr);
     if ($inetaddr[0] != 127){close NS;next;}
     #print "$port @inetaddr\n";
      while () {
        read(NIN, $in, 1);
	syswrite(NS,$in,length($in));
      }
   }
}else{
 select (undef, undef, undef, 0.5);
 return
}
}


1;