Hello, I'll post some code that I have at the moment.
The server accepting requests and responding immediately to the clients is here
#!/usr/local/bin/perl -w # UDP Server gets mysql_data from mysql or a file # receives request from client # compares request with mysql_data # responds to client # use strict; use DBI; use Cwd; use IO::Socket; # # Zuweisung der benötigten Directories für das Laden # ### Pfade intitialisieren my $aktuellesdir = getcwd; my $dirprefix = "$aktuellesdir/"; my $fehler_datei = "$dirprefix"."serv.log"; # Logdatei; =pod ## Database fields my $l_id; my $l_ipadress; my $l_spindle; my $l_vin; my $l_requestset; my $l_setok; my $l_requesttime; my $l_donetime; =cut ## Hilfsvariable my $line; ## Zeit (my $sec, my $min, my $std, my $tag, my $mon, my $jahr) = localtime(ti +me()); $mon = $mon + 1; $jahr = $jahr+1900; my $heute = "$tag.$mon.$jahr $std:$min" ; print "Heute: $heute\n"; print "Fehler_datei: $fehler_datei\n"; =pod ## open logfile open (FH_ERROR, ">>$fehler_datei" ) or die "Unable to open datei $fehl +er_datei: $!"; print "Now connecting to a mysql database mysql ...\n"; # host=192.168.178.22 # host=DELL my $dbmy = DBI->connect("DBI:mysql:ftc;host=192.168.178.22","root","ro +ot") or die "Can't connect to mySQL : $DBI::errstr\n"; print "Locken der Tabellen in MYSQL...\n"; print "Now preparing SQL Select statement for prod_vinrequests...\n"; my $sql_select = qq {SELECT ID, IPAdress, Spindle, VIN, RequestSet, Se +tOK, RequestTime, DoneTime FROM ftc.prod_vinrequests} +; my $stmy = $dbmy->prepare ($sql_select); ### csv Datei open (MYCSV, ">prodvin.txt") or die "Kann Datei nicht oeffnen $!\n"; print "Now executing SQL Select statement for prod_vinrequests...\n"; $stmy->execute(); while ( ( $l_id, $l_ipadress, $l_spindle, $l_vin, $l_requestset, $l_se +tok, $l_requesttime, $l_donetime ) = $stmy->fetchrow_array() ) { #print "l_id: $l_id | l_ipadress: $l_ipadress | l_spindle: $ +l_spindle | l_vin: $l_vin | l_requestset: $l_requestset | l_setok: + $l_setok | l_requesttime: l_requesttime | l_donetime: l_donetime \ +n"; #print "$l_id :: $l_ipadress :: $l_spindle :: $l_vin :: $l_re +questset :: $l_setok :: l_requesttime :: l_donetime \n"; $line = $l_id .",". $l_ipadress .",". $l_spindle .",". $l_vin ."," +. $l_requestset .",". $l_setok; print "line::: $line \n"; print MYCSV ""; ## zum leeren print MYCSV $line ."\n"; } ## while #$dbmy->do("UNLOCK TABLES"); print "Now disconnecting from the mysql database mysql...\n"; $dbmy->disconnect or warn "Disconnect failure from mysql $DBI::errs +tr\n"; close(MYCSV); close(FH_ERROR); =cut ######### Server section ######### use Socket qw(:DEFAULT :crlf); $/ = CRLF; #use constant DEFAULT_HOST =>'localhost'; #use constant DEFAULT_HOST =>'192.169.212.50'; use constant DEFAULT_PORT =>'4712'; use constant MAX_MSG_LEN => 100; #my $line; ## Hilfsvariable fuer line my $quellfile = "$dirprefix"."empfangsfile.txt"; my $EMPFANG; #open (RECVFILE, ">>$quellfile") or die "Kann Datei $quellfile nicht o +effnen $!\n"; ### UDP Variablen initialisieren my ($sock, $PORTNO, $MAXLEN, $nachricht); $PORTNO = shift ||DEFAULT_PORT ; #$PORTNO = 0; $MAXLEN = 1024; my $laenge; my $startzeit; $sock = IO::Socket::INET->new ( LocalPort=>$PORTNO, Proto=>'udp') or die "socket: $@"; print "Warte auf UDP Nachricht auf Port $PORTNO$/"; while ($sock->recv($nachricht, $MAXLEN)) { $laenge = length($nachricht); $startzeit = scalar localtime; print "Zeitstempel: $startzeit : Laenge: $laenge : Der Client sagt +e ''$nachricht''$/"; # $sock->send("Du sagtest: ''$nachricht'' zu mir $/"); # $sock->send("Zeitstempel: $startzeit : Du sagtest: ''$nachricht'' + zu mir $/"); $sock->send("Zeitstempel: ''$startzeit'' : Du sagtest: ''$nachricht' +' zu mir $/"); open (RECVFILE, ">>$quellfile") or die "Kann Datei $quellfile nich +t oeffnen $!\n"; print RECVFILE $nachricht; close(RECVFILE); } die "recv: $!";
Normally the server reads from a mysql table and compares the request content to the table content, and updates eventually the mysql table.
This is at the moment comment.
The code for the client sending request after n seconds is here
#!/usr/bin/perl use strict; use Tie::File; use IO::Socket; use Socket qw(:DEFAULT :crlf); $/ = CRLF; #use constant DEFAULT_HOST =>'localhost'; #use constant DEFAULT_HOST =>'192.169.212.50'; use constant DEFAULT_HOST =>'192.168.178.23'; use constant DEFAULT_PORT =>'4712'; use constant MAX_MSG_LEN => 100; use constant TIMEOUT => 2; my $host = shift ||DEFAULT_HOST; my $port = shift ||DEFAULT_PORT; my $counter=0; my @array_file; my $protocol = getprotobyname('udp'); $port = getservbyname($port, 'udp') unless $port =~ /^\d+$/; my $data; my $sendung; #my $startzeit = scalar localtime; my $startzeit; my $timeout = 0; my $hilfe = 0; #Variante 1 #socket(SOCK, AF_INET, SOCK_DGRAM, $protocol) or die "socket() geschei +tert: $!"; #my $dest_addr = sockaddr_in($port, inet_aton($host)); #Variante 2 my $sock = IO::Socket::INET->new(Proto=>$protocol, PeerAddr=>"$host:$p +ort") or die $@; ## Sende-Empfangsschleife ########## while(1) { fill_with_tie(); ## Sendedaten aus Datei lesen print "Laenge sendung: length($sendung) \n\n"; if ( length($sendung) == 0 ) { $sendung = 'init'; } # if print "sendung: $sendung\n\n"; #Variante 1 #send(SOCK, $sendung, 0, $dest_addr) or die "send() gescheitert: $!\n" +; #Variante 2 $sock->send($sendung) or die "sendung gescheitert: $!\n"; #=pod $startzeit = scalar time(); print "start: $startzeit \n"; $hilfe = $startzeit +3 ; print "hilfe: $hilfe \n"; $timeout = scalar time(); unless ( $hilfe < $timeout ) { #sleep(4); print "in Schleife \n\n"; $timeout = scalar time(); print "timeout:: $timeout \n"; $sock->recv($data, MAX_MSG_LEN) or die "empfang gescheitert $!\n"; # recv(SOCK, $data, MAX_MSG_LEN, 0) or die "receive() gescheitert $ +!"; } #=cut =pod eval { local $SIG{ALRM} = sub { die "Timeout\n" }; alarm(TIMEOUT); $sock->recv($data, MAX_MSG_LEN) or die "empfang gescheitert $!\n"; alarm(0); }; if ($@) { die $@ unless $@ eq "Timeout\n"; warn "Timeout !!\n"; } # if =cut fill_empfang_file($data); ## Empfang in Datei schreiben chomp($data); print "Empfangen: $data \n"; sleep(3); } # while #Variante 2 $sock->close; sub fill_with_tie { my $file = "meinfile.txt"; #my $file="empfangsfile.txt"; my $line; my $elem; my $stempel = scalar localtime; $sendung =''; if ( -e $file ) { tie @array_file, "Tie::File", $file || die $!; foreach $elem (@array_file) { chomp $elem; $sendung= $sendung ."$elem"; #$liste->insert("end",$elem); } ## foreach untie @array_file; $sendung = $stempel . " :::: \n" . $sendung; } else { print "Kann $file nicht oeffnen $!$/"; } ## if -s $file } ## fill_with_tie ################# sub fill_empfang_file { #my $file = "meinfile.txt"; my $file="empfangsfile.txt"; my $line = @_[0]; my $elem; print "Operator: $line \n"; open (EMPFANG, ">>$file") or die "Kann $file nicht oeffnen $!\n"; print EMPFANG "$line\n"; close(FILE); } ## fill_empfang_file ##############
In the client I tried to let him receive the server-response with a timeout, but I did not succeed. Maybe some hints ? The client should continue to send every n seconds a request even if there is no server listening.
By the way, when using the client on a xp machine it stops at the first time he receives (server is listening) when the server includes $startzeit in his response.
If the client runs on ubuntu (vmware guest system) he receives the whole response if the response does not include $startzeit, but with the server code $sock->send("Zeitstempel: $startzeit : Du sagtest: ''$nachricht'' zu mir $/"); or   $sock->send("Zeitstempel: ''$startzeit'' : Du sagtest: ''$nachricht'' zu mir $/"); the client receives not the whole response or at least prints not the whole response to STDOUT. What could be here the problem ?

