Beefy Boxes and Bandwidth Generously Provided by pair Networks
more useful options
 
PerlMonks  

Gtk2 server and client GUI's with root messaging

by zentara (Archbishop)
on May 31, 2012 at 20:24 UTC ( #973602=CUFP: print w/replies, xml ) Need Help??

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__

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__
</c>

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

Replies are listed 'Best First'.
Re: Gtk2 server and client GUI's with root messaging
by strredwolf (Chaplain) on Jul 20, 2012 at 01:43 UTC
    This makes me wonder if PerlGtk works on MacOS X w/o X11.
    Information doesn't want to be free. It wants to be feline.
      I might guess that the Glib module, the one that does the connection handling, would work without x11, it does on Linux. So you could probably strip the GUI Gtk2 code out of my code, and it would work at the console level. It's just a guess based on the way it works on Linux, but MacOS might work differently.

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

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: CUFP [id://973602]
Front-paged by Eliya
help
Chatterbox?
[oakbox]: thanks, marto.
[marto]: there was a period where search.cpan had some frequent outages for (IIRC) a couple of weeks. I've not had any problems since, until today.
[marto]: this was about 16 months ago maybe. the noc team are, in my experience, very responsive to reports of issues, so please raise the issue after checking known problems/outages

How do I use this? | Other CB clients
Other Users?
Others chanting in the Monastery: (5)
As of 2017-07-26 10:20 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    I came, I saw, I ...
























    Results (390 votes). Check out past polls.