[ViewVC] Contents 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 (19 years, 6 months ago) by elmex
Branch:	MAIN
CVS Tags:	HEAD
Log Message:	gtk client
#	Content
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;