From 745bf92ab51803650b6d63166f482072a9568165 Mon Sep 17 00:00:00 2001 From: Jan Henning Thorsen Date: Wed, 25 Aug 2021 18:04:52 +0200 Subject: [PATCH 1/3] Need to install Mojo::SQLite in workflows --- .github/workflows/linux.yml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/.github/workflows/linux.yml b/.github/workflows/linux.yml index 3970ea77a..a3067628e 100644 --- a/.github/workflows/linux.yml +++ b/.github/workflows/linux.yml @@ -36,7 +36,7 @@ jobs: run: | cpanm -n EV~"!= 4.28" cpanm -n https://github.com/jhthorsen/linkembedder/archive/main.tar.gz - cpanm -n DBD::SQLite Hailo Math::Calc::Parser + cpanm -n DBD::SQLite Hailo Math::Calc::Parser Mojo::SQLite cpanm -n Test::Pod Test::Pod::Coverage cpanm -n --installdeps . - name: Run perl tests From 4fc9c1278cffd2c89ab317fbccb4805149a0a65e Mon Sep 17 00:00:00 2001 From: Jan Henning Thorsen Date: Wed, 25 Aug 2021 17:22:56 +0200 Subject: [PATCH 2/3] Drafted SQLite backend --- lib/Convos/Core/Backend/SQLite.pm | 253 ++++++++++++++++++++++++++++++ 1 file changed, 253 insertions(+) create mode 100644 lib/Convos/Core/Backend/SQLite.pm diff --git a/lib/Convos/Core/Backend/SQLite.pm b/lib/Convos/Core/Backend/SQLite.pm new file mode 100644 index 000000000..20700fc62 --- /dev/null +++ b/lib/Convos/Core/Backend/SQLite.pm @@ -0,0 +1,253 @@ +package Convos::Core::Backend::SQLite; +use Mojo::Base 'Convos::Core::Backend'; + +use Mojo::SQLite; +use Convos::Date qw(dt); +use Mojo::JSON qw(false true); + +has home => sub { Carp::confess('home() cannot be built') }; +has sqlite => sub { Mojo::SQLite->new('sqlite:' . shift->home->child('convos.sqlite')) }; + +sub connections_p { + my ($self, $user) = @_; + + return $self->sqlite->db->select_p('convos_connections')->then(sub { + return shift->hashes->to_array; + }); +} + +sub delete_messages_p { + my ($self, $obj) = @_; + return Mojo::Promise->reject('Unknown target.') unless $obj and $obj->connection; + return $self->sqlite->db->delete_p(convos_messages => {conversation_id => $obj->id}) + ->then(sub {$obj}); +} + +sub delete_object_p { + my ($self, $obj) = @_; + + if ($obj->isa('Convos::Core::Connection')) { + $obj->unsubscribe($_) for qw(conversation message state); + } + + return $self->delete_p($self->_obj_to_table($obj), {id => $obj->id})->then(sub {$obj}); +} + +sub load_object_p { + my ($self, $obj) = @_; + + return $self->select_p($self->_obj_to_table($obj), {id => $obj->id})->then(sub { + return shift->hash; + }); +} + +sub messages_p { + my ($self, $obj, $query) = @_; + + if ($query->{around}) { + my %query_before = (%$query, around => undef, before => $query->{around}); + my %query_after = (%$query, around => undef, after => $query->{around}, include => 1); + + return Mojo::Promise->all( + $self->messages_p($obj, \%query_before), + $self->messages_p($obj, \%query_after), + )->then(sub { + my ($before, $after) = map { $_->[0] } @_; + return {%$before, %$after, messages => [map { @{$_->{messages}} } ($before, $after)]}; + }); + } + + my %extra = (limit => $query->{limit} || 60); + $extra{order_by} = {-desc => 'ts'}; + + my %where = (id => $obj->id); + $where{from} = $query->{from} if $query->{from}; + + my $lt = $query->{include} ? '<=' : '<'; + my $gt = $query->{include} ? '>=' : '>'; + push @{$where{ts}}, {$gt => dt $query->{after}} if $query->{after}; + push @{$where{ts}}, {$lt => dt $query->{before}} if $query->{before}; + + return $self->select_p(convos_messages => \%where, \%extra)->then(sub { + return shift->hashes->to_array; + }); +} + +sub notifications_p { + my ($self, $user, $query) = @_; + + my %extra = (limit => $query->{limit} || 60); + $extra{order_by} = {-desc => 'ts'}; + + return $self->select_p(convos_notifications => {}, \%extra)->then(sub { + return shift->hashes->to_array; + }); +} + +sub save_object_p { + my ($self, $obj) = @_; + + return $self->insert_p($self->_obj_to_table($obj), $obj->TO_JSON('private'))->then(sub {$obj}); +} + +sub users_p { + my $self = shift; + + return $self->sqlite->db->select_p('convos_users')->then(sub { + return shift->hashes->sort(sub { + $a->{registered} cmp $b->{registered} || $a->{email} cmp $b->{email}; + })->to_array; + }); +} + +sub _add_message_p { + my ($self, $target, $msg) = @_; + + return $self->sqlite->db->insert_p( + convos_notifications => { + connection_id => $target->connection->id, + conversation_id => $target->id, + from => $msg->{from}, + highlight => $msg->{highlight} ? 1 : 0, + message => $msg->{message}, + ts => dt($msg->{ts})->to_datetime, + type => $msg->{type} || 'normal', + } + ); +} + +sub _add_notification_p { + my ($self, $target, $msg) = @_; + + return $self->sqlite->db->insert_p( + convos_notifications => { + connection_id => $target->connection->id, + conversation_id => $target->id, + from => $msg->{from}, + message => $msg->{message}, + ts => dt($msg->{ts})->to_datetime, + type => $msg->{type} || 'normal', + } + ); +} + +sub _obj_to_table { + my ($self, $obj) = @_; + return 'convos_connections' if $obj->isa('Convos::Core::Connection'); + return 'convos_conversations' if $obj->isa('Convos::Core::Conversation'); + return 'convos_settings' if $obj->isa('Convos::Core::Settings'); + return 'convos_users' if $obj->isa('Convos::Core::User'); + return 'convos_unknown_object'; +} + +sub _setup { + my $self = shift; + + Scalar::Util::weaken($self); + my $catch = sub { $self->emit(error => shift) }; + + $self->on( + connection => sub { + my ($self, $connection) = @_; + my $cid = $connection->id; + my $uid = $connection->user->id; + + Scalar::Util::weaken($self); + $connection->on( + message => sub { + my ($connection, $target, $msg) = @_; + + if ($msg->{highlight} and $target->id and !$target->is_private) { + $self->_add_notification_p($target, $msg)->catch($catch); + $connection->user->save_p->catch($catch); + } + + $self->_add_message_p($target, $msg)->catch($catch); + } + ); + } + ); + + return $self->SUPER::_setup; +} + +1; + +=encoding utf8 + +=head1 NAME + +Convos::Core::Backend::SQLite - Backend for storing objects to SQLite + +=head1 DESCRIPTION + +L contains methods which is useful for objects +that want to be persisted to an SQLite database. + +=head2 Where is data stored + +C can be set to specify the root location for where to save store +the SQLite database. The default directory on *nix systems is something like +this: + + $HOME/.local/share/convos/ + +C<$HOME> is figured out from L. + +=head1 ATTRIBUTES + +L inherits all attributes from +L and implements the following new ones. + +=head2 home + +See L. + +=head2 sqlite + + $sqlite = $backend->sqlite; + +Returns a L object. + +=head1 METHODS + +L inherits all methods from +L and implements the following new ones. + +=head2 connections_p + +See L. + +=head2 delete_messages_p + +See L. + +=head2 delete_object_p + +See L. + +=head2 load_object_p + +See L. + +=head2 messages_p + +See L. + +=head2 notifications_p + +See L. + +=head2 save_object_p + +See L. + +=head2 users_p + +See L. + +=head1 SEE ALSO + +L. + +=cut From be2afa62e5d82361388016dd7f682920d29229cd Mon Sep 17 00:00:00 2001 From: Jan Henning Thorsen Date: Wed, 25 Aug 2021 19:04:12 +0200 Subject: [PATCH 3/3] First SQLite test and bugfixes --- lib/Convos/Core/Backend/SQLite.pm | 33 +++++++++++++++--------- t/backend-sqlite-basic.t | 42 +++++++++++++++++++++++++++++++ 2 files changed, 63 insertions(+), 12 deletions(-) create mode 100644 t/backend-sqlite-basic.t diff --git a/lib/Convos/Core/Backend/SQLite.pm b/lib/Convos/Core/Backend/SQLite.pm index 20700fc62..2408c9eaa 100644 --- a/lib/Convos/Core/Backend/SQLite.pm +++ b/lib/Convos/Core/Backend/SQLite.pm @@ -6,12 +6,19 @@ use Convos::Date qw(dt); use Mojo::JSON qw(false true); has home => sub { Carp::confess('home() cannot be built') }; -has sqlite => sub { Mojo::SQLite->new('sqlite:' . shift->home->child('convos.sqlite')) }; +has sqlite => sub { + my $self = shift; + $self->home->make_path unless -d $self->home; + + my $sqlite = Mojo::SQLite->new('sqlite:' . $self->home->child('convos.sqlite')); + $sqlite->migrations->from_file(...)->migrate; + return $sqlite; +}; sub connections_p { my ($self, $user) = @_; - return $self->sqlite->db->select_p('convos_connections')->then(sub { + return $self->_db->select_p('convos_connections')->then(sub { return shift->hashes->to_array; }); } @@ -19,8 +26,7 @@ sub connections_p { sub delete_messages_p { my ($self, $obj) = @_; return Mojo::Promise->reject('Unknown target.') unless $obj and $obj->connection; - return $self->sqlite->db->delete_p(convos_messages => {conversation_id => $obj->id}) - ->then(sub {$obj}); + return $self->_db->delete_p(convos_messages => {conversation_id => $obj->id})->then(sub {$obj}); } sub delete_object_p { @@ -30,13 +36,13 @@ sub delete_object_p { $obj->unsubscribe($_) for qw(conversation message state); } - return $self->delete_p($self->_obj_to_table($obj), {id => $obj->id})->then(sub {$obj}); + return $self->_db->delete_p($self->_obj_to_table($obj), {id => $obj->id})->then(sub {$obj}); } sub load_object_p { my ($self, $obj) = @_; - return $self->select_p($self->_obj_to_table($obj), {id => $obj->id})->then(sub { + return $self->_db->select_p($self->_obj_to_table($obj), {id => $obj->id})->then(sub { return shift->hash; }); } @@ -68,7 +74,7 @@ sub messages_p { push @{$where{ts}}, {$gt => dt $query->{after}} if $query->{after}; push @{$where{ts}}, {$lt => dt $query->{before}} if $query->{before}; - return $self->select_p(convos_messages => \%where, \%extra)->then(sub { + return $self->_db->select_p(convos_messages => \%where, \%extra)->then(sub { return shift->hashes->to_array; }); } @@ -79,7 +85,7 @@ sub notifications_p { my %extra = (limit => $query->{limit} || 60); $extra{order_by} = {-desc => 'ts'}; - return $self->select_p(convos_notifications => {}, \%extra)->then(sub { + return $self->_db->select_p(convos_notifications => {}, \%extra)->then(sub { return shift->hashes->to_array; }); } @@ -87,13 +93,14 @@ sub notifications_p { sub save_object_p { my ($self, $obj) = @_; - return $self->insert_p($self->_obj_to_table($obj), $obj->TO_JSON('private'))->then(sub {$obj}); + return $self->_db->insert_p($self->_obj_to_table($obj), $obj->TO_JSON('private')) + ->then(sub {$obj}); } sub users_p { my $self = shift; - return $self->sqlite->db->select_p('convos_users')->then(sub { + return $self->_db->select_p('convos_users')->then(sub { return shift->hashes->sort(sub { $a->{registered} cmp $b->{registered} || $a->{email} cmp $b->{email}; })->to_array; @@ -103,7 +110,7 @@ sub users_p { sub _add_message_p { my ($self, $target, $msg) = @_; - return $self->sqlite->db->insert_p( + return $self->_db->insert_p( convos_notifications => { connection_id => $target->connection->id, conversation_id => $target->id, @@ -119,7 +126,7 @@ sub _add_message_p { sub _add_notification_p { my ($self, $target, $msg) = @_; - return $self->sqlite->db->insert_p( + return $self->_db->insert_p( convos_notifications => { connection_id => $target->connection->id, conversation_id => $target->id, @@ -131,6 +138,8 @@ sub _add_notification_p { ); } +sub _db { shift->sqlite->db } + sub _obj_to_table { my ($self, $obj) = @_; return 'convos_connections' if $obj->isa('Convos::Core::Connection'); diff --git a/t/backend-sqlite-basic.t b/t/backend-sqlite-basic.t new file mode 100644 index 000000000..722d9ac91 --- /dev/null +++ b/t/backend-sqlite-basic.t @@ -0,0 +1,42 @@ +#!perl +use lib '.'; +use t::Helper; +use Convos::Core::Backend::SQLite; +use Convos::Core::User; + +my $backend = Convos::Core::Backend::SQLite->new(home => Mojo::File->new($ENV{CONVOS_HOME})); +my $user = Convos::Core::User->new(email => 'jhthorsen@cpan.org', uid => 42); + +my $users; +$backend->users_p->then(sub { $users = shift })->$wait_success('users_p'); +is_deeply $users, [], 'no users'; + +my $saved; +$backend->save_object_p($user)->then(sub { $saved = shift })->$wait_success('save_object_p'); +is $saved, $user, 'save_object_p'; + +my $connections; +$backend->connections_p($user)->then(sub { $connections = shift })->$wait_success('connections_p'); +is_deeply $connections, [], 'no connections'; + +my $loaded; +$backend->load_object_p($user)->then(sub { $loaded = shift; $loaded->{registered} = 'ts', }) + ->$wait_success('load_object_p'); +is_deeply $loaded, + { + email => 'jhthorsen@cpan.org', + highlight_keywords => [], + password => '', + registered => 'ts', + remote_address => '127.0.0.1', + roles => [], + uid => 42, + unread => 0 + }, + 'load_object_p'; + +my $deleted; +$backend->delete_object_p($user)->then(sub { $deleted = shift })->$wait_success('delete_object_p'); +is $deleted, $user, 'delete_object_p'; + +done_testing;