[ViewVC] Annotation of: cvs/Net-IRC3/samples/jsonclient

#!/opt/perl/bin/perl
use strict;
use utf8;
use URI;
use JSONConnection;
use JSON::Syck;
use POSIX qw(strftime);
use CursesChatMainwindow;

our $id_seq = 0;

my $HOST = 'localhost';
my $PORT = 1236;

our $temporary_timer;

our @highlight;
our $CFG;
our $js;
our %completion = map { $_ => 1 } qw{
   /goto
   /kill
   /colors
   /clear_temporaries
   /buffers
   /reload
   /remote_reload
   /reconnect
   /pop
};

our %buffer_nicks;

our %on_reply;

my $d = 0;
my $wt;
sub timer {
   $wt = AnyEvent->timer (after => 3, cb => sub {
      printline (status => [0, "TEST $d"]); $d++;
      timer ();
   });
}

sub start_temporary_killer {
   my ($buffer, $timeout) = @_;
   $::temporary_timer = AnyEvent->timer (after => $timeout || 4, cb => sub {
      clear_buffer_temporaries ($buffer);
      $temporary_timer = undef;
   });
}

sub search_buffer {
   my ($id) = @_;

   for (keys %{$::CFG->{buffers}}) {
      if ($::CFG->{buffers}->{$_} eq $id) {
         return $_;
      }
   }

   return undef
}

sub on_reply {
   my ($id, $cb) = @_;
   push @{$on_reply{$id}}, $cb;
}

sub do_reply {
   my ($id, $status, $data) = @_;
   for my $cb (@{$on_reply{$id} || []}) {
      $cb->($status, $data);
   }
   delete $on_reply{$id};
}

sub print_temporary_line {
   my ($buffer, $line, $timeout) = @_;
   $buffer = current_buffer () unless defined $buffer;
   unshift @$line, 't';
   printline ($buffer, $line);
   if ($timeout) {
      start_temporary_killer ($buffer);
   }
}

sub write_chatline {
   my ($buffer, $id, $time, $msg, $is_echo, $type, $msg_scope, $highlight) = @_;
   my ($host, $nick) = get_id_parts ($id);

   my $nick_color =
      $is_echo
         ? 0
         : (
            $msg_scope eq 'private'
               ? 4
               : ($highlight ? 70 : 7)
         );
   my $ts = POSIX::strftime ("%T", localtime ($time));

   my ($adel, $bdel) = ('<', '>');
   if ($type eq 'notice') {
      ($adel, $bdel) = ('{', '}');
   }

   my (@chatline) = (
      ("p".(length ($ts) + 4 + length ($nick))),
 #     0, "[$host] ",
      0, $ts,
      0, " $adel",
      $nick_color, "$nick",
      0, "$bdel ",
      0, $msg);

   printline ($buffer, \@chatline);
}

sub write_infoline {
   my ($buffer, $time, $msg) = @_;
   unless (defined $buffer) {
     write_infoline (status            => $time, $msg);
     write_infoline (current_buffer () => $time, $msg) if current_buffer () ne 'status';
     return;
   }

   my $ts = POSIX::strftime ("%T", localtime ($time || time ()));
   my (@chatline) = (("p".length $ts), 0, $ts, 0, " ", 3, $msg);
   printline ($buffer, \@chatline);
}

sub write_errorline {
   my ($buffer, $time, $msg) = @_;
   unless (defined $buffer) {
     write_errorline (status            => $time, $msg);
     write_errorline (current_buffer () => $time, $msg) if current_buffer () ne 'status';
     return;
   }

   my $ts = POSIX::strftime ("%T", localtime ($time || time ()));
   my (@chatline) = (("p".length $ts), 0, $ts, 0, " ", 68, "ERROR: ", 4, $msg);
   printline ($buffer, \@chatline);
}


sub load_cfg {
   $CFG ||= {};
   return unless -e "$ENV{HOME}/.jsonircclrc";
   open CFGH, "<", "$ENV{HOME}/.jsonircclrc" or die "Couldn't open ~/.jsonircclrc: $!";
   $::CFG = JSON::Syck::Load (do { local $/; <CFGH> });
}

