Gtk2 server and client GUI's with root messaging

Hi, I've yet to see a Gtk2 version of a server and client using sockets. This one uses Glib's IO::Watch to handle the connections. The most notable points I can make about these scripts, is that they should work on Windows ( Glib's IO::Watch works on Windows, as opposed to Tk's fileevent).

Also, I noticed the server responds to nohup and err conditions, but the client seems to see only an 'in' condition. This makes it possible to check for the length of the incoming data, and if 0, you can assume the server shut down. Play with it and see.

Server:

#!/usr/bin/perl
use warnings;
use strict;
use Glib qw(TRUE FALSE);
use Gtk2 -init;
use IO::Socket;

$|++;

my @clients; #used for root messaging to all

my $port = 2345;
my $server = new IO::Socket::INET(
    Timeout   => 7200,
    Proto     => "tcp",
    LocalPort => $port,
    Reuse     => 1,
    Listen    => SOMAXCONN
);

print "\n",$server,' fileno ',fileno($server),"\n";

if( ! defined $server){ 
          print "\nERROR: Can't connect to port $port on host: $!\n" ;
          exit;
  } else{ print "\nServer up and running on $port\n" }


my $con_watcher = Glib::IO->add_watch ( fileno( $server ), 
                 'in', \&new_connection, $server );

my $stdin_watcher = Glib::IO->add_watch ( fileno( 'STDIN' ), 
                 'in', \&watch_stdin, 'STDIN' );

# make entry widget larger, colored text
Gtk2::Rc->parse_string(<<__);

style "my_entry" {
  font_name ="arial 18"
  text[NORMAL] = "#FF0000"
}

style "my_text" {
font_name ="sans 18"
text[NORMAL] = "#FFAA00"
base[NORMAL] = "#000000"   
GtkTextView::cursor-color = "red"
}
style "my_cursor"{
fg[NORMAL] = "#FF0000"
}

widget "*Text*" style "my_text"
widget "*Entry*" style "my_entry"
__

my $window = Gtk2::Window->new;
$window->signal_connect( delete_event => sub { exit } );
$window->set_default_size( 700, 300 );

my $vbox = Gtk2::VBox->new;
$window->add($vbox);

my $scroller = Gtk2::ScrolledWindow->new;
$vbox->add($scroller);
my $textview = Gtk2::TextView->new;
$textview ->set_editable (0); #read-only text
$textview ->can_focus(0);     #

my $buffer = $textview->get_buffer;
$buffer->create_mark( 'end', $buffer->get_end_iter, FALSE );

$buffer->signal_connect(
    insert_text => sub {
        $textview->scroll_to_mark( $buffer->get_mark('end'), 0.0, TRUE
+, 0, 0.5 );
    }
);

$scroller->add($textview);

my $entry = Gtk2::Entry->new();
$vbox->pack_start( $entry, FALSE, FALSE, 0 );
$vbox->set_focus_child ($entry); # keeps cursor in entry
$window->set_focus_child ($entry); # keeps cursor in entry

# allows for sending each line with an enter keypress
my $send_sig = $entry->signal_connect ('key-press-event' => sub {
         my ($widget,$event)= @_;
         if( $event->keyval() == 65293){  # a return key press
                my $text = $entry->get_text;
                 root_message( $text ); 
             
             $entry->set_text('');
             $entry->set_position(0);
     }
   });

my $bexit = Gtk2::Button->new('Exit');
$bexit->signal_connect( clicked => sub{ 
                foreach my $cli (@clients){
                   $cli->close;
                   exit;
                 }
               });
$vbox->pack_start( $bexit, FALSE, FALSE, 0 );

$window->show_all;

