in reply to Re: endless loops for server and tk
in thread endless loops for server and tk

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: $!";

[download]
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 ##############

[download]
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

[download]
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 #################        
############################################################

[download]
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
######################################

[download]
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.

Replies are listed 'Best First'.
Re^3: endless loops for server and tk
by BrowserUk (Patriarch) on Aug 10, 2007 at 13:24 UTC

    Okay. Here are three separate minimal programs, and one composite that joins them all together. I have used your Tk program, cleaned up a lot. Sorry that your comments are missing, but I don't read Gernman and they were just in the way of seeing what was going on. You should really try to be a little more consistant with your code layout also.

    This is the standalone server that listens and responds to 5 different udp ports:

    <Reveal this spoiler or all spoilers in this node or all in this thread>

    And this is the standalone client. It talks to all of the ports on the server for testing and demo, but would normally only talk to one. When used as the heartbeat thread withing the combined app, it would also talk to all 5 clients.

    <Reveal this spoiler>

    And here is my cleaned up and working version of your Tk code. I am posting it separately because you should maintain all 3 standalone apps as testbeds and reference points, as well as the combined app. It is much easier to test changes in the individual apps and, once you are satisfied they are working, c&p the changes into the combined app. It make seem extra work, but think of the separate apps and testcases.

    <Reveal this spoiler>

    And finally, the combined, threaded app. The modifications are minimal. Each thread is a direct C&P from the standalone version.

    In particular, there is very little shared data, as it is not clear what else you want to do or what else you need to share, but it should give you a starting point. My purpose is to demonstrate the simplicity of combining the code.

    After that, you are responsible for adding whatever extras you need. I'm willing to help you make your additions, but please don't post reams and reams of code with huge chunks commented out and reams and reams of comments that I cannot understand--just delete them from the post--otherwise I am apt to be put off.

    <Reveal this spoiler>

    To answer your question from Re^2: Displaying text in columns, I've used spoiler tags, rather than readmore tags, despite this usage being frowned upon, because spoiler tags do not get expanded until you choose to click on them whereas readmore tags are expanded whenever you view the post directly. This way, you can read the text of the post as a coherent whole without having to scroll past loads of code.

    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom