use 5.026;
use strict;
use warnings;
use experimental 'signatures';
package Model {
use Moo;
use experimental 'signatures';
has _words => ( is => 'ro', default => sub { +{} } );
sub add_words($self,$words) {
++$self->_words->{$_} for $words->@*;
return;
}
sub get_words($self) {
return +{ $self->_words->%* };
}
sub get_pairs($self) {
my $w = $self->_words;
return [ map { [ $_, $w->{$_} ] } keys $w->%* ];
}
sub get_most_common_pairs($self,$how_many) {
my $pairs = $self->get_pairs;
my @ranked_pairs = reverse sort { $a->[1] <=> $b->[1] } $pairs->@*;
splice @ranked_pairs,$how_many;
return \@ranked_pairs;
}
};
package View {
use Moo;
use experimental 'signatures';
sub words_from_input($self,$input) {
my @words = grep { length } split /\s+/, $input;
return \@words;
}
sub table_from_ranked_pairs($self,$ranked_pairs) {
return join "\n", map {
sprintf '%-15s %3d', $_->@*;
} $ranked_pairs->@*;
}
};
package HTTPController {
use Moo;
use experimental 'signatures';
use HTTP::Response;
has model => ( is => 'ro', required => 1 );
has view => ( is => 'ro', required => 1 );
sub on_request($self,$req) {
if ($req->method eq 'GET') {
$self->get_words($req);
}
elsif ($req->method eq 'POST') {
$self->post_words($req);
}
}
sub _text_response($self,$req,$text) {
my $response = HTTP::Response->new( 200 );
$response->add_content( "$text\n" );
$response->content_type( "text/plain" );
$response->content_length( length $response->content );
$req->respond($response);
}
sub get_words($self,$req) {
my $how_many = $req->query_param('n') || 10;
my $most_common_pairs = $self->model->get_most_common_pairs($how_many);
my $table = $self->view->table_from_ranked_pairs($most_common_pairs);
$self->_text_response($req,$table);
return;
}
sub post_words($self,$req) {
my $body = $req->body;
my $words = $self->view->words_from_input($body);
$self->model->add_words($words);
$self->_text_response($req,'ok');
}
};
package LineController {
use Moo;
use experimental 'signatures';
has model => ( is => 'ro', required => 1 );
has view => ( is => 'ro', required => 1 );
sub on_command($self,$stream,$command,$args_string) {
if ($command eq 'get') {
$self->get_words($stream,$args_string);
}
elsif ($command eq 'put') {
$self->put_words($stream,$args_string);
}
else {
$self->_reply($stream,"bad command, only 'get' and 'put'");
}
}
sub _reply($self,$stream,$text) {
$stream->write("$text\n");
}
sub get_words($self,$stream,$args_string) {
my $how_many = $args_string || 10;
my $most_common_pairs = $self->model->get_most_common_pairs($how_many);
my $table = $self->view->table_from_ranked_pairs($most_common_pairs);
$self->_reply($stream,$table);
return;
}
sub put_words($self,$stream,$args_string) {
my $words = $self->view->words_from_input($args_string);
$self->model->add_words($words);
$self->_reply($stream,'ok');
}
};
package TextServer {
use Moo;
use experimental 'signatures';
use IO::Async::Listener;
extends 'IO::Async::Notifier';
has listener => ( is => 'lazy', handles => ['listen'] );
sub _build_listener($self) {
my $listener = IO::Async::Listener->new(
on_stream => sub ($l,$stream,@) {
$stream->configure(
on_read => sub($stream,$buffref,$eof) {
while( $$buffref =~ s/^(.*\n)// ) {
$self->handle_command($stream,$1);
}
return 0;
},
);
$self->add_child($stream);
},
);
$self->add_child($listener);
return $listener;
}
has on_command => ( is => 'rwp' );
sub configure($self,%params) {
$self->_set_on_command(delete $params{on_command});
return $self->next::method(%params);
}
sub handle_command($self,$stream,$command_line) {
my ($command,$args) = split /\s+/,$command_line,2;
$self->on_command->($stream,$command,$args);
return;
}
};
use Net::Async::HTTP::Server;
use IO::Async::Loop;
my $model = Model->new();
my $view = View->new();
my $loop = IO::Async::Loop->new();
my $httpcontroller = HTTPController->new({
model => $model,
view => $view,
});
my $httpserver = Net::Async::HTTP::Server->new(
on_request => sub($self,$req,@) {
$httpcontroller->on_request($req);
},
);
$loop->add( $httpserver );
my $linecontroller = LineController->new({
model => $model,
view => $view,
});
my $textserver = TextServer->new(
on_command => sub($stream,$command,$args_string) {
$linecontroller->on_command($stream,$command,$args_string);
},
);
$loop->add( $textserver );
$httpserver->listen(
addr => { family => "inet6", socktype => "stream", port => 8080 },
)->retain;
$textserver->listen(
addr => { family => "inet6", socktype => "stream", port => 2020 },
)->retain;
$loop->run;
