POE::Component::IRC::Cookbook::Gtk2 man page on Pidora
[printable version]
POE::Component::IRC::CUseroContributed PPOE::Component::IRC::Cookbook::Gtk2(3)
NAME
POE::Component::IRC::Cookbook::Gtk2 - An IRC client with a Gtk2
interface
SYNOPSIS
This example uses Gtk2 and POE::Loop::Glib to present an event-driven
GUI to the user.
DESCRIPTION
#!/usr/bin/env perl
use strict;
use warnings;
use Gtk2 -init;
use Gtk2::SimpleList;
use POE qw(Loop::Glib Component::IRC::State Component::IRC::Plugin::Connector);
use POE::Component::IRC::Common qw(parse_user strip_color strip_formatting irc_to_utf8);
my $channel = "#IRC.pm-test";
my $irc = POE::Component::IRC::State->spawn(
nick => 'gtk-example',
server => 'irc.perl.org',
port => 6667,
ircname => 'Testing',
debug => 1,
plugin_debug => 1,
) or die "Oh noooo! $!";
POE::Session->create(
package_states => [
(__PACKAGE__) => [qw(
_start
ui_start
ui_input
ui_menu_quit
ui_about
ui_about_ok
irc_start
irc_001
irc_public
irc_notice
irc_chan_sync
irc_nick_sync
irc_join
irc_msg
irc_433
)],
],
);
$poe_kernel->run();
my $messages;
my $buffer;
my $input;
my $nicks;
my $window;
sub _start {
$_[KERNEL]->yield('ui_start');
$_[KERNEL]->yield('irc_start');
}
sub ui_start {
my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
my $window = Gtk2::Window->new("toplevel");
$heap->{main_window} = $window;
$kernel->signal_ui_destroy($heap->{main_window});
$heap->{main_window}->set_size_request(640, 480);
my $box = Gtk2::VBox->new(0, 0);
my $menu_file = Gtk2::Menu->new();
my $menu_quit = Gtk2::MenuItem->new('_Exit');
$menu_quit->signal_connect(activate => $session->postback('ui_menu_quit'));
$menu_file->append($menu_quit);
my $menu_help = Gtk2::Menu->new();
my $menu_about = Gtk2::MenuItem->new('_About');
$menu_about->signal_connect(activate => $session->postback('ui_about'));
$menu_help->append($menu_about);
my $menu_item_file = Gtk2::MenuItem->new('_Program');
my $menu_item_help = Gtk2::MenuItem->new('_Help');
$menu_item_file->set_submenu($menu_file);
$menu_item_help->set_submenu($menu_help);
my $menu_bar = Gtk2::MenuBar->new();
$menu_bar->append($menu_item_file);
$menu_bar->append($menu_item_help);
$box->pack_start($menu_bar, 0, 0, 0);
$heap->{main_window}->add($box);
my $hbox = Gtk2::HBox->new(0, 0);
$box->pack_start($hbox, 1, 1, 0);
$nicks = Gtk2::SimpleList->new('nickname', 'text');
$nicks->set_headers_visible(0);
$nicks->set_size_request(120, -1);
$messages = Gtk2::TextView->new();
$messages->set_editable(0);
$messages->set_size_request(600, -1);
$hbox->pack_start($messages, 1, 1, 0);
$hbox->pack_start(Gtk2::VSeparator->new(), 0, 1, 4);
$hbox->pack_start($nicks, 1, 1, 0);
$messages->set_cursor_visible(0);
$buffer = Gtk2::TextBuffer->new();
my $blue = $buffer->create_tag("fg_blue", foreground => "blue");
my $yellow = $buffer->create_tag("fg_yellow", foreground => "yellow");
my $orange = $buffer->create_tag("fg_orange", foreground => "orange");
my $pink = $buffer->create_tag("fg_pink", foreground => "pink");
my $red = $buffer->create_tag("fg_red", foreground => "red");
$messages->set_buffer($buffer);
my $label = Gtk2::Label->new("Counter");
$heap->{counter} = 0;
$heap->{counter_label} = Gtk2::Label->new($heap->{counter});
$input = Gtk2::Entry->new;
$box->pack_start($input, 0, 0, 4);
$heap->{main_window}->show_all();
$input->grab_focus();
$input->signal_connect(activate => $session->postback('ui_input'));
}
sub push_buffer {
my ($start, $end) = $buffer->get_bounds();
my $text = strip_color(strip_formatting($_[0]));
shift;
$buffer->insert_with_tags_by_name($end, $text, @_);
$messages->scroll_to_iter($end,0, 0, 0, 0);
}
sub ui_about {
my $session = $_[SESSION];
my $dialog = Gtk2::MessageDialog->new(
$window,
'destroy-with-parent',
'info',
'ok',
"POE::Component::IRC with Gtk2 example\nAuthor: Damian Kaczmarek"
);
$dialog->signal_connect(response => $session->postback('ui_about_ok'));
$dialog->show();
}
sub ui_input {
my ($self, $response) = @{ $_[ARG1] };
my $input = $self->get_text();
return if $input eq "";
if (my ($target, $msg) = $input =~ /^\/msg (\S+) (.*)$/) {
$irc->yield(privmsg => $target, $msg);
push_buffer("-> $target -> $msg\n", "fg_red");
}
else {
$irc->yield(privmsg => $channel, $input);
push_buffer('<'.$irc->nick_name()."> $input\n");
}
$self->set_text("");
}
sub ui_about_ok {
my ($dialog, $response) = @{ $_[ARG1] };
$dialog->destroy;
}
sub ui_menu_quit {
$_[HEAP]{main_window}->destroy();
}
sub irc_start {
$irc->plugin_add('Connector', POE::Component::IRC::Plugin::Connector->new());
$irc->yield(register => 'all');
$irc->yield('connect' );
}
sub irc_msg {
my ($user, $recipients, $text) = @_[ARG0..ARG2];
my $nick = parse_user($user);
push_buffer("PRIV <$nick> $text\n", "fg_red");
}
sub irc_join {
my ($user, $channel) = (@_[ARG0..ARG1]);
my ($nick, $username, $host) = parse_user($user);
push_buffer("$nick ($host) joined $channel\n", "fg_pink");
}
sub irc_chan_sync {
@{$nicks->{data}} = map { [$_] } $irc->channel_list($channel);
push_buffer("Synchronized to $channel!\n");
}
sub irc_nick_sync {
@{$nicks->{data}} = map { [$_] } $irc->channel_list($channel);
}
sub irc_001 {
push_buffer("Connected to IRC server!\n");
$irc->yield(join => $channel);
}
sub irc_notice {
my ($user, $recipients, $text) = @_[ARG0..ARG2];
my $nick = parse_user($user);
$text = irc_to_utf8($text);
push_buffer("$nick : $text\n", "fg_orange");
}
sub irc_public {
my ($user, $where, $what) = @_[ARG0 .. ARG2];
my $nick = parse_user($user);
$what = irc_to_utf8($what);
push_buffer("<$nick> $what\n");
}
sub irc_433 {
my $new_nick = $irc->nick_name() . "_";
$irc->yield(nick => $new_nick);
push_buffer("433 Nick taken ... changing to $new_nick\n", "fg_orange");
}
AUTHOR
Damian Kaczmarek
perl v5.14.1 2010-1POE::Component::IRC::Cookbook::Gtk2(3)
[top]
List of man pages available for Pidora
Copyright (c) for man pages and the logo by the respective OS vendor.
For those who want to learn more, the polarhome community provides shell access and support.
[legal]
[privacy]
[GNU]
[policy]
[cookies]
[netiquette]
[sponsors]
[FAQ]
Polarhome, production since 1999.
Member of Polarhome portal.
Based on Fawad Halim's script.
....................................................................
|
Vote for polarhome
|