scripts/Perl JSON Server Client/MCast Receiver/mcastrcv_sequences.pl

#!/bin/perl
use strict "vars";
#use strict "refs";
use strict "subs";


use threads;
#use threads::shared;
use Time::HiRes qw /usleep/;

use IO::Socket::Multicast;

my @a10; my @a11; my @a12; my @a13; my @a14; my @a15; my @a16; my @a17; my @a18; my @a19;
my @a20; my @a21; my @a22; my @a23; my @a24; my @a25; my @a26; my @a27; my @a28; my @a29;
my @a30; my @a31; my @a32; my @a33; my @a34; my @a35; my @a36; my @a37; my @a38; my @a39;

@a10=("hallo","blöder","text");

my @arrays = qw /a10 a11 a12 a13 a14 a15 a16 a17 a18 a19 a20 a21 a22 a23 a24 a25 a26 a27 a28 a29 a30 a31 a32 a33 a34 a35 a36 a37 a38 a39/;

my %mcasts :shared;
my %mcdata :shared;
my %mcopen :shared;

my $TimeOut = 20;
my $starttime;

my %LASTV :shared;
my %MISS :shared;

# Konfigdatei einlesen
open CONF, "<config.txt";
my @config=<CONF>;
close CONF;
   
foreach (@config) {
   chomp;
   next if ($_ =~ /^#/);
   next if (length($_)==0);
   $mcasts{$_}='';
}
   
# Threads für die einzelnen Multicastgruppen anstarten
my $i=0;
my @aref;
my $thr2 = threads->new(\&Write_Gaps);

foreach (keys %mcasts) {
   my $arr=$arrays[$i];
   $aref[$i]=\@$arr;
   my $thr1 = threads->new(\&WaitForMessage,$_,$aref[$i]);   
   $i++;
}

# Startzeit, lesbar
my $t=localtime;
   
$starttime = time;

while (1) {
   sleep 1;
}

sub WaitForMessage {
   my ($IPPORT,$ARR)=@_;
   my ($SESSION, $IP, $PORT) = split/:/,$IPPORT;
   #print "Öffne $IP $PORT\n"; <STDIN>;
   my $sock;
   my @ta=@{$ARR};
   
   $mcopen{$IPPORT}=0;
   while (!$sock) {
     $sock = IO::Socket::Multicast->new(LocalPort=>$PORT,ReuseAddr=>1);
     Time::HiRes::sleep(0.1);
   }
   $sock->mcast_add($IP);
   $mcopen{$IPPORT}=1;
   my $data;
   while (1) {
      #print ".\n";
      $sock->recv($data,4096);

      #print "$data\n";
      my @a=split//,$data;
      
      my $b=$a[10];
      my $c=$a[11];
      
      $b=unpack("Cn",$b);
      $c=unpack("Cn",$c);
      
      my $d=($b<<16)+$c;
      
      ###print "$IPPORT $d\n";
      if (MissedValue($d,$IPPORT)) {
         DelFromMissing($d,$IPPORT);
      }
      else {
         if (ExistPrevSeqNr($d,$IPPORT)) {
            if (LastSeqNrGreaterThanLast($d,$IPPORT)) {
               if (MissingSeqNumbers($d,$IPPORT)) {
                  my @missed=MissedSeqNumbers($d,$IPPORT);
                  PushMissedSeqNr($IPPORT,@missed);
               }
               else {
                  RemLastSeqNr($d,$IPPORT);
               }
            }
         }
         else {
            RemLastSeqNr($d,$IPPORT);
         }
      }
      #sleep 1;
   }
}

sub MissedValue {
   my ($d,$s)=@_;
   #print "MV\n";
   foreach (@{$MISS{$s}}) {
      if ( $_ == $d ) {
         return 1;
      }
   }
   return 0;
}

sub ExistPrevSeqNr {
   my ($d,$s)=@_;
   #print "EPSN\n";
   if ( $LASTV{$s} >= 0 ) {
      return 1;
   }
   return 0;
}

sub LastSeqNrGreaterThanLast {
   my ($d,$s)=@_;
   #print "LSNGTL\n";
   if ( $d > $LASTV{$s} ) {
      return 1;
   }
   return 0;
}

sub MissingSeqNumbers {
   my ($d,$s)=@_;
   #print "MSQ\n";
   if ( $d > $LASTV{$s}+1 ) {
      return 1;
   }
   return 0;
}

sub MissedSeqNumbers {
   my ($d,$s)=@_;
   #print "MDSQ\n";
   my @missing;
   print "H\n";
   if ($LASTV{$s} > 0) {
      foreach ($i=$LASTV{$s};$i<$d;$i++) {
         push @missing, $i;
         #print "$i\n";
      }
   }
   print "MA- @missing -MA\n";
   return @missing;
}

sub PushMissedSeqNr {
   my ($s,@d)=@_;
   #print "PSQ\n";
   push @{$MISS{$s}}, @d;
}

sub RemLastSeqNr {
   my ($d,$s)=@_;
   #print "RMSN\n";
   $LASTV{$s} = $d;
}

sub DelFromMissing {
   my ($d,$s)=@_;
   #print "DFM\n";
   my $i=0;
   foreach (@{$MISS{$s}}) {
      if ($d == $_) {
         delete $MISS{$s}[$i];
      }
      $i++;
   }
}

sub Write_Gaps {
   while (1) {
      #print "GAPS 1\n";
      foreach (keys %MISS) {
         print "$_\n";
         foreach (@{$MISS{$_}}) {
            print "$_ ";
         }
         print "\n\n";
      }
      sleep (5);
      #print "GAPS 2\n";
   }
}