[ViewVC] Annotation of: cvs/Net-Knuddels/eg/gknuddels

#!/usr/bin/perl
package main;
use strict;
use lib '../Net-IRC-Server/';
use Gtk2 -init;
use Gtk2::SimpleList;
use Gtk2::Helper;
use IO::Select;
use IO::Socket::INET;
use Socket;
use Net::Knuddels;
use YAML;

my %CFG = (
  knuddel_nick   => "Net-Knuddels",
  knuddel_pass   => "lolfe",
  knuddel_chan   => "Flirt Private",
);

scan_config ();

my $client;
my $kn_active; 

sub scan_config {
  my $config = $ENV{HOME}."/.knuddels2irc2.rc";

  if (! -e $config) { return; }
  
  my $h = YAML::LoadFile $config;

  if (defined $h and ref $h eq "HASH") {
    %CFG = (%CFG, %$h);
  } else {
    die "$config is not a map!";
  }
}

sub connect_knuddels {
  return if $kn_active; # don't make another login if we are already in

  $client->login;
  Gtk2::Helper->add_watch ($client->fh()->fileno, 'in', sub {
    my ($fh, $tag) = @_;

    if (not $client->ready) {
      Gtk2::Helper->remove_watch ($tag) 
        or die "Couldn't remove watcher for knuddels connection\n";
      $client->fh ()->close;
      return 1;
    }
    return 1;
  });
}

####################################################################################
########################## BUILD GUI ###############################################
####################################################################################

my $ntb;
my %targets;

##### CONSTRUCT ROOMLIST:

my $roomlist = new Gtk2::SimpleList (
                     'Channel' => 'text',
                     'Users'   => 'int',
                     'Full'    => 'text'
               );
$roomlist->signal_connect (row_activated => sub {
  my ($l, $path, $column) = @_;
  my $row = $l->get_row_data_from_path ($path);
  $client->enter_room ($row->[0], $CFG{knuddel_nick}, $CFG{knuddel_pass});
});
my $list_win = Gtk2::Window->new ('toplevel');
$list_win->set_default_size (200, 500);
$list_win->add (my $sw = new Gtk2::ScrolledWindow);
$sw->add ($roomlist);

##### CONSTRUCT MAINWINDOW

my $main = Gtk2::Window->new ('toplevel');
$main->set_default_size (400, 400);

$main->add (my $vb = new Gtk2::VBox (0, 2));

$vb->pack_start (my $hb = new Gtk2::HBox (1, 2), 0, 1, 2);
  $hb->pack_start (my $btn = new Gtk2::Button ("connect"), 0, 1, 2);
  $btn->signal_connect (clicked => sub {
    connect_knuddels ();
  });

  $hb->pack_start (my $btn = new Gtk2::Button ("list"), 0, 1, 2);
  $btn->signal_connect (clicked => sub {
    if (not $list_win->visible) {
      $list_win->show_all;
    } else {
      $list_win->hide_all;
    }
  });

  $hb->pack_start (my $e = new Gtk2::Entry, 0, 1, 2);
  $e->signal_connect (activate => sub {
    create_target ($e->get_text (), 1);
    $e->set_text ("");
  });

$vb->pack_start ($ntb = new Gtk2::Notebook, 1, 1, 2);


####################################################################################
########################## MAIN START ##############################################
####################################################################################

sub send_keepalive {
  my ($room) = grep { defined $_->{room} } values %targets;
  return if not defined $room;
  $client->send_room_msg ($room->{room}, "/knuschel");
}

sub create_target {
  my ($targ, $priv) = @_;

  $ntb->append_page (my $vb = new Gtk2::VBox (0, 0), $targ);

    $vb->pack_start (my $txt = new Gtk2::TextView, 1, 1, 2);
      $txt->set_wrap_mode ('char');
      $targets{lc $targ}->{text} = $txt->get_buffer;
      $targets{lc $targ}->{room} = $targ if not $priv;
      $txt->get_buffer ()->create_tag ("priv", foreground => "red");
      $txt->get_buffer ()->create_tag ("nick", foreground => "blue");
      
    $vb->pack_start (my $e = new Gtk2::Entry, 0, 1, 2);
      $e->signal_connect (activate => sub {
        my $t = $e->get_text;
        $e->set_text ("");
        if ($priv) {
          my ($room) = grep { defined $_->{room} } values %targets;
          if (not defined $room) {
            print "no room i'm in found, won't send message!\n";
            return;
          }
          print "$room->{room}|$targ|$t\n";
          $client->send_priv_msg ($targ, $room->{room}, $t);
        } else {
          $client->send_room_msg ($targ, $t);
        }
      });

    $vb->show_all;
}

