This commit is contained in:
2024-10-14 00:08:40 +02:00
parent dbfba56f66
commit 1462d52e13
4572 changed files with 2658864 additions and 0 deletions

View File

@@ -0,0 +1,350 @@
#!/usr/bin/perl
# benutze Threads
use Thread;
# benutze Multicast
use IO::Socket::Multicast;
# TK zur Fensterdarstellung verwenden
use Tk;
use Tk::MsgBox;
# wav Dateien abspielen ist auch toll
#use Win32::MediaPlayer;
# für JSON Objekt in die alle vom server gesendeten Nachrichten gekapselt sind.
use JSON::XS;
# Saubere Programmierung erzwingen
use strict;
# Alle Nachrichten vom Server
my @messages :shared;
# Flag das neue Nachricht erhalten wurde
my $new_message :shared;
# Flag ob Alarmierung stattfinden soll
my $AlarmAn :shared;
# Thread ID des Multicast Listener
my $thr;
# Die letzte, also aktuellste Nachricht
my $pub_lastmessage :shared;
#my $pub_timerlastmessage :shared;
# Nachricht die übermittelt wird (aus Eingabezeile des Fensters) wird in dieser Variable hinterlegt
my $eingegeben :shared;
# Nachricht die von diesem Client zuletzt gesendet wurde
my $zuletztgesendet :shared;
$zuletztgesendet="initiale Nachricht um zuverhindern das \$zuletztgesendet in \$pub_lastmessage gematcht werden kann und auch die erst nachricht per alarm bekannt gegeben wird";
# Zähler der Timeraufrufe zählt um festzustellen wie viele Umläufe keine MCast mehr empfangen wurde
# wird vom Empfangs-Thread wieder zurückgesetzt
my $unterbrechung :shared;
# Handle des Timerobjekts
my $timer_id;
# Multicast IP Adresse, wird per Parameter übergeben
my $MCASTIP :shared;
# Port des Multicast Stroms, wird als Parameter übergeben
my $MCASTPORT :shared;
# IP Adresse des Senders, wird aus STARTOFMESSAGES extrahiert
my $TCPIP :shared;
# Port auf den Sender hört um neue Nachrichten anzunehmen, wird aus STARTOFMESSAGES extrahiert
my $TCPPORT :shared;
# Alarmierung wird per Default auf 'ein' gesetzt
$AlarmAn = 1;
# Wenn Parameter 0, der erste, keinen Inhalt hat wurde Client ohne Parameter gestartet
if ($ARGV[0] eq "") {
# Fehlermeldung und Programmende
wrong_start();
}
# Versuch aus dem ersten übergebenen Parameter die Multicast Adresse und den zugehörigen Port zu extrahieren
($MCASTIP,$MCASTPORT) = split(/:/, $ARGV[0]);
# Weitere Parameter werden ignoriert
# Wenn Parameterformat nicht korrekt bleibt IP oder Port leer
if ($MCASTIP eq "" or $MCASTPORT eq "") {
# Fehlermeldung und Programmende
wrong_start();
}
# Neues Fensterobjekt erzeugen
my $main = new MainWindow(-title=>'Möp Tool');
# Frameobjekt im Fensterobjekt mit verschiedenen Eigenschaften wird erzeugt
# nimmt später Statuslabel, LetzteNachrichtLabel und Eingabezeile auf
my $top_f=$main->Frame(-width=>500, -height=>200)->pack(-side=>'top', -padx=>5, -pady=>5);
# Ein weiteres Frameobjekt, das die Schaltflächen aufnimmt
my $bottom_f=$main->Frame()->pack(-side=>'top', -padx=>5, -pady=>5);
# Configure Event des Fensters wird abgefangen und ein resize verhindert
$main->bind('<Configure>' => sub {
my $xe = $main->XEvent;
$main->maxsize($xe->w, $xe->h);
$main->minsize($xe->w, $xe->h);
});
# Labelobjekte im oberen Frame erzeugen
my $status_label = $top_f->Label(-text => 'Alarm an');
my $news_label = $top_f->Label(-text => '');
# Eingabeobjekt erzeugen und Variable $eingegeben wird referenziert, dadurch landen alle Eingaben in dieser globalen Variable
my $eingabe = $top_f->Entry(-width=>150, -textvariable => \$eingegeben);
# Die Schaltflächen Senden,AlarmAnAus, Nachrcíchten werden erzeugt
my $left1=$bottom_f->Frame()->pack(-side=>'left', -fill=>'none');
my $left2=$bottom_f->Frame()->pack(-side=>'left', -fill=>'none');
my $left3=$bottom_f->Frame()->pack(-side=>'left', -fill=>'none');
# Standardaktion bei <Return> wird definiert, selbe Aktion wie bei Betätigung der Senden Schaltfläche (Aufruf sub senden_click)
$eingabe->bind('<Return>', \&senden_click );
# Senden Knopf wird definiert, Beschriftung und Aktion (Aufruf sub senden_click)
my $send_button = $left1->Button(
'-text' => 'Senden',
'-command' => \&senden_click,
);
# Alarm An/Aus Knopf definiert, Beschriftung und Aktion (Aufruf sub start_click)
my $startstop_button = $left2->Button(
'-text' => 'Alarm an/aus',
'-command' => \&start_click,
);
# Nachrichten Knopf definiert, Beschriftung und Aktion (Popup mit den letzten Nachrichten)
my $news_button = $left3->Button(
'-text' => 'Nachrichten',
'-command' => sub {
# Alle Nachrichten zu einem Array zusammensetzen und an jede Nachricht ein \n anhängen
# Darstellung der Arrayelemente in der Messagebox damit untereinander
my @msg=join ("\n", @messages);
# Messagebox definieren
my $db=$main->messageBox(-title=>'Nachrichten', -message=>"@msg", -type=>'ok');
# und anzeigen
$db->show;
},
);
# Statuslabel wird angezeigt und nach Westen 'w' ausgerichtet, also links
$status_label->pack(-anchor => 'w');
# Letzte Nachricht Label wird angezeigt und nach Westen 'w' ausgerichtet, also links
$news_label->pack(-anchor => 'w');
# Eingabefeld wird angezeigt und nach Westen 'w' ausgerichtet, also links
#$eingabe->pack(-side => 'left');
$eingabe->pack(-anchor => 'w');
# Knöpfe werden angezeigt
$send_button->pack;
$startstop_button->pack;
$news_button->pack;
# Multicast Empfangs Thread wird gestartet
$thr = new Thread \&WaitForMessage;
# Timer wird angestartet, alle 100 ms, Funktionsaufruf
$timer_id = $main->repeat(100, \&timer);
# MainLoop des TK
MainLoop;
# Timerfunktion wird alle 100ms aufgerufen
sub timer {
# Zähler, kein MCast empfangen, wird im Mcast Empfangsthread zurückgesetzt falls doch Mcast kommt
$unterbrechung++;
# Zeigt die letzte, aktuellste Nachricht an, pub_message wird vom Mcast thread gesetzt
$news_label->configure(-text=>"$pub_lastmessage");
# wenn Alamierung erfolgen soll
if ($AlarmAn==1) {
# UND eine neue Nachricht erhalten wurde
if ($new_message == 1) {
# Neue Nachricht Flag zurücksetzen, damit Alarmierung nur ein mal erfolgt
$new_message=0;
# UND wenn die letzte Nachricht NICHT vom eigenen Client kam
unless ($pub_lastmessage =~ /$zuletztgesendet/) {
#my $winmm = new Win32::MediaPlayer; # new object
#$winmm->load('alarm.mp3'); # Load music file
#$winmm->play; # Play the music
# und Popup mit Inhalt der letzten Nachricht anzeigen
my $db=$main->MsgBox(-title=>"Neue Nachricht", -message=>"$pub_lastmessage", -type=>"ok");
$db->Show;
}
}
}
# Wenn 20 Durchläufe kein MCast empfangen wurde
if ($unterbrechung >= 20) {
# ... Senderinfos zurücksetzen, damit kann keine neue Nachricht vom Client abgesetzt werden
$TCPIP="";
$TCPPORT="";
}
# Status Label Text neu zusammen bauen
my $statustext="";
# Nachricht beginnt mit 'Alarm an', 'Alarm aus' je nach gesetztem Flag
if ($AlarmAn==0) {
$statustext = "Alarm aus";
}
else {
$statustext = "Alarm an";
}
# Nachricht geht weiter mit Informationen zum Sender
if ($TCPIP eq "") {
$statustext .= " - Server unbekannt";
}
else {
$statustext .= " - Server $TCPIP:$TCPPORT";
}
# Nachricht Label setzen
$status_label->configure(-text => $statustext);
}
# wird aufgerufen wenn Nachricht gesendet werden soll
sub senden_click {
# Wenn Text nicht leer ist
if ($eingegeben ne "") {
# UND Sender IP nicht unbekannt ist
if ($TCPIP ne "") {
# socket öffnen
my $tcpsock = IO::Socket::INET->new(PeerAddr => "$TCPIP",
PeerPort => $TCPPORT,
Proto => "tcp",
Type => SOCK_STREAM)
or die "Couldn't connect to $TCPIP : $TCPPORT $@\n";
# Nachricht zusammen bauen und formatieren
#my $zusenden = $eingegeben =~ /(.{50})/;
my $zusenden = $eingegeben;
# Nachricht auf 120 Zeichen Länge begrenzen und mit Umgebungsvariable 'USERNAME' ergänzen
my $selbst_gesendet = sprintf "%-.140s", $eingegeben;
$zusenden = sprintf "%-.140s (%s)",$eingegeben,$ENV{USERNAME};
# Nachricht auf socket senden
print $tcpsock "$zusenden";
# socket wieder schließen
close ($tcpsock);
# Eigene zuletzt gesendete Nachricht speichern
$zuletztgesendet=$selbst_gesendet;
# Eingabezeile leeren
$eingegeben="";
}
}
}
# Wird aufgerufen bei Betätigung der Schaltfläche 'Alarm An/Aus'
# Wechselt zwischen Status 'Alarmierung an', 'Alarmierung aus'
sub start_click {
# wenn Alarmierung ausgeschaltet ist
if ($AlarmAn==0) {
# Alarmierung einschalten
$AlarmAn = 1;
}
# wenn Alarmierung eingeschaltet ist
else {
# Alarmierung ausschalten
$AlarmAn = 0;
}
}
# Wird als Thread gestartet und nimmt Multicastnachrichten an
sub WaitForMessage {
# socket eröffnen, IP und Port kommen als Übergabeparameter
my $sock = IO::Socket::Multicast->new(LocalPort=>$MCASTPORT);
$sock->mcast_add("$MCASTIP") || die "Couldn't set group: $!\n";
# Beim Anstarten des Threads wird gesetzt das noch keine Daten empfangen wurden
# oldlastmessage enthält die letzte Nachricht der vorhergehenden Durchlaufs
my $oldlastmessage="";
# lastmessage enthält die letzte Nachricht des aktuellen Durchlaufs
my $lastmessage="";
# Nimmt die aktuell empfangenen Daten auf
my $jdata;
# neues json objekt anlegen
my $JSONObject = JSON::XS->new->ascii->pretty->allow_nonref();
# enthält die gesendeten daten nach umwandlung vom json objekt zum array
my @sentdata;
# Solange Daten vom socket geholt werden können
while ($sock->recv($jdata,10000)) {
# Mcast unterbrechung zurücksetzen, Programm wird damit signalisiert das Mcast empfangen wird
$unterbrechung = 0;
# empfangen daten sind JSON objekt, also zunächt dekodieren
@sentdata = @{$JSONObject->decode($jdata)};
# erhaltene nachrichten leeren um neu zu beginnen
@messages=();
foreach my $data(@sentdata) {
chomp $data;
# Wenn die Nachricht 'STARTOFMESSAGES' enthält, handelt es sich um die erste Nachricht
if ($data =~ /STARTOFMESSAGES/) {
# aus diesen Daten werden dann IP und Port des Senders gewonnen
# Sender schickt diese Daten mit
(undef,$TCPIP,$TCPPORT) = split/#/,$data;
# Nachrichten Array leeren
}
# wenn Nachricht 'ENDOFMESSAGES' enthält wurde der letzte Datensatz empfangen
elsif ($data eq "ENDOFMESSAGES") {
}
else {
# aktuelle empfangen daten an alle nachrichten anhängen
@messages=(@messages,$data);
}
}
# die letzte empfangen nachricht wird global zur verfügung gestellt
# [-1] ist ENDOFMESAGE, [-2] also die letzte 'echte' nachricht
$pub_lastmessage=$sentdata[-2];
# wenn die letzte gerade empfangene nachricht $pub_lastmessage nicht die letzte davor erhaltene nachricht $oldlastmessage ist
# dann ist die letzte nachricht eine neue
if ($oldlastmessage ne $pub_lastmessage) {
# global bekannt geben das eine neue nachricht erhalten wurde
$new_message=1;
}
# die letzte erhalten nachricht wird zur letzt erhaltenen nachricht des neuen durchlaufs
$oldlastmessage = $sentdata[-2];
}
}
# Wird aufgerufen bei Fehlerhaftem Programmstart
sub wrong_start {
# Fehlernachricht anzeigen
print
"\n\nclient_tk MCASTIP:MPort\n\n",
" MCASTIP Multicast Adresse an die Nachrichten gesendet werden\n",
" Bsp 239.1.1.1\n\n",
" MPort Port der für die Multicast Nachrichten verwendet wird\n",
" Bsp 64000\n\n",
" Beispielaufruf\n",
" client_tk 239.1.1.1:64000\n\n",
" Falsche IPs und/oder Ports werden nicht! abgefangen\n\n";
# Programm beenden
exit;
}