#!/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 @highlight; our $CFG; our $js; our %completion = map { $_ => 1 } qw{ /goto /kill /colors /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 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 write_chatline { my ($buffer, $id, $time, $msg, $is_echo, $msg_type, $highlight) = @_; my ($host, $nick) = get_id_parts ($id); my $nick_color = $is_echo ? 7 : ( ($msg_type eq 'private' or $msg_type eq 'private_notice') ? 4 : ($highlight ? 70 : 0) ); my $ts = '[' . POSIX::strftime ("%T", localtime ($time)) . ']'; my ($adel, $bdel) = ('<', '>'); if ($msg_type eq 'private_notice' or $msg_type eq 'public_notice') { ($adel, $bdel) = ('{', '}'); } my (@chatline) = (("p".length $ts), 0, $ts, 0, " [$host]", 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 $/; }); } sub get_first_highlight { return ($highlight[0] || [])->[0]; } 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); 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') { my ($src_id) = ($data->{src}); my $highlight = 0; if ($data->{msg_type} eq 'private' or $data->{msg_type} eq 'private_notice') { 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->{msg_type}, $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 ($_) } @{$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 ($_) } @{$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 ($_) } @{$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, $first_compl, $idx, @line) = @_; # TODO: make completion cycling with $first_compl #d# printline (undef, [0, "f[$first_compl] [$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 ()} || {}}) { my $n = $_ . ":"; if ($n =~ /^\Q$word\E/) { push @found, $n; } } for (keys %buffers) { if (m/^[^\/:]+\/\S+$/) { $_ = prettyfy_id ($_); 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'); } 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/) { 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*)/) { 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;