$client = new Net::Knuddels::Client PeerAddr => "213.61.5.150:2710";


$client->register (UNHANDLED => sub {
   use Dumpvalue;
   print "---\n";
   Dumpvalue->new (compactDump => 1, veryCompact => 1, quoteHighBit => 1, tick => '"')->dumpValue ([@_]);
});

$client->register (login => sub {
   $kn_active = 1;
   print "CONNECTION ACTIVATED\n";
   Glib::Timeout->add (1000 * 10, sub { send_keepalive () });
});

$client->register (msg_room => sub {
   my ($room, $user, $msg) = @_;
   my $b = $targets{lc $room}->{text};
   print "ROOM: $room : $user : $msg\n";
   return if not defined $b;

   my $ei = $b->get_end_iter;
   $b->insert_with_tags_by_name ($ei, "$user", "nick");
   $ei = $b->get_end_iter;
   $b->insert_with_tags_by_name ($ei, ": $msg\n");
});

$client->register (msg_priv => sub {
   my ($room, $src, $dst, $msg) = @_;
   return if $msg =~ m/Die.*Funktion.*knuschel.*gibts.*hier.*leider.*nicht/i;
   print "PRIV:$room:$dst\n";
   my $b = $targets{lc $src}->{text};
   $b = $targets{lc $dst}->{text} if not defined $b;
   $b = $targets{lc $room}->{text} if not defined $b;

   if (not defined $b) {
     ($b) = map { $_->{text} } values %targets;
   }
   my $ei = $b->get_end_iter;
   $b->insert_with_tags_by_name ($ei, "{$src:$dst} $msg\n", "priv");
});

$client->register (dialog => sub {
  for my $l (@{$_[0]}) {
 #   $l =~ s/\260[^\260]*female[^\260]*\260/weiblich/i;
 #   $l =~ s/\260[^\260]*male[^\260]*\260/maennlich/i;
 #   $l =~ s/\260[^\260]*\260//g;
 #   $ircsrv->generic_msg ($server_cl, $_, "PRIVMSG", $l) for keys %privmsg_receiver;
 #   $ircsrv->send_msg ($irc_client, $ircsrv->mk_clpref ($server_cl), "NOTICE", $l, $irc_client->{nickname});
  }
});

$client->register (join_room => sub {
 # print "$_[1]->{name} joined $_[0]: ".scalar(keys %{$client->{user_lists}->{lc $_[0]}}). " users\n";
 # join_knuddels_nick ($_[1]->{name}, $_[1]->{age}, $_[1]->{gender}, $_[0]);
});

$client->register (action_room => sub {
 my ($room, $msg);
 # action_knuddels ($_[0], $_[1]);
 my $b = $targets{lc $room}->{text};
 return if not defined $b;

 my $ei = $b->get_end_iter;
 $b->insert ($ei, "$msg\n");
});

$client->register (part_room => sub {
 # print "$_[1]->{name} left $_[0]: ".scalar(keys %{$client->{user_lists}->{lc $_[0]}}). " users\n";
 # part_knuddels_nick ($_[1]->{name}, $_[0]);
});

$client->register (user_list => sub {
   my ($room, $list) = @_;
   print "***** USER JOIN FUER $room *****\n";

 #  join_knuddels_nick ($_->{name}, $_->{age}, $_->{gender}, $room)
 #    for values %$list;

   print scalar (keys %$list)." users\n";

 #  send_nameslist ($room);
   print "********************************\n";
});

$client->register (room_info => sub {
  my ($room, $ri) = @_;
  create_target ($room);
});

$client->register (change_room => sub {
  my ($r, $nr) = @_;
 # change_knuddels_room ($r, $nr);
});

$client->register (room_list => sub {
  my ($room_hash) = @_;
  # %knuddel_channels = %$room_hash;
  @{$roomlist->{data}} = ();
  for (map { $room_hash->{$_} } sort keys %$room_hash) {
    next if $_->{name} eq "";
    push @{$roomlist->{data}}, [ $_->{name}, $_->{user_count}, $_->{full_flag} ? "full" : "" ]
  }
});

