prima irc client

prima-irc.pl

 #!/usr/bin/env perl

 use strict;
 use warnings;
 use Prima qw(Application Label Buttons InputLine Edit Lists MsgBox);
 use IRC::Utils qw(parse_user strip_color strip_formatting decode_irc);
 use POE qw(Component::IRC::State Component::IRC::Plugin::Connector);

 my $channel = "#IRC.pm";
 my $irc = POE::Component::IRC::State->spawn(
     nick         => 'prima-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
             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];

     $heap->{main_window} = my $window = Prima::MainWindow->new(
       text => 'Prima IRC Client',
       size => [640, 480],
       menuItems => [
         ['~File' =>[
           [ '~Exit', 'Alt+X', '@X', $session->postback('ui_menu_quit') ],
         ]],
         ['~Help' => [
           [ 'Show ~Help', 'Ctrl+H', '', sub { $::application-> open_help($0); } ],
           [ '~About' => $session->postback('ui_about') ],
         ]],
       ],
     );
     $kernel->signal_ui_destroy($heap->{main_window});
     
     $nicks = $window->insert(ListBox =>
       place => {
           anchor => 'sw', x => 5, width => 120,
           y => 30, height => -35, relheight => 1,
       }
     );
     
     $messages = $window->insert(Edit =>
       place => {
           anchor => 'sw', x => 130, width => -135, relwidth => 1,
           y => 30, height => -35, relheight => 1,
       },
       text => '*** IRC log ***',
       cursorWrap => 1,
       wordWrap => 1,
       readOnly => 1,
       backColor => cl::LightGray,
     );

     # no text coloring (yet)

     $input = $window->insert(InputLine =>
       place => {
           anchor => 'sw', x => 130, width => -135, relwidth => 1,
           y => 5, height => 20,
       },
       accelItems => [
         # Enter/Return sends the text
           ['Return', '', kb::Return, $session->postback('ui_input') ]
         , ['Enter', '',  kb::Enter,  $session->postback('ui_input') ]
       ],
       text => '',
       selected => 1,
     );
 }

 sub push_buffer {
     my ($message) = @_;
     my $text_ref = $messages->textRef;
     $$text_ref .= "\n$message";
     $messages->textRef($text_ref);
 }

 sub ui_about {
     Prima::MsgBox::message(join("\n",
         'POE::Component::IRC with Prima example',
         'Based on similar client for Gtk2 by Damian Kaczmarek',
         'Translated to Prima by David Mertens'
     ), mb::Ok);
 }

 sub ui_input {
     my $input_text = $input->text();
     return if $input_text eq "";

     if (my ($target, $msg) = $input_text =~ /^\/msg (\S+) (.*)$/) {
         $irc->yield(privmsg => $target, $msg);
         push_buffer("-> $target -> $msg\n");   #, "fg_red");
     }
     else {
         $irc->yield(privmsg => $channel, $input_text);
         push_buffer('<'.$irc->nick_name()."> $input_text\n");
     }

     $input->text('');
 }

 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->items( map { [$_] } $irc->channel_list($channel) );
     push_buffer("Synchronized to $channel!\n");
 }

 sub irc_nick_sync {
     $nicks->items( 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");

 }