Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
tree: 908a957a54
Fetching contributors…

Cannot retrieve contributors at this time

executable file 184 lines (164 sloc) 4.454 kb
#!/usr/bin/env perl
# bird -- client for birdhouse
use 5.10.0;
use Mojo::UserAgent;
use Mojo::JSON;
use Mojo::Log;
use File::Basename qw/dirname/;
use Term::Size;
use Term::ANSIScreen qw/:color :cursor :screen/;
use IO::Socket::SSL;
use List::Util qw/max/;
use Cwd qw/abs_path/;
use warnings;
use strict;
$|=1;
my $ua = Mojo::UserAgent->new();
my $id = $ENV{USER} || [ getpwuid($<) ]->[0];
my $j = Mojo::JSON->new();
my $birds = [];
my $ws;
my $server; # host:port
my $ws_url; # ws://host:port/path
my ( $cols, $rows ) = Term::Size::chars * STDOUT { IO };
my $log = Mojo::Log->new(level => 'debug');
&main;
exit;
sub debug { $log->debug(@_); }
sub init_birdhouse {
chdir dirname $0;
-d 'log' or mkdir 'log' or die $!;
$server = $ARGV[0] or die "Usage $0 <host:port>\n";
$server = "http://$server" unless $server=~/:\/\//;
$ws_url = Mojo::URL->new($server);
$ws_url->scheme("ws");
$ws_url->path("door");
$log->path('./log/birdhouse.log');
$ua->inactivity_timeout(60 * 60);
}
sub init_screen {
$Term::ANSIScreen::AUTORESET = 1;
print color 'white on black';
cls();
locate 1, 1;
setscroll 1, $rows - 3;
}
sub write_status {
my %a = @_;
savepos;
locate $rows- 2, 1;
my $str = "birdhouse at $server @$birds";
print( ( color 'white on blue' ), $str);
print ' ' for length($str)..($cols-1);
loadpos;
}
sub prompt {
locate $rows - 1, 1;
clline;
print ( ( color 'yellow on black'), "$id> " );
locate $rows - 1, length("$id> ") + 1;
print color 'white on black';
}
sub timestamp {
print color 'green on black';
print "[",scalar(localtime)=~/(\S+) \d+$/,"] ";
}
sub write_server_msg {
my $msg = shift;
savepos;
locate $rows-3, 1;
timestamp();
print color 'cyan on black';
say $msg;
loadpos;
}
sub write_chat_msg {
my ($who,$msg) = @_;
savepos;
locate $rows-3, 1;
timestamp();
print color 'yellow on black';
my $max = max map length, @$birds;
printf("%${max}s: ",$who);
print color 'white on black';
say $msg;
loadpos;
}
sub init_connection {
debug "initializing";
my $connect;
$connect = sub {
debug "connecting";
my ($ua, $tx) = @_;
write_server_msg("connecting to $ws_url");
if ( my $e = $tx->error ) {
debug "error (retry in 5 seconds): $e";
write_server_msg($e." (retry in 5 seconds)");
Mojo::IOLoop->singleton->timer( 5 => sub { $ua->websocket( $ws_url => $connect ); }
);
return;
}
$ws = $tx;
$tx->send("hello, i am $id");
$tx->unsubscribe('message');
$tx->on(message =>
sub {
my ( $tx, $msg ) = @_;
$msg = $j->decode($msg);
if ( $msg->{id} eq 'server' ) {
if ($msg->{birds}) {
$birds = [ @{ $msg->{birds} } ];
write_status();
}
write_server_msg( $msg->{msg}) if $msg->{msg};
}
else {
write_chat_msg($msg->{id} ,$msg->{msg});
}
}
);
$tx->on( finish =>
sub {
write_server_msg "lost connection to $ws_url";
Mojo::IOLoop->singleton->timer(
2 => sub { $ua->websocket( $ws_url => $connect ); } );
}
);
$SIG{INT} = $SIG{QUIT} = sub {
$ws->finish if $ws && $ws->is_websocket;
setscroll 1, $rows;
locate $rows-1,1;
print "\nbye!\n";
exit;
};
write_server_msg("connected.");
prompt();
};
$ua->websocket( $ws_url => $connect );
}
sub init_stdin {
$ua->ioloop(Mojo::IOLoop->singleton);
my $w = $ua->ioloop->reactor;
$w->io(
\*STDIN,
sub {
chomp( my $input = <STDIN> );
unless ( $ws && $ws->is_websocket ) {
write_server_msg("write failed : no connection to $server");
return;
}
$ws->send($input);
prompt();
}
);
$w->watch(\*STDIN, 1, 0); # watch for read events
}
sub main {
init_birdhouse();
debug "starting";
init_screen();
write_status();
init_stdin();
init_connection();
Mojo::IOLoop->start;
}
Jump to Line
Something went wrong with that request. Please try again.