351 lines
12 KiB
Perl
351 lines
12 KiB
Perl
#!/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;
|
|
}
|