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

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

our @highlight;
our $CFG;
our %known_ids;
our %rev_known_ids;
our $js;
our %completion = map { $_ => 1 } qw{
   /buffer
   /colors
   /list_buffers
   /reload        /remote_reload /reconnect
};

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

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

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

   return undef
}

sub write_chatline {
   my ($buffer, $nick, $time, $msg, $mode) = @_;
   my $nick_color = $mode eq 'local' ? 7 : ($mode eq 'private' ? 4 : 0);
   my $ts = '[' . POSIX::strftime ("%T", localtime ($time)) . ']';
   my (@chatline) = (("p".length $ts), 0, $ts, 0, " <", $nick_color, "$nick", 0, "> ", 0, $msg);
   printline ($buffer, \@chatline);
}

sub write_infoline {
   my ($buffer, $time, $msg) = @_;
   my $ts = '[' . POSIX::strftime ("%T", localtime ($time)) . ']';
   my (@chatline) = (("p".length $ts), 0, $ts, 0, " ", 3, $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 maybe_pop_highlight {
   my ($buffer) = @_;
   @highlight = grep { $buffer ne $_->[0] } @highlight;
   printline (msgline => [map { (103, $_->[1] || $_->[0], 0, ' ') } @highlight]);
}

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

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

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

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

load_cfg ();

my $c = AnyEvent->condvar;

#timer ();

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

         if ($data->{type} eq 'message') {
            my ($src_id) = ($data->{src});
            my $pretty_id = prettyfy_id ($src_id);
            $known_ids{$src_id}->{send_id} = $data->{to}->{id};

            if ($data->{msg_type} eq 'private') {
               push_highlight ($pretty_id);
            } else {
               for (@{$::CFG->{highlight}}) {
                  if ($data->{message} =~ m/$_/) {
                     push_highlight ($pretty_id);
                  }
               }
            }

            write_chatline ($pretty_id, prettyfy_id ($data->{from}->{id}), $data->{timestamp}, $data->{message}, $data->{msg_type});

         } elsif ($data->{type} eq 'metainfo') {
            my $src_id = $data->{src};
            my $pretty_id = prettyfy_id ($src_id);
            my $it = $data->{info_type};

            if ($it eq 'add_ids') {
               write_infoline ($pretty_id, $data->{timestamp},
                  "channel add: " . join (', ', map { prettyfy_id ($_) } @{$data->{ids}}));

            } elsif ($it eq 'remove_ids') {
               write_infoline ($pretty_id, $data->{timestamp},
                  "channel remove: " . join (', ', map { prettyfy_id ($_) } @{$data->{ids}}));

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

         } elsif ($data->{type} eq 'info') {
            printline (status => [3, 'INFO: ' . $data->{message}]);
         } elsif ($data->{type} eq 'error') {
            printline (status => [4, 'INFO: ' . $data->{message}]);
         }

         printline (debug => [0, JSON::Syck::Dump ($data)]);
      },
      disconnect_cb => sub {
         printline (status => [4, "ERROR: " . $_[0]]);
      }
   );

$js->connect (localhost => 1236);

CursesChatMainwindow::init;

printline (status => ['p0', 0, "Connected!"]);
printline (statusline => [20, "Welcome to the json enhanced chat framework!"]);

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, $first_compl, $idx, @line) = @_;

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

   my @found;

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

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

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

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

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

   if (@found) {
      printline (undef, [0, "$word: " . join ", ", @found]);
      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');
         printline (statusline => [20, "[$buf]"]);
      } else {
         change_buffer ('status');
         printline (statusline => [20, "[status]"]);
      }
      return;
   }

   if ($input =~ m/^\/buffer\s*(\S+)/) {
      change_buffer ("$1");
      printline (statusline => [20, "[$1]"]);

   } elsif ($input =~ m/^\/list_buffers/) {
      printline (undef, [0, "buffers:"]);
      for (list_buffers) {
         printline (undef, [0, "- $_"]);
      }

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

   } elsif ($input =~ m/^\/reconnect\s*(\S*)\s*(\S*)/) {
      $js->connect ($1 || 'localhost', $2 || 1236);
      printline (status => [3, "reconnected"]);

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

   } elsif ($input =~ m/^\/remote_reload/) {
      $js->send_data ({ type => 'command', command => 'reload' });

   } else {
      my $pret_id = "" . current_buffer ();
      my $dest_id = $rev_known_ids{$pret_id};

      my $msg = {
         type => 'message',
         dest => $dest_id,
         message => $input
      };
      $js->send_data ($msg);
      printline (debug => [0, JSON::Syck::Dump ($msg)]);
      my $mynick = $known_ids{$dest_id}->{send_id} ? prettyfy_id ($known_ids{$dest_id}->{send_id}) : "";
      write_chatline ($pret_id, $mynick, time, $input, 'local');
   }
});

