#!/usr/bin/perl -w # # Perl TCP demo with the GTK-server 2.1.6 # Tested with Perl 5.8.8 on Windows XP Professional # # Note: to use a remote GTK-server, replace the 'start /b' # command with a rsh/ssh command. # # October 05, 2007 by Luigi Di Fraia #--------------------------------------- use strict; use IO::Socket; my $target = "localhost"; my $port = "50000"; my $gtk_sock; # Disconnect on completion sub disconn { if ( $gtk_sock ) { close $gtk_sock; } exit 0; } # Communicate with GTK-server sub gtk { print $gtk_sock @_; my $line = <$gtk_sock>; return $line; } #------------------------ Main starts here $SIG{'INT'} = 'IGNORE'; $SIG{'QUIT'} = 'disconn'; $SIG{'TERM'} = 'disconn'; $SIG{'HUP'} = 'disconn'; # Start GTK-server in TCP mode system "start /b gtk-server -tcp=$target:$port"; # Open TCP socket to server $gtk_sock = new IO::Socket::INET ( proto => "tcp", PeerAddr => $target, PeerPort => $port ) || die $@; $gtk_sock -> autoflush(1); # Setup GUI gtk "gtk_init NULL NULL"; my $win = gtk "gtk_window_new 0"; gtk "gtk_window_set_title $win \"Perl GTK-server demo with STDIN\""; gtk "gtk_window_set_default_size $win 400 200"; gtk "gtk_window_set_position $win 1"; my $tbl = gtk "gtk_table_new 10 10 1"; gtk "gtk_container_add $win $tbl"; my $but = gtk "gtk_button_new_with_label \"Click to Quit\""; gtk "gtk_table_attach_defaults $tbl $but 5 9 5 9"; gtk "gtk_widget_show_all $win"; # Initialize event my $event=0; # Mainloop until($event == $win || $event == $but){ $event = gtk "gtk_server_callback WAIT"; } # Exit GTK without waiting for an answer gtk "gtk_server_exit"; disconn;