Here is the actual contents of meinfile.txt which corresponds to the request:

Hallo kleine Welten Hallo grosse Welt sososos es geht loser neue Zeilenn naechste Nummernn
A first Tk code is here:
#!/usr/bin/perl use Tk; use Tie::File; use Tk::after; my $liste; my $liste_font; my $breite=100; ### Anzahl der abgezeigten Zeichen in der Liste my $the_selectmode = "extended"; ### "single","multiple","extended" my $enter; my @array_file; my $mw = MainWindow->new(); ### rahmen fuer Hauptseite my $frame1 = $mw->Frame(-width=>50, -height=>50, -bg=>"seashell"); my $frame2 = $mw->Frame(-width=>5, -height=>5, -bg=>"grey80"); $liste_font = $mw->fontCreate(-family=>"courier", -size=>7 ); +### zB treffer-Liste my $liste = $frame1->ScrlListbox( ##-font=>$liste_font, -setgrid=>1, -scrollbars=>"se", #-background=>"wheat3", -background=>"lemonchiffon3", -borderwidth=>3, -highlightthickness=>10, ##-selectmode => "extended", ###"multiple" ##-selectmode => "multiple", ##-selectmode => "single", ## -selectmode =>$the_selectmode, -height => 30, ## -width => $breite, -selectforeground=>"blue", -selectbackground=>"green", ##-setgrid=>1, ##-selectborderwidth=>1, -relief=>"ridge", -exportselection => 1)->pack(-side=>"right", -expand=> +1, -fill=>"both"); my $exitButton = $frame2->Button ( -text=>"Schliessen" ,-command=> +"exit" ,-bg=>"red" ,-activebackground=>"red" ,-activeforeground=>"cya +n" )->pack(-anchor=>"w" ,-padx=>10 ,-pady=>15 ,-ipady=>10 ,-fill=>" +x"); ################################################################## ### Packen der Rahmen auf Hauptseite ############################ ################################################################## $frame1->pack(-side => 'left' ,-expand=>1 ,-fill=>"both"); $frame2->pack(-side => 'right',-expand=>1 ); $frame2->pack(-expand=>1 ,-fill=>"both"); ############################################## ### sofort ausgefuehrte Subroutines ############################################## =pod while(1) { #&fill_from_file(); sleep(2); }; =cut #&fill_from_file(); #&fill_with_tie(); $mw->repeat(10, \&fill_with_tie ); ############################################## ### Ende sofort ausgefuehrte Subroutines ############################################## MainLoop; ###################################################### sub fill_from_file { my $file = "meinfile.txt"; my $line; $liste->delete(0,"end"); if ( -s $file ) { open(DATEI, "<$file") or die $!; while ($line = <DATEI>) { chomp $line; $liste->insert(0,$line); } close(DATEI); } ## if -s $file } ## fill_from_file ################# ############################################################ ###################################################### sub fill_with_tie { my $file = "meinfile.txt"; my $line; my $elem; $liste->delete(0,"end"); if ( -e $file ) { tie @array_file, "Tie::File", $file || die $!; foreach $elem (@array_file) { chomp $elem; $liste->insert(0,$elem); } ## foreach untie @array_file; } else { print "Kann $file nicht oeffnen $!\n"; } ## if -s $file } ## fill_with_tie ################# ############################################################
If I edit the contents of the meinfile.txt in an editor, the changes are displayed immediately in the listbox.
The listbox should later display the data of the mysql table which should be updated depending on the clients requests.

