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

my $port="5678";
my $wait=2;

my $service=csharp_ipc_service->new($port,$wait);
print csharp_ipc_service::error()."\n" unless($service);

# Etwas Demonstartion, dass es Funktioniert

if($service->test_running())
{ print "test_running() erfolgreich\n"; }
else
{ print "ERROR:".$service->error()."\n"; }
print "#"x80,"\n";

if($service->test_running())
{ print "test_running() erfolgreich\n"; }
else
{ print "ERROR:".$service->error()."\n"; }
print "#"x80,"\n";

my $val=$service->test_get(1);
if(defined($val))
{ print "test_get(1) = $val\n"; }
else
{ print "ERROR:".$service->error()."\n"; }
print "#"x80,"\n";

$val=$service->test_get(4);
if(defined($val))
{ print "test_get(4) = $val\n"; }
else
{ print "ERROR:".$service->error()."\n"; }
print "#"x80,"\n";

########################################################################
########################################################################
########################################################################

{package csharp_ipc_service;
use strict;
use warnings;
use Protocol::XMLRPC::MethodCall;
use Protocol::XMLRPC::MethodResponse;
use LWP::UserAgent;
use FindBin;
use POSIX ":sys_wait_h";

my $ERROR=undef;

#-----------------------------------------------------------------------
sub new
{
  my $class=shift;
  my $port=shift;
  my $wait=shift;

  my $self={};
  $self->{stop}=0;
  $self->{pid}=0;
  $self->{ua}=undef;
  $self->{host}=undef;
  $self->{name}='test';

  bless($self, $class);
  unless($self->_start($port,$wait))
  {
    $ERROR=$self->{ERROR};
    return undef;
  }
  return $self;
}

#-----------------------------------------------------------------------
# Kommandos, die auf dem Server ausgeführt werden sollen
sub test_running
{
  my $self=shift;
  my $ret=$self->_runn_cmd('Running');
  return 1 if(defined($ret));
  return 0;
}

sub test_get
{
  my $self=shift;
  my $number=shift;
  return $self->_runn_cmd('Get',$number);
}

#-----------------------------------------------------------------------
# Fehler ausgeben wenn sie auftreten
sub error
{
  my $self=shift;
  if($self && ref($self) eq __PACKAGE__)
  {
    my $err=$self->{ERROR} || '';
    $self->{ERROR}=undef if($self->{ERROR});
    return $err;
  }
  else
  {
    my $err=$ERROR;
    $ERROR=undef;
    return $err;
  }
}

########################################################################
# privat #
########################################################################

sub _add_error
{
  my $self=shift;
  my $msg=shift;
  if($msg)
  {
    if($self->{ERROR})
    { $self->{ERROR}.="\n$msg"; }
    else
    { $self->{ERROR}=$msg; }
  }
}


sub _runn_cmd
{
  my $self = shift;
  my $method = shift;

  my $method = Protocol::XMLRPC::MethodCall->new( 'name' => $self->{name}.'.'.$method );
  $method->add_param($_) for(@_);

  my $req = HTTP::Request->new('POST', $self->_url() );
  $req->content_type('text/xml');
  $req->content( $method->to_string() );
  $req->content_length( length($req->content()) );

  my $return=undef;

  my $resp = $self->_ua->request($req);
  if($resp->is_success())
  {
    my $rcontent = $response->decoded_content( );
    my $response=undef;

    eval
    { $response = Protocol::XMLRPC::MethodResponse->parse( $rcontent ); };
    if($@)
    { $self->_add_error( "Server did not send a valid xmlrpc response: $@" ); }

    $return= $response->param() if($response);
  }
  else
  {
    $self->_add_error(
        'Server did not send a HTTP OK response: '.
        $response->status_line()."\n".
        $response->decoded_content()
      );
  }

  return $return;
}

sub _sig_child
{
  my $self=shift;
  my $msg=waitpid($self->{pid},0);
  $self->_add_error("server died unexpected") unless($self->{stop});
}

sub _start
{
  my $self=shift;
  my $port=shift || 5678;
  my $wait=shift || 5;

  unless($self->{ua})
  { $self->{ua}=LWP::UserAgent->new(); }
  $self->{ua}->timeout( $wait );

  $self->{host}='http://localhost:'.$port.'/'.$self->{name};

  unless($self->{pid})
  {
    $self->{stop}=0;
    $self->{pid}=0;
    $self->{ipc}=undef;
    local $SIG{CHLD}=sub{ $self->_sig_child(@_); };

    # XML-IPC Client initialisieren
    my $req = HTTP::Request->new('POST', $self->{host} );
    $req->content_type('text/xml');

    # läuft möglicherweise schon ein Service?
    # wenn ja, keinen eigenen starten.
    $req->content( Protocol::XMLRPC::MethodCall->new('name' => $self->{name}.'.Running')->to_string() );
    $req->content_length( length($req->content()) );
    my $resp = $self->{ua}->request($req);
    if($resp->is_error())
    {
      if($resp->code()==500)
      {
        #Service starten
        my $cs_pid=fork();
        if(defined($cs_pid))
        {
          if($cs_pid)
          {
            $self->{pid}=$cs_pid;
            # warten dass der Server hochkommt.
            sleep($wait);
          }
          # im Kindprozess C# Programm starten
          # da müsste man noch etwas machen wenn man auch
          # den MS-Interpreter nutzen möchte
          # zudem ist das alles auf linux/Unix abgestimmt
          # (siehe Pfadangabe)
          else
          {
            # programm starten
            exec("/usr/bin/mono $FindBin::Bin/mono/xml_rpc_deamon.exe -d -s localhost -p $port");
            # wenn man hier ankommt lief was verkehrt!
            exit(10);
          }
        }
        # fork hat nicht geklappt!
        {
          $self->_add_error("Fork failed");
         return 0;
        }
      }
    }
    return 1;
  }
}

sub _stop
{
  my $self=shift;
  if($self->{pid})
  {
    $self->{stop}=1;
    my $pid=$self->{pid};
    local $SIG{CHLD}='DEFAULT';
    # zu beenden auffordern
    kill('KILL',$pid) if(waitpid($pid, WNOHANG)>-1);

    # maximal 20 Sekunden warten.
    eval{
      local $SIG{ALRM}={die("timeout1\n")};
      alarm(20);
      waitpid($pid,0);
      alarm(0);
    };

    # 20 Sekunden gewartet ohne dass der Prozess beendet wurde
    if($@ && waitpid(-1, WNOHANG)>-1)
    {

      # Abwürgen
      kill('TERM',$pid) if(waitpid($pid, WNOHANG)>-1);

      # und 2 Sekunden warten
      eval{
        local $SIG{ALRM}={die("timeout2\n")};
        alarm(5);
        waitpid($pid,0);
        alarm(0);
      };

      # Prozess hängt ganz übel
      # Deadlock ??
      if($@ && waitpid(-1, WNOHANG)>-1)
      {
        $SIG{CHLD}='IGNORE';
        die("Can't kill $pid!\n");
      }
    }
  }
}

sub DESTROY
{ _stop(@_); }
1;}