sub get_first_highlight {
   return $highlight[0];
}

sub maybe_pop_highlight {
   my ($buffer) = @_;
   @highlight = grep { $buffer ne $_ } @highlight;
   printline (msgline => [map { (103, $_, 0, ' ') } @highlight]);
}

sub push_highlight {
   my ($id) = @_;

   unless (grep { $_ eq $id } (@highlight, current_buffer ())) {
      push @highlight, $id;
      printline (msgline => [map { (103, $_, 0, ' ') } @highlight]);
   }
}

sub change_buffer {
   my ($new_buf) = @_;
   maybe_pop_highlight ($new_buf);
   select_buffer ($new_buf);

   my $add_info = "";
   if ($new_buf =~ /^jsirc:/) {
      my $u = URI->new ($new_buf);
      $add_info = sprintf " {%s} %s@%s", $u->scheme, ($u->path_segments ())[1], $u->authority;
   }
   printline (statusline => ['f', 56, "$new_buf |$add_info"]);
}

sub get_id_parts {
   my ($id) = @_;
   my $uri = URI->new ($id);
   my $a = $uri->authority;
   my $p = ($uri->path_segments ())[1];
   ($a, $p)
}

sub prettyfy_id {
   my ($id) = @_;
   my ($a, $p) = get_id_parts ($id);
   "$a/$p"
}

sub protocolize_id {
   my ($pretty_id) = @_;
   if ($pretty_id =~ m/^([^\/]+)\/?(.*)$/) {
      my ($auth, $path) = ($1, $2);
      my $uri = URI->new;
      $uri->scheme ('jsirc');
      $uri->authority ($auth);
      $uri->path ($path);
      return "$uri";
   }
   undef
}

sub connect_json {
   eval {
      $js->connect ($1 || $HOST, $2 || $PORT);
   };
   if ($@) {
      write_errorline (undef, undef, "Error on connect to jsonsrv at $HOST:$PORT: $@");
   } else {
      write_infoline (undef, undef, "Connected to jsonsrv at $HOST:$PORT.");
   }
}

load_cfg ();

my $c = AnyEvent->condvar;

#timer ();

$js =
   JSONClientConnection->new (
      packet_cb => sub {
         my ($js, $data) = @_;
         require JSON::Syck;

         if ($data->{type} eq 'message' or $data->{type} eq 'notice') {
            my ($src_id) = ($data->{src});

            my $highlight = 0;
            if ($data->{msg_scope} eq 'private') {
               push_highlight ($src_id);
            } else {
               for (@{$::CFG->{highlight}}) {
                  if ($data->{message} =~ m/$_/) {
                     push_highlight ($src_id);
                     $highlight = 1;
                     last;
                  }
               }
            }

            write_chatline ($src_id, $data->{from}->{id}, $data->{timestamp}, $data->{message}, $data->{is_echo}, $data->{type}, $data->{msg_scope}, $highlight);

         } elsif ($data->{type} eq 'subid') {
            my $src_id = $data->{src};
            my $it = $data->{command};

            if ($it eq 'add') {
               for (@{$data->{ids}}) {
                  my ($h, $n) = get_id_parts ($_);
                  $buffer_nicks{$src_id}->{$n} = 1;
               }
               write_infoline ($src_id, $data->{timestamp},
                  "sub id add: " . join (', ', map { prettyfy_id ($_) } sort @{$data->{ids}}));

            } elsif ($it eq 'remove') {
               for (@{$data->{ids}}) {
                  my ($h, $n) = get_id_parts ($_);
                  delete $buffer_nicks{$src_id}->{$n};
               }
               write_infoline ($src_id, $data->{timestamp},
                  "sub id remove: " . join (', ', map { prettyfy_id ($_) } sort @{$data->{ids}}));
            } elsif ($it eq 'change') {
               my ($oh, $on) = get_id_parts ($data->{old_id});
               delete $buffer_nicks{$src_id}->{$on};
               my ($h, $n) = get_id_parts ($data->{new_id});
               $buffer_nicks{$src_id}->{$n} = 1;

               write_infoline ($src_id, $data->{timestamp},
                  "sub id change: " . prettyfy_id ($data->{old_id}) . " => " . prettyfy_id ($data->{new_id}));

            } elsif ($it eq 'list') {
               $buffer_nicks{$src_id} = {};
               for (@{$data->{ids}}) {
                  my ($h, $n) = get_id_parts ($_);
                  $buffer_nicks{$src_id}->{$n} = 1
               }
               write_infoline ($src_id, $data->{timestamp},
                  "sub id list: " . join (', ', map { prettyfy_id ($_) } sort @{$data->{ids}}));


            } elsif ($it eq 'special') {
               write_infoline ($src_id, $data->{timestamp}, "[$data->{message}]");
            }

         } elsif ($data->{type} eq 'info') {
            write_infoline (undef, $data->{timestamp} => $data->{message});
            do_reply ($data->{id}, info => $data);

         } elsif ($data->{type} eq 'error') {
            do_reply ($data->{id}, 'error' => $data);
            write_errorline (undef, $data->{timestamp}, "$data->{error_type}: $data->{message}");

         } elsif ($data->{type} eq 'reply') {
            do_reply ($data->{id}, 'reply' => $data);
         }

         printline (debug => [0, JSON::Syck::Dump ($data)]);
      },
      disconnect_cb => sub {
         write_errorline (undef, undef, "Lost connection to jsonsrv: $_[0]");
      }
   );

