Linux Certif

Toute la documentation sur la certification Linux LPI

POE::Component::IRC::Cookbook::Gtk2.3pm

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
          )],
      ],
  );
 
  $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");
  }
 
 

AUTHOR

Damian Kaczmarek