1POE::Component::IRC::CoUoskebrooCko:n:tGrtikb2u(t3e)d PePrOlE:D:oCcoummpeonnteantti:o:nIRC::Cookbook::Gtk2(3)
2
3
4

NAME

6       POE::Component::IRC::Cookbook::Gtk2 - An IRC client with a Gtk2
7       interface
8

SYNOPSIS

10       This example uses Gtk2 and POE::Loop::Glib to present an event-driven
11       GUI to the user.
12

DESCRIPTION

14        #!/usr/bin/env perl
15
16        use strict;
17        use warnings;
18        use Gtk2 -init;
19        use Gtk2::SimpleList;
20        use IRC::Utils qw(parse_user strip_color strip_formatting decode_irc);
21        use POE qw(Loop::Glib Component::IRC::State Component::IRC::Plugin::Connector);
22
23        my $channel = "#IRC.pm-test";
24        my $irc = POE::Component::IRC::State->spawn(
25            nick         => 'gtk-example',
26            server       => 'irc.perl.org',
27            port         => 6667,
28            ircname      => 'Testing',
29            debug        => 1,
30            plugin_debug => 1,
31        ) or die "Oh noooo! $!";
32
33        POE::Session->create(
34            package_states => [
35                (__PACKAGE__) => [qw(
36                    _start
37                    ui_start
38                    ui_input
39                    ui_menu_quit
40                    ui_about
41                    ui_about_ok
42                    irc_start
43                    irc_001
44                    irc_public
45                    irc_notice
46                    irc_chan_sync
47                    irc_nick_sync
48                    irc_join
49                    irc_msg
50                    irc_433
51                )],
52            ],
53        );
54
55        $poe_kernel->run();
56
57        my $messages;
58        my $buffer;
59        my $input;
60        my $nicks;
61        my $window;
62
63        sub _start {
64            $_[KERNEL]->yield('ui_start');
65            $_[KERNEL]->yield('irc_start');
66        }
67
68        sub ui_start {
69            my ($kernel, $session, $heap) = @_[KERNEL, SESSION, HEAP];
70
71            my $window = Gtk2::Window->new("toplevel");
72            $heap->{main_window} = $window;
73            $kernel->signal_ui_destroy($heap->{main_window});
74
75            $heap->{main_window}->set_size_request(640, 480);
76
77            my $box = Gtk2::VBox->new(0, 0);
78
79            my $menu_file = Gtk2::Menu->new();
80            my $menu_quit = Gtk2::MenuItem->new('_Exit');
81
82            $menu_quit->signal_connect(activate => $session->postback('ui_menu_quit'));
83
84            $menu_file->append($menu_quit);
85
86            my $menu_help = Gtk2::Menu->new();
87            my $menu_about = Gtk2::MenuItem->new('_About');
88            $menu_about->signal_connect(activate => $session->postback('ui_about'));
89            $menu_help->append($menu_about);
90
91            my $menu_item_file = Gtk2::MenuItem->new('_Program');
92            my $menu_item_help = Gtk2::MenuItem->new('_Help');
93            $menu_item_file->set_submenu($menu_file);
94            $menu_item_help->set_submenu($menu_help);
95
96            my $menu_bar = Gtk2::MenuBar->new();
97            $menu_bar->append($menu_item_file);
98            $menu_bar->append($menu_item_help);
99            $box->pack_start($menu_bar, 0, 0, 0);
100            $heap->{main_window}->add($box);
101
102            my $hbox = Gtk2::HBox->new(0, 0);
103            $box->pack_start($hbox, 1, 1, 0);
104
105            $nicks = Gtk2::SimpleList->new('nickname', 'text');
106            $nicks->set_headers_visible(0);
107            $nicks->set_size_request(120, -1);
108
109            $messages = Gtk2::TextView->new();
110            $messages->set_editable(0);
111            $messages->set_size_request(600, -1);
112
113            $hbox->pack_start($messages, 1, 1, 0);
114            $hbox->pack_start(Gtk2::VSeparator->new(), 0, 1, 4);
115            $hbox->pack_start($nicks, 1, 1, 0);
116
117            $messages->set_cursor_visible(0);
118            $buffer = Gtk2::TextBuffer->new();
119
120            my $blue  = $buffer->create_tag("fg_blue", foreground => "blue");
121            my $yellow = $buffer->create_tag("fg_yellow", foreground => "yellow");
122            my $orange = $buffer->create_tag("fg_orange", foreground => "orange");
123            my $pink   = $buffer->create_tag("fg_pink", foreground => "pink");
124            my $red    = $buffer->create_tag("fg_red", foreground => "red");
125
126            $messages->set_buffer($buffer);
127
128            my $label = Gtk2::Label->new("Counter");
129
130            $heap->{counter}       = 0;
131            $heap->{counter_label} = Gtk2::Label->new($heap->{counter});
132
133            $input = Gtk2::Entry->new;
134            $box->pack_start($input, 0, 0, 4);
135
136            $heap->{main_window}->show_all();
137            $input->grab_focus();
138            $input->signal_connect(activate => $session->postback('ui_input'));
139        }
140
141        sub push_buffer {
142            my ($start, $end) = $buffer->get_bounds();
143            my $text = strip_color(strip_formatting($_[0]));
144            shift;
145            $buffer->insert_with_tags_by_name($end, $text, @_);
146            $messages->scroll_to_iter($end,0, 0, 0, 0);
147        }
148
149        sub ui_about {
150            my $session = $_[SESSION];
151            my $dialog = Gtk2::MessageDialog->new(
152                $window,
153                'destroy-with-parent',
154                'info',
155                'ok',
156                "POE::Component::IRC with Gtk2 example\nAuthor: Damian Kaczmarek"
157            );
158
159            $dialog->signal_connect(response => $session->postback('ui_about_ok'));
160            $dialog->show();
161        }
162
163        sub ui_input {
164            my ($self, $response) = @{ $_[ARG1] };
165            my $input = $self->get_text();
166
167            return if $input eq "";
168
169            if (my ($target, $msg) = $input =~ /^\/msg (\S+) (.*)$/) {
170                $irc->yield(privmsg => $target, $msg);
171                push_buffer("-> $target -> $msg\n", "fg_red");
172            }
173            else {
174                $irc->yield(privmsg => $channel, $input);
175                push_buffer('<'.$irc->nick_name()."> $input\n");
176            }
177
178            $self->set_text("");
179        }
180
181        sub ui_about_ok {
182            my ($dialog, $response) = @{ $_[ARG1] };
183            $dialog->destroy;
184        }
185
186        sub ui_menu_quit {
187            $_[HEAP]{main_window}->destroy();
188        }
189
190        sub irc_start {
191            $irc->plugin_add('Connector', POE::Component::IRC::Plugin::Connector->new());
192            $irc->yield(register => 'all');
193            $irc->yield('connect' );
194        }
195
196        sub irc_msg {
197            my ($user, $recipients, $text) = @_[ARG0..ARG2];
198            my $nick = parse_user($user);
199
200            push_buffer("PRIV <$nick> $text\n", "fg_red");
201        }
202
203        sub irc_join {
204            my ($user, $channel) = (@_[ARG0..ARG1]);
205            my ($nick, $username, $host) = parse_user($user);
206
207            push_buffer("$nick ($host) joined $channel\n", "fg_pink");
208        }
209
210        sub irc_chan_sync {
211            @{$nicks->{data}} = map { [$_] } $irc->channel_list($channel);
212            push_buffer("Synchronized to $channel!\n");
213        }
214
215        sub irc_nick_sync {
216            @{$nicks->{data}} = map { [$_] } $irc->channel_list($channel);
217        }
218
219        sub irc_001 {
220            push_buffer("Connected to IRC server!\n");
221            $irc->yield(join => $channel);
222        }
223
224        sub irc_notice {
225            my ($user, $recipients, $text) = @_[ARG0..ARG2];
226            my $nick = parse_user($user);
227            $text = decode_irc($text);
228            push_buffer("$nick : $text\n", "fg_orange");
229        }
230
231        sub irc_public {
232            my ($user, $where, $what) = @_[ARG0 .. ARG2];
233            my $nick = parse_user($user);
234            $what = decode_irc($what);
235            push_buffer("<$nick> $what\n");
236        }
237
238        sub irc_433 {
239            my $new_nick = $irc->nick_name() . "_";
240            $irc->yield(nick => $new_nick);
241            push_buffer("433 Nick taken ... changing to $new_nick\n", "fg_orange");
242
243        }
244

AUTHOR

246       Damian Kaczmarek
247
248
249
250perl v5.34.0                      2022-01P-O2E1::Component::IRC::Cookbook::Gtk2(3)