CursesChatMainwindow::init;

change_buffer ('status');
connect_json;

sub find_common_prefix {
   my (@words) = @_;
   @words = sort { length ($a) <=> length ($b) } @words;
   my $shortest = $words[0];

   while ($shortest ne '') {
      my $no_match = 0;
      for (@words) {
         unless (/^\Q$shortest\E/) {
            $no_match = 1;
            last;
         }
      }

      return $shortest if not $no_match;
      substr $shortest, -1, 1, '';
   }

   return '';
}

CursesChatMainwindow::register_complete_cb (sub {
   my ($word, $idx, @line) = @_;

   # TODO: make completion cycling with $first_compl
   #d# printline (undef, [0, "[$idx] [$word]"]);

   my @found;

   if ($idx == 0) {
      for (keys %{$buffer_nicks{current_buffer ()} || {}}) {
         my $n = $_ . ":";
         if ($n =~ /^\Q$word\E/) {
            push @found, $n;
         }
      }

      for (keys %completion) {
         if (/^\Q$word\E/) {
            push @found, $_;
         }
      }

   } else {
      my %buffers = map { $_ => 1 } list_buffers;

      for (keys %{$buffer_nicks{current_buffer ()} || {}}) {
         if (/^\Q$word\E/) {
            push @found, $_;
         }
      }

      for (keys %buffers) {
         if (m/^jsirc:/) {
            my $pi = prettyfy_id ($_);
            if ($pi =~ /^\Q$word\E/) {
               push @found, $pi;
            }
         } else {
            if (/^\Q$word\E/) {
               push @found, $_;
            }
         }
      }
   }

   return "$found[0] " if @found == 1;

   if (@found > 10) {
      my $longest;
      for (@found) { $longest = length $_ > $longest ? length $_ : $longest }

      my %first_chars;
      my $len = 1;
      while ((keys %first_chars) <= 1 && $len < $longest) {
         %first_chars = ();
         for (@found) { $first_chars{(substr $_, 0, $len)} = 1 }
         $len++;
      }

      print_temporary_line (undef, [t => 7, "$word: ", map { (3, "$_-", 0, ', ') } sort keys %first_chars], 1);
      return find_common_prefix (keys %first_chars);

   } elsif (@found) {
      print_temporary_line (undef, [t => 7, "$word: ", map { (3, $_, 0, ', ') } @found], 1);
      return find_common_prefix (@found);
   }

   return $word;
});

