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; |