ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/Net-IRC3/samples/jsonclient
Revision: 1.13
Committed: Sat Feb 17 13:01:38 2007 UTC (19 years, 7 months ago) by elmex
Branch: MAIN
CVS Tags: HEAD
Changes since 1.12: +0 -0 lines
State: FILE REMOVED
Log Message: 
removed json examples,
fixed a few minor bugs and added connect/connect_error events
with improved network code.

File Contents

# User Rev Content
1 elmex 1.8 #!/opt/perl/bin/perl
2 elmex 1.1 use strict;
3 elmex 1.5 use utf8;
4 elmex 1.6 use URI;
5 elmex 1.1 use JSONConnection;
6 elmex 1.3 use JSON::Syck;
7 elmex 1.2 use POSIX qw(strftime);
8     use CursesChatMainwindow;
9 elmex 1.1
10 elmex 1.8 our $id_seq = 0;
11    
12     my $HOST = 'localhost';
13     my $PORT = 1236;
14    
15 elmex 1.6 our @highlight;
16 elmex 1.3 our $CFG;
17 elmex 1.4 our $js;
18 elmex 1.12 our %buffer_nicks;
19     our %on_reply;
20     our %buffer_attrs;
21    
22 elmex 1.4 our %completion = map { $_ => 1 } qw{
23 elmex 1.8 /goto
24     /kill
25 elmex 1.6 /colors
26 elmex 1.10 /clear_temporaries
27 elmex 1.8 /buffers
28 elmex 1.12 /toggle_inhibit_highlight
29     /toggle_highlight_activity
30 elmex 1.10 /reload
31     /remote_reload
32     /reconnect
33 elmex 1.8 /pop
34 elmex 1.4 };
35    
36 elmex 1.12 our $temporary_timer;
37 elmex 1.10 sub start_temporary_killer {
38     my ($buffer, $timeout) = @_;
39     $::temporary_timer = AnyEvent->timer (after => $timeout || 4, cb => sub {
40     clear_buffer_temporaries ($buffer);
41     $temporary_timer = undef;
42     });
43     }
44    
45 elmex 1.8 sub on_reply {
46     my ($id, $cb) = @_;
47     push @{$on_reply{$id}}, $cb;
48     }
49    
50     sub do_reply {
51     my ($id, $status, $data) = @_;
52     for my $cb (@{$on_reply{$id} || []}) {
53     $cb->($status, $data);
54     }
55     delete $on_reply{$id};
56     }
57    
58 elmex 1.10 sub print_temporary_line {
59     my ($buffer, $line, $timeout) = @_;
60     $buffer = current_buffer () unless defined $buffer;
61     unshift @$line, 't';
62     printline ($buffer, $line);
63     if ($timeout) {
64     start_temporary_killer ($buffer);
65     }
66     }
67    
68 elmex 1.4 sub write_chatline {
69 elmex 1.9 my ($buffer, $id, $time, $msg, $is_echo, $type, $msg_scope, $highlight) = @_;
70 elmex 1.8 my ($host, $nick) = get_id_parts ($id);
71    
72     my $nick_color =
73     $is_echo
74 elmex 1.10 ? 0
75 elmex 1.8 : (
76 elmex 1.9 $msg_scope eq 'private'
77 elmex 1.8 ? 4
78 elmex 1.10 : ($highlight ? 70 : 7)
79 elmex 1.8 );
80 elmex 1.11 my $ts = POSIX::strftime ("%T", localtime ($time));
81 elmex 1.8
82     my ($adel, $bdel) = ('<', '>');
83 elmex 1.9 if ($type eq 'notice') {
84 elmex 1.8 ($adel, $bdel) = ('{', '}');
85     }
86    
87 elmex 1.11 my (@chatline) = (
88     ("p".(length ($ts) + 4 + length ($nick))),
89     # 0, "[$host] ",
90     0, $ts,
91     0, " $adel",
92     $nick_color, "$nick",
93     0, "$bdel ",
94     0, $msg);
95 elmex 1.8
96 elmex 1.4 printline ($buffer, \@chatline);
97     }
98 elmex 1.3
99 elmex 1.7 sub write_infoline {
100     my ($buffer, $time, $msg) = @_;
101 elmex 1.8 unless (defined $buffer) {
102     write_infoline (status => $time, $msg);
103     write_infoline (current_buffer () => $time, $msg) if current_buffer () ne 'status';
104     return;
105     }
106    
107 elmex 1.11 my $ts = POSIX::strftime ("%T", localtime ($time || time ()));
108 elmex 1.7 my (@chatline) = (("p".length $ts), 0, $ts, 0, " ", 3, $msg);
109     printline ($buffer, \@chatline);
110     }
111    
112 elmex 1.8 sub write_errorline {
113     my ($buffer, $time, $msg) = @_;
114     unless (defined $buffer) {
115     write_errorline (status => $time, $msg);
116     write_errorline (current_buffer () => $time, $msg) if current_buffer () ne 'status';
117     return;
118     }
119    
120 elmex 1.11 my $ts = POSIX::strftime ("%T", localtime ($time || time ()));
121 elmex 1.8 my (@chatline) = (("p".length $ts), 0, $ts, 0, " ", 68, "ERROR: ", 4, $msg);
122     printline ($buffer, \@chatline);
123     }
124    
125 elmex 1.3 sub load_cfg {
126     $CFG ||= {};
127     return unless -e "$ENV{HOME}/.jsonircclrc";
128     open CFGH, "<", "$ENV{HOME}/.jsonircclrc" or die "Couldn't open ~/.jsonircclrc: $!";
129     $::CFG = JSON::Syck::Load (do { local $/; <CFGH> });
130     }
131    
132 elmex 1.8 sub get_first_highlight {
133 elmex 1.10 return $highlight[0];
134 elmex 1.8 }
135    
136 elmex 1.6 sub maybe_pop_highlight {
137     my ($buffer) = @_;
138 elmex 1.10 @highlight = grep { $buffer ne $_ } @highlight;
139     printline (msgline => [map { (103, $_, 0, ' ') } @highlight]);
140 elmex 1.6 }
141    
142     sub push_highlight {
143     my ($id) = @_;
144    
145 elmex 1.10 unless (grep { $_ eq $id } (@highlight, current_buffer ())) {
146     push @highlight, $id;
147     printline (msgline => [map { (103, $_, 0, ' ') } @highlight]);
148 elmex 1.6 }
149     }
150    
151 elmex 1.12 sub set_buffer_attr {
152     my ($buf, $attr, $flag) = @_;
153     if (defined $flag) {
154     $buffer_attrs{$buf}->{$attr} = $flag;
155     } else {
156     $buffer_attrs{$buf}->{$attr} = not $buffer_attrs{$buf}->{$attr};
157     }
158     update_buffer_statusline ($buf);
159     }
160    
161     sub update_buffer_statusline {
162     my ($buf) = @_;
163    
164     my @add_info;
165     if ($buf =~ /^jsirc:/) {
166     my $u = URI->new ($buf);
167     my @ps = $u->path_segments ();
168     push @add_info,
169     11, '{'.$u->scheme.'} ',
170     14, $ps[1],
171     11, '@', 13, $u->authority;
172     }
173     push @add_info, 76, " [inhib act]" if $buffer_attrs{$buf}->{inhibit_highlight};
174     push @add_info, 12, " [highlight act]" if $buffer_attrs{$buf}->{highlight_activity};
175     printline (statusline => [11, "$buf | ", @add_info, 'f', 11, ""]);
176     }
177    
178 elmex 1.6 sub change_buffer {
179     my ($new_buf) = @_;
180     maybe_pop_highlight ($new_buf);
181     select_buffer ($new_buf);
182 elmex 1.12 update_buffer_statusline ($new_buf);
183 elmex 1.6 }
184    
185 elmex 1.8 sub get_id_parts {
186 elmex 1.6 my ($id) = @_;
187     my $uri = URI->new ($id);
188     my $a = $uri->authority;
189     my $p = ($uri->path_segments ())[1];
190 elmex 1.8 ($a, $p)
191     }
192    
193     sub prettyfy_id {
194     my ($id) = @_;
195     my ($a, $p) = get_id_parts ($id);
196 elmex 1.6 "$a/$p"
197     }
198    
199 elmex 1.8 sub protocolize_id {
200     my ($pretty_id) = @_;
201     if ($pretty_id =~ m/^([^\/]+)\/?(.*)$/) {
202     my ($auth, $path) = ($1, $2);
203     my $uri = URI->new;
204 elmex 1.10 $uri->scheme ('jsirc');
205 elmex 1.8 $uri->authority ($auth);
206     $uri->path ($path);
207     return "$uri";
208     }
209     undef
210     }
211    
212     sub connect_json {
213     eval {
214     $js->connect ($1 || $HOST, $2 || $PORT);
215     };
216     if ($@) {
217     write_errorline (undef, undef, "Error on connect to jsonsrv at $HOST:$PORT: $@");
218     } else {
219     write_infoline (undef, undef, "Connected to jsonsrv at $HOST:$PORT.");
220     }
221     }
222    
223 elmex 1.3 load_cfg ();
224    
225 elmex 1.2 my $c = AnyEvent->condvar;
226 elmex 1.1
227 elmex 1.2 #timer ();
228 elmex 1.1
229     $js =
230 elmex 1.6 JSONClientConnection->new (
231     packet_cb => sub {
232     my ($js, $data) = @_;
233     require JSON::Syck;
234    
235 elmex 1.9 if ($data->{type} eq 'message' or $data->{type} eq 'notice') {
236 elmex 1.6 my ($src_id) = ($data->{src});
237    
238 elmex 1.8 my $highlight = 0;
239 elmex 1.12 unless ($buffer_attrs{$src_id}->{inhibit_highlight}) {
240     if ($buffer_attrs{$src_id}->{highlight_activity}
241     or $data->{msg_scope} eq 'private')
242     {
243     push_highlight ($src_id);
244     } else {
245     for (@{$::CFG->{highlight}}) {
246     if ($data->{message} =~ m/$_/) {
247     push_highlight ($src_id);
248     $highlight = 1;
249     last;
250     }
251 elmex 1.6 }
252     }
253     }
254    
255 elmex 1.9 write_chatline ($src_id, $data->{from}->{id}, $data->{timestamp}, $data->{message}, $data->{is_echo}, $data->{type}, $data->{msg_scope}, $highlight);
256 elmex 1.7
257 elmex 1.8 } elsif ($data->{type} eq 'subid') {
258 elmex 1.7 my $src_id = $data->{src};
259 elmex 1.8 my $it = $data->{command};
260    
261     if ($it eq 'add') {
262     for (@{$data->{ids}}) {
263     my ($h, $n) = get_id_parts ($_);
264     $buffer_nicks{$src_id}->{$n} = 1;
265     }
266     write_infoline ($src_id, $data->{timestamp},
267 elmex 1.10 "sub id add: " . join (', ', map { prettyfy_id ($_) } sort @{$data->{ids}}));
268 elmex 1.8
269     } elsif ($it eq 'remove') {
270     for (@{$data->{ids}}) {
271     my ($h, $n) = get_id_parts ($_);
272     delete $buffer_nicks{$src_id}->{$n};
273     }
274     write_infoline ($src_id, $data->{timestamp},
275 elmex 1.10 "sub id remove: " . join (', ', map { prettyfy_id ($_) } sort @{$data->{ids}}));
276 elmex 1.8 } elsif ($it eq 'change') {
277     my ($oh, $on) = get_id_parts ($data->{old_id});
278     delete $buffer_nicks{$src_id}->{$on};
279     my ($h, $n) = get_id_parts ($data->{new_id});
280     $buffer_nicks{$src_id}->{$n} = 1;
281    
282     write_infoline ($src_id, $data->{timestamp},
283     "sub id change: " . prettyfy_id ($data->{old_id}) . " => " . prettyfy_id ($data->{new_id}));
284    
285     } elsif ($it eq 'list') {
286     $buffer_nicks{$src_id} = {};
287     for (@{$data->{ids}}) {
288     my ($h, $n) = get_id_parts ($_);
289     $buffer_nicks{$src_id}->{$n} = 1
290     }
291     write_infoline ($src_id, $data->{timestamp},
292 elmex 1.10 "sub id list: " . join (', ', map { prettyfy_id ($_) } sort @{$data->{ids}}));
293 elmex 1.7
294    
295     } elsif ($it eq 'special') {
296 elmex 1.8 write_infoline ($src_id, $data->{timestamp}, "[$data->{message}]");
297 elmex 1.7 }
298    
299 elmex 1.6 } elsif ($data->{type} eq 'info') {
300 elmex 1.8 write_infoline (undef, $data->{timestamp} => $data->{message});
301     do_reply ($data->{id}, info => $data);
302    
303 elmex 1.6 } elsif ($data->{type} eq 'error') {
304 elmex 1.8 do_reply ($data->{id}, 'error' => $data);
305     write_errorline (undef, $data->{timestamp}, "$data->{error_type}: $data->{message}");
306    
307     } elsif ($data->{type} eq 'reply') {
308     do_reply ($data->{id}, 'reply' => $data);
309 elmex 1.6 }
310    
311     printline (debug => [0, JSON::Syck::Dump ($data)]);
312     },
313     disconnect_cb => sub {
314 elmex 1.8 write_errorline (undef, undef, "Lost connection to jsonsrv: $_[0]");
315 elmex 1.2 }
316 elmex 1.6 );
317 elmex 1.1
318 elmex 1.2 CursesChatMainwindow::init;
319 elmex 1.1
320 elmex 1.8 change_buffer ('status');
321     connect_json;
322 elmex 1.2
323 elmex 1.4 sub find_common_prefix {
324     my (@words) = @_;
325     @words = sort { length ($a) <=> length ($b) } @words;
326     my $shortest = $words[0];
327    
328     while ($shortest ne '') {
329     my $no_match = 0;
330     for (@words) {
331     unless (/^\Q$shortest\E/) {
332     $no_match = 1;
333     last;
334     }
335     }
336    
337     return $shortest if not $no_match;
338     substr $shortest, -1, 1, '';
339     }
340    
341     return '';
342     }
343    
344     CursesChatMainwindow::register_complete_cb (sub {
345 elmex 1.10 my ($word, $idx, @line) = @_;
346 elmex 1.4
347     # TODO: make completion cycling with $first_compl
348 elmex 1.10 #d# printline (undef, [0, "[$idx] [$word]"]);
349 elmex 1.4
350     my @found;
351 elmex 1.6
352 elmex 1.4 if ($idx == 0) {
353 elmex 1.8 for (keys %{$buffer_nicks{current_buffer ()} || {}}) {
354     my $n = $_ . ":";
355     if ($n =~ /^\Q$word\E/) {
356     push @found, $n;
357     }
358     }
359    
360 elmex 1.4 for (keys %completion) {
361     if (/^\Q$word\E/) {
362     push @found, $_;
363     }
364     }
365 elmex 1.6
366 elmex 1.4 } else {
367     my %buffers = map { $_ => 1 } list_buffers;
368 elmex 1.6
369 elmex 1.8 for (keys %{$buffer_nicks{current_buffer ()} || {}}) {
370 elmex 1.10 if (/^\Q$word\E/) {
371     push @found, $_;
372 elmex 1.8 }
373     }
374    
375     for (keys %buffers) {
376 elmex 1.10 if (m/^jsirc:/) {
377 elmex 1.9 my $pi = prettyfy_id ($_);
378     if ($pi =~ /^\Q$word\E/) {
379     push @found, $pi;
380     }
381     } else {
382 elmex 1.8 if (/^\Q$word\E/) {
383     push @found, $_;
384     }
385 elmex 1.4 }
386     }
387     }
388 elmex 1.6
389 elmex 1.4 return "$found[0] " if @found == 1;
390 elmex 1.6
391 elmex 1.11 if (@found > 10) {
392 elmex 1.10 my $longest;
393     for (@found) { $longest = length $_ > $longest ? length $_ : $longest }
394    
395     my %first_chars;
396     my $len = 1;
397     while ((keys %first_chars) <= 1 && $len < $longest) {
398     %first_chars = ();
399     for (@found) { $first_chars{(substr $_, 0, $len)} = 1 }
400     $len++;
401     }
402    
403     print_temporary_line (undef, [t => 7, "$word: ", map { (3, "$_-", 0, ', ') } sort keys %first_chars], 1);
404     return find_common_prefix (keys %first_chars);
405    
406     } elsif (@found) {
407     print_temporary_line (undef, [t => 7, "$word: ", map { (3, $_, 0, ', ') } @found], 1);
408 elmex 1.4 return find_common_prefix (@found);
409     }
410    
411     return $word;
412     });
413    
414 elmex 1.2 CursesChatMainwindow::register_input_cb (sub {
415 elmex 1.3 my ($input, $escape) = @_;
416    
417     unless (defined $input) {
418     if (exists $CFG->{buffers}->{$escape}) {
419 elmex 1.6 change_buffer (my $buf = $CFG->{buffers}->{$escape} || 'status');
420 elmex 1.2 } else {
421 elmex 1.6 change_buffer ('status');
422 elmex 1.1 }
423 elmex 1.3 return;
424     }
425    
426 elmex 1.8 if ($input =~ m/^\/goto\s*(\S+)/) {
427     my $buf = $1;
428 elmex 1.10 if ($buf =~ m/^[^\/:]+\/\S*$/) {
429 elmex 1.8 change_buffer (protocolize_id ($buf));
430     } else {
431     change_buffer ("$buf");
432     }
433 elmex 1.6
434 elmex 1.8 } elsif ($input =~ m/^\/kill\s*(\S+)/) {
435     change_buffer ('status') if "$1" eq current_buffer ();
436     if (clear_buffer ("$1") or "$1" eq current_buffer ()) {
437     write_infoline (undef, undef, "Killed buffer '$1'.");
438     }
439    
440     } elsif ($input =~ m/^\/buffers/) {
441 elmex 1.10 print_temporary_line (undef, [0, "buffers:"]);
442 elmex 1.9 for (sort { $a cmp $b } (list_buffers ())) {
443 elmex 1.10 if (/^jsirc:/) {
444     print_temporary_line (undef, ['p12', 0, sprintf "- (%6s) | %s", 'jsirc', prettyfy_id ($_)]);
445 elmex 1.9 } else {
446 elmex 1.10 print_temporary_line (undef, ['p12', 0, sprintf "- (%6s) | %s", 'other', $_]);
447 elmex 1.9 }
448 elmex 1.4 }
449 elmex 1.6
450 elmex 1.2 } elsif ($input =~ m/^\/colors/) {
451     CursesChatMainwindow::print_colors;
452 elmex 1.6
453 elmex 1.10 } elsif ($input =~ m/^\/clear_temporaries/) {
454     clear_buffer_temporaries (current_buffer ());
455    
456 elmex 1.12 } elsif ($input =~ m/^\/toggle_inhibit_highlight/) {
457     set_buffer_attr (current_buffer (), 'inhibit_highlight');
458    
459     } elsif ($input =~ m/^\/toggle_highlight_activity/) {
460     set_buffer_attr (current_buffer (), 'highlight_activity');
461    
462 elmex 1.6 } elsif ($input =~ m/^\/reconnect\s*(\S*)\s*(\S*)/) {
463 elmex 1.8 connect_json;
464    
465     } elsif ($input =~ m/^\/raw\s+(.*)$/) {
466     my $raw = $1;
467     my $dest_id = "" . current_buffer ();
468     unless ($dest_id =~ m/^[^:]+:/) {
469     write_errorline ($dest_id, undef, "Can't send regular messages in this buffer: '$dest_id'.");
470     return;
471     }
472    
473     my $msg = {
474     type => 'raw',
475     dest => $dest_id,
476     message => $raw,
477     id => $id_seq
478     };
479 elmex 1.6
480 elmex 1.8 $js->send_data ($msg);
481    
482     on_reply ($id_seq => sub {
483     if ($_[0] eq 'error') {
484     write_errorline ($dest_id, undef, "Couldn't send raw message: '$raw': $_[1]->{message}");
485     } else {
486     write_infoline ($dest_id, undef, "Sent raw message: '$raw'.");
487     }
488     });
489    
490     $id_seq++;
491 elmex 1.6 } elsif ($input =~ m/^\/reload/) {
492     load_cfg ();
493    
494     } elsif ($input =~ m/^\/remote_reload/) {
495 elmex 1.8 $js->send_data ({ type => 'command', command => 'reload', id => $id_seq });
496     on_reply ($id_seq => sub { write_infoline (undef, undef, "reloaded jsonsrv") });
497     $id_seq++;
498    
499     } elsif ($input =~ m/^\/pop/) {
500     my $buf = get_first_highlight ();
501     if (my $buf = get_first_highlight ()) {
502     change_buffer ($buf);
503     } else {
504     write_errorline (current_buffer (), undef, "There are no highlights to pop.");
505     }
506    
507     } elsif ($input =~ m/^\//) {
508     write_errorline (current_buffer (), undef, "Not a recognized command: '$input'");
509 elmex 1.6
510 elmex 1.2 } else {
511 elmex 1.8 my $dest_id = "" . current_buffer ();
512     unless ($dest_id =~ m/^[^:]+:/) {
513     write_errorline ($dest_id, undef, "Can't send regular messages in this buffer: '$dest_id'.");
514     return;
515     }
516 elmex 1.6
517 elmex 1.4 my $msg = {
518 elmex 1.3 type => 'message',
519 elmex 1.4 dest => $dest_id,
520 elmex 1.8 message => $input,
521     id => $id_seq
522 elmex 1.4 };
523 elmex 1.8
524 elmex 1.4 $js->send_data ($msg);
525     printline (debug => [0, JSON::Syck::Dump ($msg)]);
526 elmex 1.8
527     on_reply ($id_seq => sub {
528     if ($_[0] eq 'error') {
529     write_errorline ($dest_id, time, "Couldn't send message: '$input': $_[1]->{message}");
530     }
531     });
532    
533     $id_seq++;
534 elmex 1.1 }
535 elmex 1.2 });
536 elmex 1.1
537     $c->wait;
538    
539 elmex 1.2 CursesChatMainwindow::end;