JohnD <> wrote in message-id: <4d887b62$0$9483$ >
>
> I posted this in comp.lang.perl.tk but would like to give it a try over
> here.
>
> The problem is Win32 (Unix works). I do not understand the very
> details of the differences between sockets on Unix and Windows. I just
> want working code, the socket part (server).
> If this socket part works I can get my real program working.
>
> Who can help me producing a working program on Windows?
>
> One server, one client. The client connects, sends strings (1-30 bytes)
> once every few seconds, the server processes these strings within 0.1
> seconds, and the connection remains open for an hour or so. If a fixed
> string-length would be better: fine. If UDP is much easier: please show me.
>
> My code so far (runs on Linux, freezes on Windows while processing the
> first message)
>
> #!/usr/bin/perl
> use strict;
> use warnings;
> use IO::Socket;
> use Tk;
>
> $| = 1;
> $SIG{PIPE} = 'IGNORE';
>
> my $listen = IO::Socket::INET->new(
> Proto => 'tcp',
> LocalPort => 7777,
> Listen => 1,
> Reuse => 1,
> ) or die "Can't create listen socket : $!\n";
>
> my $mw = MainWindow->new();
>
> my $text = $mw->Scrolled( 'Text', )->pack();
>
> my ($sel);
> if ( $^O eq 'MSWin32' ) {
> $mw->repeat( 50, [ \&new_connection, $listen ] );
> }
> else {
> $mw->fileevent( $listen, 'readable' => [ \&new_connection, $listen ]
> );
> }
>
> Tk::MainLoop;
>
> sub new_connection {
> my ($listen) = shift;
> my ($sel);
> my $client = $listen->accept() or warn "Can't accept connection";
> $client->autoflush(1);
> if ( $^O eq 'MSWin32' ) {
> use IO::Select;
> $sel = IO::Select->new;
> $sel->add($listen);
> $mw->repeat( 50, [ \&handle_connection, $client, $sel ] );
> }
> else {
> $mw->fileevent( $client,
> 'readable' => [ \&handle_connection, $client, $sel ] );
> }
>
> $text->insert( 'end', "Connected\t" );
> $text->see('end');
> }
>
> sub handle_connection {
> my ( $client, $sel ) = shift;
> if ( $^O eq 'MSWin32' ) {
> my (@ready) = $sel->can_read(0);
> return if $#ready == -1;
> $client = $ready[0];
> }
> my $message = <$client>;
> if ( defined $message and $message !~ /^quit/ ) {
> $message =~ s/[\r\n]+$//;
> $text->insert( 'end', "Got message [$message]\t" );
> $text->see('end');
> }
> else {
> $text->insert( 'end', "Connection Closed\n" );
> $text->see('end');
> $client->close();
> }
> }
>
>
> A client (as simple as I could maker it)
> #!/usr/bin/perl
> use IO::Socket;
>
> my $machine_addr = 'localhost';
> $sock = new IO::Socket::INET(PeerAddr=>$machine_addr,
> PeerPort=>7777,
> Proto=>'tcp',
> );
>
> die "Could not connect: $!" unless $sock;
>
> foreach my $count(1..100){
> print $sock "$count\n";
> print "$count\n";
> #select(undef,undef,undef,.1) ;
> }
>
> close ($sock);
Ok, this is an example of a threaded tk gui. Here we only print to
the console but you should be able to adapt this to suit your needs.
#!/usr/bin/perl
use strict;
use warnings;
use threads;
use threads::shared;
use Tk;
my (%shash, %threads, $mw,);
#initialize thread shared memory and gui
init();
#start gui
gui();
Tk::MainLoop();
#exit
foreach my $tId (keys %threads) {
$shash{$tId}{'die'} = 1;
sleep (1);
}
exit;
################################################## ######################
sub init #--------------------------------------------------------------
{
$mw = MainWindow->new();
#Example - one worker subroutine for one worker thread
foreach my $tId (1..1) {
foreach my $i qw(go1 progress die) {
share ($shash{$tId}{$i});
$shash{$tId}{$i} = 0;
}
$threads{$tId} = threads->new(\&worker1, $tId);
$threads{$tId}->detach();
warn "launched thread ($tId)\n";
}
return (1);
}
sub gui #---------------------------------------------------------------
{
my $c = 1;
foreach my $csv ('on,1', 'off,0') {
my ($label,$state) = split(/,/, $csv);
$mw->Button(
-text => $label,
-command => sub {$shash{1}{go1} = $state;}
)->pack();
}
return (1);
}
sub worker1 #-----------------------------------------------------------
{
my $tId = $_[0] || return (0);
local $| = 1;
warn "welcome to worker1 ($tId)\n";
workerLoop:
while (1) {
if ( $shash{$tId}{'die'} == 1) {
last;
};
if ( $shash{$tId}{'go1'} == 1 ) {
foreach my $num (1..10){
$shash{$tId}{'progress'} = $num;
warn "\tThread (".$tId.") says: ($tId->$num)\n";
if($shash{$tId}{'go1'} == 0) { last; }
if($shash{$tId}{'die'} == 1) { last workerLoop; };
sleep(1);
}
$shash{$tId}{'go01'} = 0;
}
else {
sleep(1);
}
}
warn "thread ($tId) is exiting worker1\n";
return (1);
}
################################################## ######################
hTh,
J
Similar Threads
