#use strict;

#require "ipc.ph";
#require "sem.ph";

use IO::Socket;
use IO::File;
use POSIX ":sys_wait_h";

sub start_log #(Dateiname)
  {
  my $filename = shift;
  open(FH,">>".$filename) || return 0;
  chmod($filename,644);
  # Autoflush setzen fuer FH
  my $oldfh = select(FH); $| = 1; select($oldfh);
  # Lock freigeben
  flock(FH,8);
  # warn und die umleiten
  $SIG{} = \&log_warn;
  $SIG{} = \&log_die;
  return 1;
  }

sub end_log
  {
  close(FH);
  }

sub log_info #(Message)
  {
  my $time = localtime;
  my $mesg = join(' ',@_) || "Oops!";
  $mesg = $time . " [INFO] " . $mesg . "\n";
  flock(FH,2);
  print FH $mesg;
  flock(FH,8);
  }

sub log_warn #(Message)
  {
  my $time = localtime;
  my $mesg = join(' ',@_) || "Oops!";
  $mesg = $time . " [ERROR] " . $mesg . "\n";
  flock(FH,2);
  print FH $mesg;
  flock(FH,8);
  }

sub log_die #(Message)
  {
  my $time = localtime;
  my $mesg = join(' ',@_) || "Oops!";
  $mesg = $time . " [FATAL] " . $mesg . "\n";
  flock(FH,2);
  print FH $mesg;
  flock(FH,8);
  close(FH);
  die @_;
  }


# Port Nr 7777 wg. Firewall Konfiguration im PDV Labor
use constant MYPORT => 7777;
#
my $sock = '';
my $client = '';
my $pid;
my %child_pids = (); # Hash fuer Prozessnummern
my %key_ids = (); # Hash fuer shared mem keys
my %typedef = (); # Hash fuer typedefs
my %sizeof = (); # Hash fuer sizeofs

# signal handler
sub catcher
  { 
  my $pid;
  $SIG{CHLD} = \&catcher;
  foreach $pid (keys(%child_pids))
    {
    if(waitpid($pid, WNOHANG)) # Zombies verhindern
      {
      print "Terminated: $pid\n";
      delete $child_pids{$pid};
      }
    }
  }

start_log ("pdvServer.log");
log_info("Server Start");

$SIG{CHLD} = \&catcher;

# mit pack/unpack werden die Daten binaer gespeichert/entpackt
# typedef und sizeof 'Arbeiten wie in C', wird von perl-Programmierern gehasst!
$typedef{SHORT} = 'S';
$typedef{LONG} = 'L';
$typedef{DOUBLE} = 'd';
$sizeof{SHORT} = length(pack($typedef{SHORT},()));
$sizeof{LONG} = length(pack($typedef{LONG},()));
$sizeof{DOUBLE} = length(pack($typedef{DOUBLE},()));

# #####
# Hier geht das Haupt-Programm los
#

# socket erstellen
$sock = new IO::Socket::INET(LocalPort => MYPORT,
                             Reuse     => 1,
                             Listen    => 20)
    or die "can't create local socket: $@\n";

print STDERR "Accepting connections on Port ", MYPORT, "...\n";

# server laeuft in Endlos-Schleife
while (1)
  {
  # wartet auf neue Verbindungen von Clients
  $client = $sock->accept();
  # accept wird auch von einem signal 'unterbrochen', darum hier noch ne Abfrage 
  if ($client)
    {
    # Verbindung ist aufgebaut
    print STDERR "Accepted connection from ",
        $client->peerhost(), ":", $client->peerport(), "\n";

    # Erzeugen eines Kindprozesses.
    $pid = fork();
    if ($pid == 0) # Kindprozess 
      {
      &serverChild;
      exit(0);
      } 
      else # else Eltern-Prozess
        {
        print STDERR "Prozess $pid started\n ";
        $child_pids{$pid} = 1; 
        $client->close; # not needed in parent
      }
    }
  }

# #####
# Kind-Prozess fuer jeden verbundenen Client
#

