From 767cfd62f209bac0c1e5b4e7edd393121c2050e5 Mon Sep 17 00:00:00 2001 From: Gianni Ceccarelli Date: Mon, 29 Jul 2019 14:56:01 +0100 Subject: perl5 implementation --- p5/cpanfile | 8 ++ p5/mixed-server.pl | 222 +++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 230 insertions(+) create mode 100644 p5/cpanfile create mode 100644 p5/mixed-server.pl diff --git a/p5/cpanfile b/p5/cpanfile new file mode 100644 index 0000000..63031da --- /dev/null +++ b/p5/cpanfile @@ -0,0 +1,8 @@ +# -*- mode: perl -*- +requires perl => '5.026'; +requires 'Moo'; +requires 'experimental'; +requires 'HTTP::Response'; +requires 'IO::Async::Listener'; +requires 'IO::Async::Loop'; +requires 'Net::Async::HTTP::Server'; diff --git a/p5/mixed-server.pl b/p5/mixed-server.pl new file mode 100644 index 0000000..698198c --- /dev/null +++ b/p5/mixed-server.pl @@ -0,0 +1,222 @@ +#!/usr/bin/env perl +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; -- cgit v1.2.3