$main->show_all;
Gtk2->main;
Revision:	1.1
Committed:	Fri Jan 21 17:25:18 2005 UTC (21 years, 7 months ago) by elmex
Branch:	MAIN
CVS Tags:	HEAD
Log Message:	gtk client
#	User	Rev	Content
1	elmex	1.1	#!/usr/bin/perl
2			package main;
3			use strict;
4			use lib '../Net-IRC-Server/';
5			use Gtk2 -init;
6			use Gtk2::SimpleList;
7			use Gtk2::Helper;
8			use IO::Select;
9			use IO::Socket::INET;
10			use Socket;
11			use Net::Knuddels;
12			use YAML;
13
14			my %CFG = (
15			knuddel_nick => "Net-Knuddels",
16			knuddel_pass => "lolfe",
17			knuddel_chan => "Flirt Private",
18			);
19
20			scan_config ();
21
22			my $client;
23			my $kn_active;
24
25			sub scan_config {
26			my $config = $ENV{HOME}."/.knuddels2irc2.rc";
27
28			if (! -e $config) { return; }
29
30			my $h = YAML::LoadFile $config;
31
32			if (defined $h and ref $h eq "HASH") {
33			%CFG = (%CFG, %$h);
34			} else {
35			die "$config is not a map!";
36			}
37			}
38
39			sub connect_knuddels {
40			return if $kn_active; # don't make another login if we are already in
41
42			$client->login;
43			Gtk2::Helper->add_watch ($client->fh()->fileno, 'in', sub {
44			my ($fh, $tag) = @_;
45
46			if (not $client->ready) {
47			Gtk2::Helper->remove_watch ($tag)
48			or die "Couldn't remove watcher for knuddels connection\n";
49			$client->fh ()->close;
50			return 1;
51			}
52			return 1;
53			});
54			}
55
56			####################################################################################
57			########################## BUILD GUI ###############################################
58			####################################################################################
59
60			my $ntb;
61			my %targets;
62
63			##### CONSTRUCT ROOMLIST:
64
65			my $roomlist = new Gtk2::SimpleList (
66			'Channel' => 'text',
67			'Users' => 'int',
68			'Full' => 'text'
69			);
70			$roomlist->signal_connect (row_activated => sub {
71			my ($l, $path, $column) = @_;
72			my $row = $l->get_row_data_from_path ($path);
73			$client->enter_room ($row->[0], $CFG{knuddel_nick}, $CFG{knuddel_pass});
74			});
75			my $list_win = Gtk2::Window->new ('toplevel');
76			$list_win->set_default_size (200, 500);
77			$list_win->add (my $sw = new Gtk2::ScrolledWindow);
78			$sw->add ($roomlist);
79
80			##### CONSTRUCT MAINWINDOW
81
82			my $main = Gtk2::Window->new ('toplevel');
83			$main->set_default_size (400, 400);
84
85			$main->add (my $vb = new Gtk2::VBox (0, 2));
86
87			$vb->pack_start (my $hb = new Gtk2::HBox (1, 2), 0, 1, 2);
88			$hb->pack_start (my $btn = new Gtk2::Button ("connect"), 0, 1, 2);
89			$btn->signal_connect (clicked => sub {
90			connect_knuddels ();
91			});
92
93			$hb->pack_start (my $btn = new Gtk2::Button ("list"), 0, 1, 2);
94			$btn->signal_connect (clicked => sub {
95			if (not $list_win->visible) {
96			$list_win->show_all;
97			} else {
98			$list_win->hide_all;
99			}
100			});
101
102			$hb->pack_start (my $e = new Gtk2::Entry, 0, 1, 2);
103			$e->signal_connect (activate => sub {
104			create_target ($e->get_text (), 1);
105			$e->set_text ("");
106			});
107
108			$vb->pack_start ($ntb = new Gtk2::Notebook, 1, 1, 2);
109
110
111			####################################################################################
112			########################## MAIN START ##############################################
113			####################################################################################
114
115			sub send_keepalive {
116			my ($room) = grep { defined $_->{room} } values %targets;
117			return if not defined $room;
118			$client->send_room_msg ($room->{room}, "/knuschel");
119			}
120
121			sub create_target {
122			my ($targ, $priv) = @_;
123
124			$ntb->append_page (my $vb = new Gtk2::VBox (0, 0), $targ);
125
126			$vb->pack_start (my $txt = new Gtk2::TextView, 1, 1, 2);
127			$txt->set_wrap_mode ('char');
128			$targets{lc $targ}->{text} = $txt->get_buffer;
129			$targets{lc $targ}->{room} = $targ if not $priv;
130			$txt->get_buffer ()->create_tag ("priv", foreground => "red");
131			$txt->get_buffer ()->create_tag ("nick", foreground => "blue");
132
133			$vb->pack_start (my $e = new Gtk2::Entry, 0, 1, 2);
134			$e->signal_connect (activate => sub {
135			my $t = $e->get_text;
136			$e->set_text ("");
137			if ($priv) {
138			my ($room) = grep { defined $_->{room} } values %targets;
139			if (not defined $room) {
140			print "no room i'm in found, won't send message!\n";
141			return;
142			}
143			print "$room->{room}\|$targ\|$t\n";
144			$client->send_priv_msg ($targ, $room->{room}, $t);
145			} else {
146			$client->send_room_msg ($targ, $t);
147			}
148			});
149
150			$vb->show_all;
151			}
152
153			$client = new Net::Knuddels::Client PeerAddr => "213.61.5.150:2710";
154
155
156			$client->register (UNHANDLED => sub {
157			use Dumpvalue;
158			print "---\n";
159			Dumpvalue->new (compactDump => 1, veryCompact => 1, quoteHighBit => 1, tick => '"')->dumpValue ([@_]);
160			});
161
162			$client->register (login => sub {
163			$kn_active = 1;
164			print "CONNECTION ACTIVATED\n";
165			Glib::Timeout->add (1000 * 10, sub { send_keepalive () });
166			});
167
168			$client->register (msg_room => sub {
169			my ($room, $user, $msg) = @_;
170			my $b = $targets{lc $room}->{text};
171			print "ROOM: $room : $user : $msg\n";
172			return if not defined $b;
173
174			my $ei = $b->get_end_iter;
175			$b->insert_with_tags_by_name ($ei, "$user", "nick");
176			$ei = $b->get_end_iter;
177			$b->insert_with_tags_by_name ($ei, ": $msg\n");
178			});
179
180			$client->register (msg_priv => sub {
181			my ($room, $src, $dst, $msg) = @_;
182			return if $msg =~ m/Die.Funktion.knuschel.gibts.hier.leider.nicht/i;
183			print "PRIV:$room:$dst\n";
184			my $b = $targets{lc $src}->{text};
185			$b = $targets{lc $dst}->{text} if not defined $b;
186			$b = $targets{lc $room}->{text} if not defined $b;
187
188			if (not defined $b) {
189			($b) = map { $_->{text} } values %targets;
190			}
191			my $ei = $b->get_end_iter;
192			$b->insert_with_tags_by_name ($ei, "{$src:$dst} $msg\n", "priv");
193			});
194
195			$client->register (dialog => sub {
196			for my $l (@{$_[0]}) {
197			# $l =~ s/\260[^\260]female[^\260]\260/weiblich/i;
198			# $l =~ s/\260[^\260]male[^\260]\260/maennlich/i;
199			# $l =~ s/\260[^\260]*\260//g;
200			# $ircsrv->generic_msg ($server_cl, $_, "PRIVMSG", $l) for keys %privmsg_receiver;
201			# $ircsrv->send_msg ($irc_client, $ircsrv->mk_clpref ($server_cl), "NOTICE", $l, $irc_client->{nickname});
202			}
203			});
204
205			$client->register (join_room => sub {
206			# print "$_[1]->{name} joined $_[0]: ".scalar(keys %{$client->{user_lists}->{lc $_[0]}}). " users\n";
207			# join_knuddels_nick ($_[1]->{name}, $_[1]->{age}, $_[1]->{gender}, $_[0]);
208			});
209
210			$client->register (action_room => sub {
211			my ($room, $msg);
212			# action_knuddels ($_[0], $_[1]);
213			my $b = $targets{lc $room}->{text};
214			return if not defined $b;
215
216			my $ei = $b->get_end_iter;
217			$b->insert ($ei, "$msg\n");
218			});
219
220			$client->register (part_room => sub {
221			# print "$_[1]->{name} left $_[0]: ".scalar(keys %{$client->{user_lists}->{lc $_[0]}}). " users\n";
222			# part_knuddels_nick ($_[1]->{name}, $_[0]);
223			});
224
225			$client->register (user_list => sub {
226			my ($room, $list) = @_;
227			print "*** USER JOIN FUER $room ***\n";
228
229			# join_knuddels_nick ($_->{name}, $_->{age}, $_->{gender}, $room)
230			# for values %$list;
231
232			print scalar (keys %$list)." users\n";
233
234			# send_nameslist ($room);
235			print "********************************\n";
236			});
237
238			$client->register (room_info => sub {
239			my ($room, $ri) = @_;
240			create_target ($room);
241			});
242
243			$client->register (change_room => sub {
244			my ($r, $nr) = @_;
245			# change_knuddels_room ($r, $nr);
246			});
247
248			$client->register (room_list => sub {
249			my ($room_hash) = @_;
250			# %knuddel_channels = %$room_hash;
251			@{$roomlist->{data}} = ();
252			for (map { $room_hash->{$_} } sort keys %$room_hash) {
253			next if $_->{name} eq "";
254			push @{$roomlist->{data}}, [ $_->{name}, $_->{user_count}, $_->{full_flag} ? "full" : "" ]
255			}
256			});
257
258			$main->show_all;
259			Gtk2->main;