polling TCP server on Win32 (with Tk)

Discussion in 'Perl Misc' started by JohnD, Mar 22, 2011.

  1. JohnD

    JohnD Guest

    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);
     
    JohnD, Mar 22, 2011
    #1
    1. Advertising

  2. JohnD

    QoS Guest

    JohnD <> wrote in message-id: <4d887b62$0$9483$4all.nl>

    >
    > 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
     
    QoS, Mar 23, 2011
    #2
    1. Advertising

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. Chuck

    Help With a Polling Server

    Chuck, Aug 22, 2003, in forum: Java
    Replies:
    1
    Views:
    387
    Jos A. Horsmeier
    Aug 22, 2003
  2. Sameer
    Replies:
    0
    Views:
    500
    Sameer
    Feb 13, 2005
  3. Tiger
    Replies:
    5
    Views:
    974
    Dave Thompson
    May 1, 2006
  4. Brad Walton

    Persisten TCP Connection for Win32

    Brad Walton, Feb 27, 2004, in forum: Perl Misc
    Replies:
    0
    Views:
    81
    Brad Walton
    Feb 27, 2004
  5. Replies:
    3
    Views:
    155
    TheBagbournes
    May 7, 2006
Loading...

Share This Page