#!/usr/bin/perl -w # http://poe.perl.org/?POE_Cookbook/Gtk2_Interfaces # # This sample program creates a Gtk2 ping interface # and uses POE::Component::Client::Ping. use strict; # make sure Gtk2 is initialized use Gtk2-init; use Gtk2::Gdk::Keysyms; use POE qw(Component::Client::Ping); # MSWin32 doesn't need DISPLAY set. if ($^O ne 'MSWin32') { unless (exists $ENV{'DISPLAY'} and defined $ENV{'DISPLAY'} and length $ENV{'DISPLAY'}) { die "Can't use this without a DISPLAY. (Set it!)"; } } POE::Component::Client::Ping->spawn( Alias => "pinger", Timeout => 10, # defaults to 1 second OneReply => 0, # defaults to disabled ); POE::Session->create( inline_states => { _start => \&_start, keypress => \&keypress, ping_host => \&ping_host, pong => \&pong, } ); $poe_kernel->run(); exit; sub _start { my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP]; $kernel->refcount_increment($session->ID, __PACKAGE__); $heap->{main_window} = Gtk2::Window->new('toplevel'); $kernel->signal_ui_destroy($heap->{main_window}); my $vbox = Gtk2::VBox->new; $heap->{main_window}->add($vbox); # the area where the user can enter a host to ping my $entry = Gtk2::Entry->new; $heap->{entry} = $entry; # key-press-event expects the return value of the signal handler # to be a boolean where TRUE means we've handled the keypress, so # Gtk can stop asking other handlers to handle it and FALSE means # we didn't handle it; continue trying to handle this key. So we # need to use a callback instead of a postback here, since post # doesn't let us return a value. $entry->signal_connect("key-press-event", $session->callback('keypress')); $vbox->pack_start($entry, 0, 0, 0); my $nw = Gtk2::Notebook->new; $nw->set_size_request(500, 300); $vbox->pack_start_defaults($nw); my $swins = Gtk2::ScrolledWindow->new; $swins->set_policy('never', 'automatic'); $nw->append_page($swins, 'ping tool'); # the text area where the ping results are put my $contents = Gtk2::TextView->new; $heap->{contents} = $contents; $swins->add_with_viewport($contents); $heap->{main_window}->show_all; } sub keypress { my ($kernel, $heap, $session, $args) = @_[KERNEL, HEAP, SESSION, ARG1]; my (undef, $event) = @$args; # this is ->call()ed, so we want this to be as short # as possible if ( $event->keyval == $Gtk2::Gdk::Keysyms{Return} || $event->keyval == $Gtk2::Gdk::Keysyms{KP_Enter}) { $kernel->yield('ping_host'); # key handled. return 1; } # we didn't handle this key return 0; } sub ping_host { my ($kernel, $heap, $session) = @_[KERNEL, HEAP, SESSION]; # add a line to the text area my $content = $heap->{'contents'}; my $entry = $heap->{'entry'}; insert($content, "pinging " . $entry->get_text . "\n"); # send off our ping $kernel->post(pinger => "ping" => "pong" => $entry->get_text); # erase the host input area $entry->set_text(""); } sub pong { my ($kernel, $heap) = @_[KERNEL, HEAP]; my ($request, $response) = @_[ARG0, ARG1]; my ($req_address, $req_timeout, $req_time) = @$request; my ($resp_address, $roundtrip_time, $resp_time) = @$response; # The response address is defined if this is a response. my $content = $heap->{'contents'}; if (defined $resp_address) { insert( $content, sprintf( "ping to %-15.15s at %10d. pong from %-15.15s in %6.3f s\n", $req_address, $req_time, $resp_address, $roundtrip_time ) ); return; } # Otherwise the timeout period has ended. insert($content, sprintf("ping to %-15.15s is done.\n", $req_address)); } sub insert { my ($content, $text) = @_; my $buffer = $content->get_buffer; $buffer->insert($buffer->get_end_iter, $text); $content->scroll_to_iter($buffer->get_end_iter(), 0, 0, 0, 0); }