diff --git a/lib/LasTres/Controller/Websocket/InputPacket/Init.pm b/lib/LasTres/Controller/Websocket/InputPacket/Init.pm index 5549f78..9a3d37e 100644 --- a/lib/LasTres/Controller/Websocket/InputPacket/Init.pm +++ b/lib/LasTres/Controller/Websocket/InputPacket/Init.pm @@ -80,6 +80,7 @@ sub handle ( $self, $ws, $session, $data ) { clear => $JSON::true, $self->_available_actions($pj), $self->_npcs($pj), + $self->_available_words($pj), ); $info_packet_to_send->send($ws); my $redis = LasTres::Redis->new; @@ -174,10 +175,16 @@ sub _on_redis_event ( $self, $ws, $session, $message, $topic, $topics ) { if ( $data->{command} eq 'update-actions' ) { LasTres::Controller::Websocket::OutputPacket::Info->new( $self->_available_actions($pj), - $self->_npcs($pj) )->send($ws); + $self->_npcs($pj), + $self->_available_words($pj))->send($ws); } } +sub _available_words($self, $pj) { + my $known_words = $pj->known_words_hash_serialized; + return ( known_words => $known_words ); +} + sub _available_actions ( $self, $pj ) { return ( available_actions => { map { $_->identifier => $_->hash($pj) } $pj->actions->@* }, ); diff --git a/lib/LasTres/Schema/Result/PJ.pm b/lib/LasTres/Schema/Result/PJ.pm index 0bb0f10..6b8ddb1 100644 --- a/lib/LasTres/Schema/Result/PJ.pm +++ b/lib/LasTres/Schema/Result/PJ.pm @@ -147,6 +147,22 @@ sub knows_word ( $self, $word ) { return 1; } +sub known_words_hash ($self) { + $self = $self->get_from_storage; + my @words = $self->known_words; + my $words_factory = LasTres::Words->new; + my %result_words = map { ( $_->identifier => $_ ) } + map { $words_factory->get( $_->identifier ) } @words; + return \%result_words; +} + +sub known_words_hash_serialized ($self) { + my %words = %{$self->known_words_hash}; + my @identifiers = keys %words; + %words = map { ($_->identifier => $_->serialize) } @identifiers; + return \%words; +} + sub teach_word ( $self, $word ) { require LasTres::Schema; my $schema = LasTres::Schema->Schema; @@ -155,29 +171,31 @@ sub teach_word ( $self, $word ) { if ( !$word->does('LasTres::Word') ) { die 'The received word does not implement LasTres::Word.'; } - if ($self->knows_word($word)) { + if ( $self->knows_word($word) ) { return; } my $known_word = $result_set_words->new( { identifier => $word->identifier, owner => $self->uuid } ); $known_word->insert_or_update; my $team = $self->team; - $team->append_log_line([ - { - color => 'green', - text => $self->nick, - }, - { - text => ' aprendiĆ³ la palabra ' - }, - { - color => 'purple', - text => $word->name, - }, - { - text => '.' - } - ]); + $team->append_log_line( + [ + { + color => 'green', + text => $self->nick, + }, + { + text => ' aprendiĆ³ la palabra ' + }, + { + color => 'purple', + text => $word->name, + }, + { + text => '.' + } + ] + ); } @@ -207,7 +225,7 @@ sub set_known_location ( $self, $location ) { my $array = $location->to_array; my ( $planet, $super_area, $area, $location_id ) = @$array[ 0 .. 3 ]; my $schema = LasTres::Schema->Schema; - if (!$self->knows_location($location)) { + if ( !$self->knows_location($location) ) { $schema->resultset('PJKnownPlaces')->new( { owner => $self->uuid, @@ -563,6 +581,7 @@ sub talk_npcs ($self) { return {}; } if ( $team->is_moving ) { + # There will be random encounters for # some movement frames in certain areas. return $self->_npc_list_to_hash( \@npcs ); diff --git a/lib/LasTres/Word.pm b/lib/LasTres/Word.pm index 4c98bc5..05ecdd3 100644 --- a/lib/LasTres/Word.pm +++ b/lib/LasTres/Word.pm @@ -29,4 +29,12 @@ requires qw/name identifier/; return $hash{$class}; } } + +## DO NOT EXTEND NOT SUPPORTED. +sub serialize ($self) { + return { + name => $self->name, + identifier => $self->identifier, + }; +} 1; diff --git a/lib/LasTres/Words.pm b/lib/LasTres/Words.pm index e9fa56f..4ac59ad 100644 --- a/lib/LasTres/Words.pm +++ b/lib/LasTres/Words.pm @@ -15,18 +15,20 @@ use Module::Pluggable search_path => ['LasTres::Word'], die $error; }; -has hash => ( - is => 'rw', - lazy => 1, - builder => \&_build_hash, -); - -sub _build_hash($self) { - my @words = $self->plugins(); +{ my %hash; - for my $word (@words) { - $hash{$word->identifier} = $word; + sub hash($self) { + if (!scalar %hash) { + my @words = $self->plugins(); + for my $word (@words) { + $hash{$word->identifier} = $word; + } + } + return {%hash}; } - return \%hash; +} + +sub get($self, $identifier) { + return $self->hash->{$identifier}; } 1; diff --git a/t/02-words.t b/t/02-words.t new file mode 100644 index 0000000..74f7684 --- /dev/null +++ b/t/02-words.t @@ -0,0 +1,31 @@ +#!/usr/bin/env perl + +use v5.36.0; +use strict; +use warnings; + +use feature 'signatures'; + +use Scalar::Util qw/blessed/; + +use Test::Most qw/bail no_plan/; + +{ + use_ok 'LasTres::Words'; +} + +{ + my $words_factory = LasTres::Words->new; + my $words = $words_factory->hash; + for my $identifier (keys %$words) { + my $word = $words->{$identifier}; + test_word($word); + } +} + +sub test_word($word) { + ok $word->does('LasTres::Word'), (blessed $word) + . ' implements LasTres::Word.'; + ok defined $word->name, (blessed $word) . ' has name.'; + ok defined $word->identifier, (blessed $word) . ' has identifier.'; +}