CursesChatMainwindow::register_input_cb (sub {
   my ($input, $escape) = @_;

   unless (defined $input) {
      if (exists $CFG->{buffers}->{$escape}) {
         change_buffer (my $buf = $CFG->{buffers}->{$escape} || 'status');
      } else {
         change_buffer ('status');
      }
      return;
   }

   if ($input =~ m/^\/goto\s*(\S+)/) {
      my $buf = $1;
      if ($buf =~ m/^[^\/:]+\/\S*$/) {
         change_buffer (protocolize_id ($buf));
      } else {
         change_buffer ("$buf");
      }

   } elsif ($input =~ m/^\/kill\s*(\S+)/) {
      change_buffer ('status') if "$1" eq current_buffer ();
      if (clear_buffer ("$1") or "$1" eq current_buffer ()) {
         write_infoline (undef, undef, "Killed buffer '$1'.");
      }

   } elsif ($input =~ m/^\/buffers/) {
      print_temporary_line (undef, [0, "buffers:"]);
      for (sort { $a cmp $b } (list_buffers ())) {
         if (/^jsirc:/) {
            print_temporary_line (undef, ['p12', 0, sprintf "- (%6s) | %s", 'jsirc', prettyfy_id ($_)]);
         } else {
            print_temporary_line (undef, ['p12', 0, sprintf "- (%6s) | %s", 'other', $_]);
         }
      }

   } elsif ($input =~ m/^\/colors/) {
      CursesChatMainwindow::print_colors;

   } elsif ($input =~ m/^\/clear_temporaries/) {
      clear_buffer_temporaries (current_buffer ());

   } elsif ($input =~ m/^\/reconnect\s*(\S*)\s*(\S*)/) {
      connect_json;

   } elsif ($input =~ m/^\/raw\s+(.*)$/) {
      my $raw = $1;
      my $dest_id = "" . current_buffer ();
      unless ($dest_id =~ m/^[^:]+:/) {
         write_errorline ($dest_id, undef, "Can't send regular messages in this buffer: '$dest_id'.");
         return;
      }

      my $msg = {
         type => 'raw',
         dest => $dest_id,
         message => $raw,
         id => $id_seq
      };

      $js->send_data ($msg);

      on_reply ($id_seq => sub {
         if ($_[0] eq 'error') {
            write_errorline ($dest_id, undef, "Couldn't send raw message: '$raw': $_[1]->{message}");
         } else {
            write_infoline ($dest_id, undef, "Sent raw message: '$raw'.");
         }
      });

      $id_seq++;
   } elsif ($input =~ m/^\/reload/) {
      load_cfg ();

   } elsif ($input =~ m/^\/remote_reload/) {
      $js->send_data ({ type => 'command', command => 'reload', id => $id_seq });
      on_reply ($id_seq => sub { write_infoline (undef, undef, "reloaded jsonsrv") });
      $id_seq++;

   } elsif ($input =~ m/^\/pop/) {
      my $buf = get_first_highlight ();
      if (my $buf = get_first_highlight ()) {
         change_buffer ($buf);
      } else {
         write_errorline (current_buffer (), undef, "There are no highlights to pop.");
      }

   } elsif ($input =~ m/^\//) {
      write_errorline (current_buffer (), undef, "Not a recognized command: '$input'");

   } else {
      my $dest_id = "" . current_buffer ();
      unless ($dest_id =~ m/^[^:]+:/) {
         write_errorline ($dest_id, undef, "Can't send regular messages in this buffer: '$dest_id'.");
         return;
      }

      my $msg = {
         type => 'message',
         dest => $dest_id,
         message => $input,
         id => $id_seq
      };

      $js->send_data ($msg);
      printline (debug => [0, JSON::Syck::Dump ($msg)]);

      on_reply ($id_seq => sub {
         if ($_[0] eq 'error') {
            write_errorline ($dest_id, time, "Couldn't send message: '$input': $_[1]->{message}");
         }
      });

      $id_seq++;
   }
});

$c->wait;

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