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 IRC::Utils qw(parse_user strip_color strip_formatting decode_irc);
        use POE qw(Loop::Glib Component::IRC::State Component::IRC::Plugin::Connector);

        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 = decode_irc($text);
            push_buffer("$nick : $text\n", "fg_orange");
        }

        sub irc_public {
            my ($user, $where, $what) = @_[ARG0 .. ARG2];
            my $nick = parse_user($user);
            $what = decode_irc($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