sub serverChild
{
my $id;

$sock->close; # not needed in child
$ipaddr = inet_aton($client->peerhost());
print $client "Hi ".gethostbyaddr($ipaddr, AF_INET). " nice to meet you ...\n";
while (<$client>) 
  {
  chomp;
 
  log_info($client->peerhost()." sent: $_");
  
  SWITCH:
    {
    @mycmd=split(' ',$_);
    # START Abtastrate Punkte -> UniqueID zurueck;
    if ($mycmd[0] =~ /START/i)
      {
      if ($#mycmd < 2)
        {
        print $client "NEE usage: START Abtastrate Punkte\n";
        }
      else
        {
        $id = time()/$$;

        $IPC_PRIVATE = 0;
        $IPC_RMID = 0;
        
        # Speicherbedarf
        # Punkteanzahl (Long), id (Double), status (Long)
        # und die Daten (Short)
        #
        $size = $mycmd[2] * $sizeof{SHORT} + $sizeof{LONG} + $sizeof{DOUBLE} + $sizeof{LONG};
        
        $key = shmget($IPC_PRIVATE, $size, 0777);
        unless ($key) 
          {
          log_info("Could not get shared memory");
          print $client "NEE Could not get shared memory\n";
          last SWITCH; 
          }
        else
          {
          log_info("shared mem key START : $key");

          # hier 'eigentlich' 
          # process fork mit vererbung von $key, $id, status 0, Punkteanzahl und Abtastrate
          # wenn fertig status auf 1 setzen, das wars ...
          #
          # hier kann ich nun "einfach" das memory beschreiben .... und beim DATA zurueckgeben
          
          # 'Header' schreiben
          $offset = 0;
          shmwrite $key, pack($typedef{LONG},$mycmd[2]),$offset,$sizeof{LONG};
          $offset += $sizeof{LONG};
          shmwrite $key, pack($typedef{DOUBLE},$id),$offset,$sizeof{DOUBLE};
          $offset += $sizeof{DOUBLE};
          $status = 0;
          $statusOffset = $offset;
          shmwrite $key, pack($typedef{LONG},$status),$offset,$sizeof{LONG};
          $offset += $sizeof{LONG};
          
          # dummy Daten sin(x)/x
          for($i=0; $i <$mycmd[2]; $i++) 
            {
		$test =  sin($i+1)/($i+1) * 2047 + 2048;
		print "$test\n";
		
            shmwrite $key, pack($typedef{SHORT},sin($i+1)/($i+1) * 2047 + 2048),$offset,$sizeof{SHORT};
            $offset += $sizeof{SHORT};
            }
          $status = 1;
          shmwrite $key, pack($typedef{LONG},$status),$statusOffset,$sizeof{LONG};
          
          $key_ids{$id} = $key;
          print $client "OK $id\n" 
          }
        }
      last SWITCH;
      }
    if ($mycmd[0] =~ /DATA/i)
      {
      if ($#mycmd < 1)
        {
        print $client "NEE id needed\n";
        }
      else
        {
        #wenn in key_ids von id ein key steht mit diesem testen ob status ok und dann mit diesem 
        #key die daten auslesen und schicken. dann memory loeschen.
        $id = $mycmd[1];
        $key = $key_ids{$id};
        if ($key) 
          {
          log_info("shared mem key DATA : $key");
          #
          $offset = 0;
          shmread $key, $points,$offset,$sizeof{LONG};
          $offset += $sizeof{LONG};
          $points = unpack($typedef{LONG},$points);
          shmread $key, $id,$offset,$sizeof{DOUBLE};
          $offset += $sizeof{DOUBLE};
          $id = unpack ($typedef{DOUBLE}, $id);
          shmread $key, $status,$offset,$sizeof{LONG};
          $offset += $sizeof{LONG};
          $status = unpack ($typedef{LONG}, $status);
  
          if ($status == 1)
            {
            print $client "OK $points daten werden gesendet\n";

            for($i=0; $i <$points; $i++) 
              {
              shmread $key,$data,$offset,$sizeof{SHORT};
              #print $client "offset: $offset;data[$i] = ". unpack ($typedef{SHORT},$data). "\n";
              #print $client "offset: $offset;data[$i] = $data \n";
							# Auf vielfachen Wunsch des(r) Studenten ...
              print $client "$i:$data\n";
              $offset += $sizeof{SHORT};
              }

            print $client "\nOK Done\n";
            shmctl($key, $IPC_RMID,0); # loescht shared memory
            delete $key_ids{$id};
            }
          else
            {
            print $client "NEE buffer not ready\n";
            }
          }
        else
          {
          print $client "NEE kein key fuer die id gefunden\n";
          }
        }
      last SWITCH;
      }
    if ($mycmd[0] =~ /STOP/i)
      {
      print $client "OK not implemented id would be needed\n";
      last SWITCH; 
      }
    if ($mycmd[0] =~ /ENDE/i)
      {
      print $client "OK will end task and close connection\n";
      # hier alle shared memory Bereiche zu dem Prozess loeschen.
      foreach $key (values(%key_ids))
        {
        print "Remove: $key\n";
        shmctl($key, $IPC_RMID,0);
        }
      $client->close;
      exit(0);
      last SWITCH;
      }
    print $client "NEE unknown command\n";
    }
  }
}

crian@theresa:~/daten/c> /usr/local/bin/perl5.8.4 /usr/local/bin/perlcc student.pl
/usr/local/bin/perlcc: student.pl did not compile:
syntax error at student.pl line 20, near "{}"
 student.pl had compilation errors.

crian@theresa:~/daten/c> perl -c student.pl
syntax error at student.pl line 20, near "{}"
student.pl had compilation errors.