vkon, I tried to implement the Tk code with fileevent, but I did not succeed. Here is my code:

#!/usr/bin/perl use Tk; use Tie::File; use Tk::after; my $liste; my $liste_font; my $breite=100; ### Anzahl der abgezeigten Zeichen in der Liste my $the_selectmode = "extended"; ### "single","multiple","extended" my $enter; my @array_file; my $filename="meinfile.txt"; open (FH, "<$filename" ) || die "Kann $filename nicht oeffnen $! \n"; my $mw = MainWindow->new(); ### rahmen fuer Hauptseite my $frame1 = $mw->Frame(-width=>50, -height=>50, -bg=>"seashell"); my $frame2 = $mw->Frame(-width=>5, -height=>5, -bg=>"grey80"); $liste_font = $mw->fontCreate(-family=>"courier", -size=>7 ); +### zB treffer-Liste my $liste = $frame1->ScrlListbox( ##-font=>$liste_font, -setgrid=>1, -scrollbars=>"se", #-background=>"wheat3", -background=>"lemonchiffon3", -borderwidth=>3, -highlightthickness=>10, ##-selectmode => "extended", ###"multiple" ##-selectmode => "multiple", ##-selectmode => "single", ## -selectmode =>$the_selectmode, -height => 30, ## -width => $breite, -selectforeground=>"blue", -selectbackground=>"green", ##-setgrid=>1, ##-selectborderwidth=>1, -relief=>"ridge", -exportselection => 1)->pack(-side=>"right", -expand=> +1, -fill=>"both"); my $exitButton = $frame2->Button ( -text=>"Schliessen" ,-command=> +"exit" ,-bg=>"red" ,-activebackground=>"red" ,-activeforeground=>"cya +n" )->pack(-anchor=>"w" ,-padx=>10 ,-pady=>15 ,-ipady=>10 ,-fill=>" +x"); ################################################################## ### Packen der Rahmen auf Hauptseite ############################ ################################################################## $frame1->pack(-side => 'left' ,-expand=>1 ,-fill=>"both"); $frame2->pack(-side => 'right',-expand=>1 ); $frame2->pack(-expand=>1 ,-fill=>"both"); ############################################## ### sofort ausgefuehrte Subroutines ############################################## ############################################## ### Ende sofort ausgefuehrte Subroutines ############################################## $mw->fileevent(FH, 'readable', [\&refresh_list] ); #$mw->fileevent(FH, readable=>\&refresh_list ); $mw->MainLoop; ###################################### sub refresh_list { my $line; $liste->delete(0,"end"); if ( $line = <FH> ) { chomp $line; $liste->insert(0,$line); } else { $mw->fileevent (FH, 'readable', ""); } ## if } ## refresh_list ######################################
BrowserUk, the client code could be used as the server "just sending every 5 seconds".
By the way, how could this be implemented,that the server listens to all UDP ports, not only to a specific. Later there are e.g. 5 clients, each sending on his on port (e.g. from 10001 to 10005) and the server should listen to all of these ports simultaneously, thats why I thought of listening to all UDP ports.

In reply to Re^2: endless loops for server and tk by hudo
in thread endless loops for server and tk by hudo

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.