$c->wait;

CursesChatMainwindow::end;
Revision:	1.7
Committed:	Mon Jan 15 17:41:42 2007 UTC (19 years, 8 months ago) by elmex
Branch:	MAIN
Changes since 1.6:	+26 -0 lines
Log Message:	just a minor change on the json chat
#	User	Rev	Content
1	elmex	1.1	#!/usr/bin/perl
2			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.6	our @highlight;
11	elmex	1.3	our $CFG;
12	elmex	1.4	our %known_ids;
13	elmex	1.6	our %rev_known_ids;
14	elmex	1.4	our $js;
15			our %completion = map { $_ => 1 } qw{
16	elmex	1.6	/buffer
17			/colors
18			/list_buffers
19			/reload /remote_reload /reconnect
20	elmex	1.4	};
21
22			my $d = 0;
23			my $wt;
24			sub timer {
25			$wt = AnyEvent->timer (after => 3, cb => sub {
26			printline (status => [0, "TEST $d"]); $d++;
27			timer ();
28			});
29			}
30
31	elmex	1.6	sub search_buffer {
32			my ($id) = @_;
33
34			for (keys %{$::CFG->{buffers}}) {
35			if ($::CFG->{buffers}->{$_} eq $id) {
36			return $_;
37			}
38			}
39
40			return undef
41			}
42
43	elmex	1.4	sub write_chatline {
44	elmex	1.6	my ($buffer, $nick, $time, $msg, $mode) = @_;
45			my $nick_color = $mode eq 'local' ? 7 : ($mode eq 'private' ? 4 : 0);
46			my $ts = '[' . POSIX::strftime ("%T", localtime ($time)) . ']';
47			my (@chatline) = (("p".length $ts), 0, $ts, 0, " <", $nick_color, "$nick", 0, "> ", 0, $msg);
48	elmex	1.4	printline ($buffer, \@chatline);
49			}
50	elmex	1.3
51	elmex	1.7	sub write_infoline {
52			my ($buffer, $time, $msg) = @_;
53			my $ts = '[' . POSIX::strftime ("%T", localtime ($time)) . ']';
54			my (@chatline) = (("p".length $ts), 0, $ts, 0, " ", 3, $msg);
55			printline ($buffer, \@chatline);
56			}
57
58
59	elmex	1.3	sub load_cfg {
60			$CFG \|\|= {};
61			return unless -e "$ENV{HOME}/.jsonircclrc";
62			open CFGH, "<", "$ENV{HOME}/.jsonircclrc" or die "Couldn't open ~/.jsonircclrc: $!";
63			$::CFG = JSON::Syck::Load (do { local $/; <CFGH> });
64			}
65
66	elmex	1.6	sub maybe_pop_highlight {
67			my ($buffer) = @_;
68			@highlight = grep { $buffer ne $_->[0] } @highlight;
69			printline (msgline => [map { (103, $_->[1] \|\| $_->[0], 0, ' ') } @highlight]);
70			}
71
72			sub push_highlight {
73			my ($id) = @_;
74
75			unless (grep { $_->[0] eq $id } (@highlight, [current_buffer ()])) {
76			push @highlight, [$id, search_buffer ($id)];
77			printline (msgline => [map { (103, $_->[1] \|\| $_->[0], 0, ' ') } @highlight]);
78			}
79			}
80
81			sub change_buffer {
82			my ($new_buf) = @_;
83			maybe_pop_highlight ($new_buf);
84			select_buffer ($new_buf);
85			}
86
87			sub prettyfy_id {
88			my ($id) = @_;
89			my $uri = URI->new ($id);
90			my $a = $uri->authority;
91			my $p = ($uri->path_segments ())[1];
92			$rev_known_ids{"$a/$p"} = $id;
93			"$a/$p"
94			}
95
96	elmex	1.3	load_cfg ();
97
98	elmex	1.2	my $c = AnyEvent->condvar;
99	elmex	1.1
100	elmex	1.2	#timer ();
101	elmex	1.1
102			$js =
103	elmex	1.6	JSONClientConnection->new (
104			packet_cb => sub {
105			my ($js, $data) = @_;
106			require JSON::Syck;
107
108			if ($data->{type} eq 'message') {
109			my ($src_id) = ($data->{src});
110			my $pretty_id = prettyfy_id ($src_id);
111			$known_ids{$src_id}->{send_id} = $data->{to}->{id};
112
113			if ($data->{msg_type} eq 'private') {
114			push_highlight ($pretty_id);
115			} else {
116			for (@{$::CFG->{highlight}}) {
117			if ($data->{message} =~ m/$_/) {
118			push_highlight ($pretty_id);
119			}
120			}
121			}
122
123			write_chatline ($pretty_id, prettyfy_id ($data->{from}->{id}), $data->{timestamp}, $data->{message}, $data->{msg_type});
124	elmex	1.7
125			} elsif ($data->{type} eq 'metainfo') {
126			my $src_id = $data->{src};
127			my $pretty_id = prettyfy_id ($src_id);
128			my $it = $data->{info_type};
129
130			if ($it eq 'add_ids') {
131			write_infoline ($pretty_id, $data->{timestamp},
132			"channel add: " . join (', ', map { prettyfy_id ($_) } @{$data->{ids}}));
133
134			} elsif ($it eq 'remove_ids') {
135			write_infoline ($pretty_id, $data->{timestamp},
136			"channel remove: " . join (', ', map { prettyfy_id ($_) } @{$data->{ids}}));
137
138			} elsif ($it eq 'special') {
139			write_infoline ($pretty_id, $data->{timestamp}, "[$data->{message}]");
140			}
141
142	elmex	1.6	} elsif ($data->{type} eq 'info') {
143			printline (status => [3, 'INFO: ' . $data->{message}]);
144			} elsif ($data->{type} eq 'error') {
145			printline (status => [4, 'INFO: ' . $data->{message}]);
146			}
147
148			printline (debug => [0, JSON::Syck::Dump ($data)]);
149			},
150			disconnect_cb => sub {
151			printline (status => [4, "ERROR: " . $_[0]]);
152	elmex	1.2	}
153	elmex	1.6	);
154	elmex	1.1
155			$js->connect (localhost => 1236);
156
157	elmex	1.2	CursesChatMainwindow::init;
158	elmex	1.1
159	elmex	1.3	printline (status => ['p0', 0, "Connected!"]);
160			printline (statusline => [20, "Welcome to the json enhanced chat framework!"]);
161	elmex	1.2
162	elmex	1.4	sub find_common_prefix {
163			my (@words) = @_;
164			@words = sort { length ($a) <=> length ($b) } @words;
165			my $shortest = $words[0];
166
167			while ($shortest ne '') {
168			my $no_match = 0;
169			for (@words) {
170			unless (/^\Q$shortest\E/) {
171			$no_match = 1;
172			last;
173			}
174			}
175
176			return $shortest if not $no_match;
177			substr $shortest, -1, 1, '';
178			}
179
180			return '';
181			}
182
183			CursesChatMainwindow::register_complete_cb (sub {
184			my ($word, $first_compl, $idx, @line) = @_;
185
186			# TODO: make completion cycling with $first_compl
187	elmex	1.6	printline (undef, [0, "f[$first_compl] [$idx] [$word]"]);
188	elmex	1.4
189			my @found;
190	elmex	1.6
191	elmex	1.4	if ($idx == 0) {
192			for (keys %completion) {
193			if (/^\Q$word\E/) {
194			push @found, $_;
195			}
196			}
197	elmex	1.6
198	elmex	1.4	} else {
199			my %buffers = map { $_ => 1 } list_buffers;
200	elmex	1.6
201			for (keys %rev_known_ids) {
202	elmex	1.4	delete $buffers{$_};
203			if (/^\Q$word\E/) {
204			push @found, $_;
205			}
206			}
207	elmex	1.6
208	elmex	1.4	for (keys %buffers) {
209			if (/^\Q$word\E/) {
210			push @found, $_;
211			}
212			}
213			}
214	elmex	1.6
215	elmex	1.4	return "$found[0] " if @found == 1;
216	elmex	1.6
217	elmex	1.4	if (@found) {
218			printline (undef, [0, "$word: " . join ", ", @found]);
219			return find_common_prefix (@found);
220			}
221
222			return $word;
223			});
224
225	elmex	1.2	CursesChatMainwindow::register_input_cb (sub {
226	elmex	1.3	my ($input, $escape) = @_;
227
228			unless (defined $input) {
229			if (exists $CFG->{buffers}->{$escape}) {
230	elmex	1.6	change_buffer (my $buf = $CFG->{buffers}->{$escape} \|\| 'status');
231	elmex	1.3	printline (statusline => [20, "[$buf]"]);
232	elmex	1.2	} else {
233	elmex	1.6	change_buffer ('status');
234	elmex	1.3	printline (statusline => [20, "[status]"]);
235	elmex	1.1	}
236	elmex	1.3	return;
237			}
238
239	elmex	1.4	if ($input =~ m/^\/buffer\s*(\S+)/) {
240	elmex	1.6	change_buffer ("$1");
241	elmex	1.3	printline (statusline => [20, "[$1]"]);
242	elmex	1.6
243	elmex	1.4	} elsif ($input =~ m/^\/list_buffers/) {
244			printline (undef, [0, "buffers:"]);
245			for (list_buffers) {
246			printline (undef, [0, "- $_"]);
247			}
248	elmex	1.6
249	elmex	1.2	} elsif ($input =~ m/^\/colors/) {
250			CursesChatMainwindow::print_colors;
251	elmex	1.6
252			} elsif ($input =~ m/^\/reconnect\s(\S)\s(\S)/) {
253			$js->connect ($1 \|\| 'localhost', $2 \|\| 1236);
254			printline (status => [3, "reconnected"]);
255
256			} elsif ($input =~ m/^\/reload/) {
257			load_cfg ();
258
259			} elsif ($input =~ m/^\/remote_reload/) {
260			$js->send_data ({ type => 'command', command => 'reload' });
261
262	elmex	1.2	} else {
263	elmex	1.6	my $pret_id = "" . current_buffer ();
264			my $dest_id = $rev_known_ids{$pret_id};
265
266	elmex	1.4	my $msg = {
267	elmex	1.3	type => 'message',
268	elmex	1.4	dest => $dest_id,
269	elmex	1.2	message => $input
270	elmex	1.4	};
271			$js->send_data ($msg);
272			printline (debug => [0, JSON::Syck::Dump ($msg)]);
273	elmex	1.6	my $mynick = $known_ids{$dest_id}->{send_id} ? prettyfy_id ($known_ids{$dest_id}->{send_id}) : "";
274			write_chatline ($pret_id, $mynick, time, $input, 'local');
275	elmex	1.1	}
276	elmex	1.2	});
277	elmex	1.1
278			$c->wait;
279
280	elmex	1.2	CursesChatMainwindow::end;