$buffer->insert( $buffer->get_end_iter, "Server up and running on $por
+t\n" );

Gtk2->main;
exit;


sub new_connection{
    my ( $fd, $condition, $fh ) = @_;
    print  "callback start $fd, $condition, $fh\n"; 

    # this grabs the incoming connections and hands them off to
    # a client_handler
   
     my $client = $server->accept() or warn "Can't accept connection @
+_\n";
     $client->autoflush(1);
    
     $buffer->insert( $buffer->get_end_iter, "accepted a client $clien
+t\n" );
     push @clients, $client; # for root messaging

    # make a listener for this client
    my $client_listener = Glib::IO->add_watch ( fileno( $client ), 
                     ['in', 'hup', 'err'], \&handle_connection, $clien
+t );
}


sub handle_connection{
    my ( $fd, $condition, $client ) = @_;
#   print  "handle connection $fd, $condition, $client\n"; 
   
  # since 'in','hup', and 'err' are not mutually exclusive,
  # they can all come in together, so test for hup/err first

     if ( $condition >= 'hup' or $condition >= 'err' ) {
        # End Of File, Hang UP, or ERRor.  that means
        # we're finished.
        $buffer->insert( $buffer->get_end_iter, "Nohup or err received
+ from $client\n" );
        #print "\nhup or err received\n";
        #close socket
        $client->close;
        $client = undef;
   
        return 0;  #stop this callback 
      }
    
    # if the client still exists, get data and return 1 to keep callba
+ck alive
    if ($client) {
      if ( $condition >= 'in' ){
        #  data available for reading
        my $bytes = sysread($client,my $data,1024);
        if ( defined $data ) {
            # do something useful with the text.

           $buffer->insert( $buffer->get_end_iter, "$data\n" );
           print $client "$data\n";  #echo back
        }
      }

        # the file handle is still open, so return TRUE to
        # stay installed and be called again.
        # print "still connected\n";
        # possibly have a "connection alive" indicator
        #print "still alive\n";
        return 1;
    }
    else {

        # we're finished with this job.  start another one,
        # if there are any, and uninstall ourselves. 

        $buffer->insert( $buffer->get_end_iter, "client $client exitin
+g\n" );
      
        return 0;  #end this callback
    
    }

}
#end of client callback    


sub root_message {
        
        #sent to all clients 
        my $text = $_[0];
       # print "$text\n";
        
        $buffer->insert( $buffer->get_end_iter, "ROOT MESSAGE-> $text\
+n" );
            
    foreach my $cli(@clients){
             
             if($cli->connected){
                 print $cli 'ROOT MESSAGE-> ', "$text\n"; 
                }else{
                  # remove dead client
                  @clients = grep { $_ ne $cli } @clients;            
+       
                }       
       }
    
    #always return TRUE to continue the callback
    return 1;
}

__END__
[download]

The client:

#!/usr/bin/perl
use warnings;
use strict;
use Glib qw(TRUE FALSE);
use Gtk2 -init;
use IO::Socket;

my $name = shift || 'anon'.time;
my $host = 'localhost';
my $port = 2345;
my $socket;

# make entry widget larger, colored text
Gtk2::Rc->parse_string(<<__);

style "my_entry" {
  font_name ="arial 18"
  text[NORMAL] = "#FF0000"
}

style "my_text" {
font_name ="sans 18"
text[NORMAL] = "#FFAA00"
base[NORMAL] = "#000000"   
GtkTextView::cursor-color = "red"
}
style "my_cursor"{
fg[NORMAL] = "#FF0000"
}

widget "*Text*" style "my_text"
widget "*Entry*" style "my_entry"
__

my $window = Gtk2::Window->new;
$window->signal_connect( delete_event => sub { exit } );
$window->set_default_size( 500, 300 );

my $vbox = Gtk2::VBox->new;
$window->add($vbox);

my $scroller = Gtk2::ScrolledWindow->new;
$vbox->add($scroller);
my $textview = Gtk2::TextView->new;
$textview ->set_editable (0); #read-only text
$textview ->can_focus(0);     #

my $buffer = $textview->get_buffer;
$buffer->create_mark( 'end', $buffer->get_end_iter, FALSE );

$buffer->signal_connect(
    insert_text => sub {
        $textview->scroll_to_mark( $buffer->get_mark('end'), 0.0, TRUE
+, 0, 0.5 );
    }
);


$scroller->add($textview);

my $entry = Gtk2::Entry->new();

$vbox->pack_start( $entry, FALSE, FALSE, 0 );
$vbox->set_focus_child ($entry); # keeps cursor in entry
$window->set_focus_child ($entry); # keeps cursor in entry

# allows for sending each line with an enter keypress
my $send_sig = $entry->signal_connect ('key-press-event' => sub {
         my ($widget,$event)= @_;
         if( $event->keyval() == 65293){  # a return key press
                my $text = $entry->get_text;
        if(defined $socket){ print $socket $name.'->'. $text;}
             $entry->set_text('');
             $entry->set_position(0);
     }
   });

#If you store the ID returned by signal_connect, you can temporarily
#block your signal handler with
#  $object->signal_handler_block ($handler_id)
#    and unblock it again when you're done with
##        $object->signal_handler_unblock ($handler_id).

# we want to block/unblock the enter keypress depending
# on the state of the socket
$entry->signal_handler_block($send_sig); #not connected yet
$entry->set_editable(0);

my $button = Gtk2::Button->new('Connect');
$button->signal_connect( clicked => \&init_connect );
$vbox->pack_start( $button, FALSE, FALSE, 0 );

my $bexit = Gtk2::Button->new('Exit');
$bexit->signal_connect( clicked => sub{ exit  } );
$vbox->pack_start( $bexit, FALSE, FALSE, 0 );

$window->show_all;

Gtk2->main;
exit;


sub init_connect{

      $socket = IO::Socket::INET->new(
          PeerAddr => $host,
          PeerPort => $port,
          Proto    => 'tcp',
       );
       
       if( ! defined $socket){ 
            $buffer->insert( $buffer->get_end_iter, 
            "ERROR: Can't connect to port $port on $host: $!\n" );
        return;
        }else{
          $buffer->insert( $buffer->get_end_iter, "Connected\n"); 
        }
      
      #if we have a socket
      $button->set_label('Connected');
      $button->set_state('insensitive');
 
        # install an io watch for this stream and
        # return immediately to the main caller, who will return
        # immediately to the event loop.  the callback will be
        # invoked whenever something interesting happens.
        Glib::IO->add_watch( fileno $socket, [qw/in hup err/], \&watch
+_callback, $socket );

       #turn on entry widget
       $entry->set_editable(1);
       $entry->grab_focus;
       $entry->signal_handler_unblock ($send_sig);
       Gtk2->main_iteration while Gtk2->events_pending; 
}


sub watch_callback {
    my ( $fd, $condition, $fh ) = @_;
    
#    print "$fd, $condition, $fh\n"; 

    if ( $condition >= 'in' ) {

        # there's data available for reading.  
        my $bytes = sysread($fh,my $data,1024);


   # it seems if the server connection is lost
   # the condition is still 'in', not nohup or err
   # so test for zero data length
   
        if ( length $data ) {
            # do something useful with the text.
           
            $buffer->insert( $buffer->get_end_iter, "$data" );
        }
       
       else{
        # close socket as there is no data
        print "close\n";
        $socket->close;
        $fh->close;
        $fh = undef;
     
        # stop ability to send 
        $entry->set_editable(0);
        $entry->signal_handler_block ($send_sig);
        
        $buffer->insert( $buffer->get_end_iter, "Server connection los
+t !!\n" );
 
        #allow for new connection
        $button->set_label('Connect');
        $button->set_sensitive(1);
        $button->grab_focus;
        Gtk2->main_iteration while Gtk2->events_pending; 
          
       }
      
    }
    


    if ($fh) {

        # the file handle is still open, so return TRUE to
        # stay installed and be called again.
        # print "still connected\n";
        # possibly have a "connection alive" indicator
        return TRUE;
    }
    else {

        # we're finished with this job.  start another one,
        # if there are any, and uninstall ourselves. 
        print "done\n";
        return FALSE;
    }

}

__END__
[download]

</c>

I'm not really a human, but I play one on earth.
Old Perl Programmer Haiku ................... flash japh

Comment on Gtk2 server and client GUI's with root messaging Select or Download Code


"be consistent"
	PerlMonks