Adding support for database mocks and more tests.

cpanfile

@@ -3,6 +3,7 @@ requires 'Mojo::Pg';
 requires 'ExtUtils::MakeMaker';
 requires 'Crypt::URandom';
 requires 'DBD::Pg';
+requires 'DBD::Mock';
 requires 'Const::Fast';
 requires 'Params::ValidationCompiler';
 requires 'Types::Standard';

lib/BeastBB/DAO/GroupManager.pm

@@ -11,6 +11,8 @@ use Params::ValidationCompiler 'validation_for';
 use Types::Standard qw/Bool Str Int/;
 
 use BeastBB::Response;
+use BeastBB::Types qw/IsClassTypeGenerator/;
+use BeastBB::Model::Group;
 
 {
     my $validator = validation_for(
@@ -53,8 +55,8 @@ use BeastBB::Response;
         );
 
         return $maybe_group_hash if $maybe_group_hash->IsError;
-        $group_hash = $maybe_group_hash;
+        my $group_hash = $maybe_group_hash->Content;
-        my $group = BeastBB::Model::Group->new(%$group_hash);
+        my $group      = BeastBB::Model::Group->new(%$group_hash);
 
         my $privileges;
         if ($recover_privileges) {
@@ -67,8 +69,10 @@ use BeastBB::Response;
 
 {
     my $validator = validation_for(
-        id_group  => { type => Int, optional => 1 },
+        params => {
-        groupname => { type => Str, optional => 1 },
+            id_group  => { type => Int, optional => 1 },
+            groupname => { type => Str, optional => 1 },
+        }
     );
 
     sub _CheckGetRequirements {
@@ -77,6 +81,7 @@ use BeastBB::Response;
 
         my ( $id_group, $groupname, ) = @params{ 'id_group', 'groupname', };
 
+        my $class = __PACKAGE__;
         confess "${class}::Get should be used passing id_group xor groupname."
           unless ( defined $id_group xor defined $groupname );
     }
@@ -143,6 +148,7 @@ use BeastBB::Response;
               . ' WHERE id_group=?',
             $id_group
         );
+        my $privileges;
         if ( $selected_privileges->rows ) {
             my $hashes_privileges = $selected_privileges->hashes;
             $privileges =
@@ -155,6 +161,7 @@ use BeastBB::Response;
 }
 
 sub _App {
+    my $self = shift;
     return $self->{app};
 }
 1;

lib/BeastBB/Database.pm

@@ -6,7 +6,7 @@ use strict;
 use warnings;
 
 use Params::ValidationCompiler 'validation_for';
-use Types::Standard qw( HashRef Str );
+use Types::Standard qw( HashRef Str Int Bool );
 
 use Mojo::Pg;
 use Mojo::Pg::Migrations;
@@ -42,27 +42,32 @@ use Mojo::Pg::Migrations;
 {
     my $validator = validation_for(
         params => {
-            user     => { type => Str, default => '' },
+            user            => { type => Str, default => '' },
-            password => { type => Str, default => '' },
+            password        => { type => Str, default => '' },
-            dsn      => { type => Str },
+            dsn             => { type => Str },
+            max_connections => { type => Int,  optional => 1 },
+            auto_migrate    => { type => Bool, default  => 1 },
         },
     );
 
     sub new {
-        my $class = shift;
+        my $class           = shift;
-        my $self  = bless {}, $class;
+        my $self            = bless {}, $class;
-        $self->{Pg} = Mojo::Pg->new;
+        my %params          = $validator->(@_);
-        my %params   = $validator->(@_);
+        my $max_connections = $params{max_connections};
+        my $auto_migrate    = $params{auto_migrate};
         my $user     = $params{user};
         my $password = $params{password};
         my $dsn      = $params{dsn};
+        $self->{Pg} = Mojo::Pg->new;
         $self->Pg->username($user)     if defined $user;
         $self->Pg->password($password) if defined $password;
         $self->Pg->dsn($dsn);
         $self->Pg->migrations->from_dir(
-            Mojo::File::curfile->dirname->child('migrations')
+            Mojo::File::curfile->dirname->child('migrations')->to_string );
-              ->to_string );
+        $self->Pg->auto_migrate($auto_migrate);
-        $self->Pg->auto_migrate(1);
+        $self->Pg->max_connections($max_connections)
+          if defined $max_connections;
         return $self;
     }
 }

t/DAO/00-group-manager.t

@@ -0,0 +1,65 @@
+use 5.32.1;
+
+use Test::Most tests => 5;
+
+use strict;
+use warnings;
+
+use Const::Fast;
+
+use BeastBB::Mock::Controller;
+use BeastBB::DAO::GroupManager;
+
+use Data::Dumper;
+
+const my $APP           => BeastBB::Mock::Controller->new;
+const my $GROUP_MANAGER => BeastBB::DAO::GroupManager->new( app => $APP );
+
+{
+    use_ok 'BeastBB::DAO::GroupManager';
+}
+
+{
+    $APP->db->Mock(
+        sql =>
+          'SELECT "id_group", "groupname" FROM "group" WHERE "groupname" = ?',
+        results => [ [ 'id_group', 'groupname' ], [ 1, 'example_group' ] ]
+    );
+    my $maybe_group = $GROUP_MANAGER->Get( groupname => 'example_group' );
+    die $maybe_group->ErrorMessage if $maybe_group->IsError;
+    my $group = $maybe_group->Content;
+    ok $group->isa('BeastBB::Model::Group'), 'We can recover groups.';
+    is_deeply $group->Hash, { groupname => 'example_group', id_group => 1 },
+      'The group hash after groupname recovery is ok.';
+}
+
+{
+    $APP->db->Mock(
+        sql =>
+          'SELECT "id_group", "groupname" FROM "group" WHERE "groupname" = ?',
+        results => [ [ 'id_group', 'groupname' ], [ 1, 'example_group' ] ]
+    );
+    $APP->db->Mock(
+        sql =>
+          'SELECT privilege.name FROM group_privilege INNER JOIN privilege USING (id_privilege) WHERE id_group=?',
+        results => [
+            ['name'],
+            ['example_privilege'],
+            ['example_privilege_1']
+        ]
+    );
+    my $maybe_group = $GROUP_MANAGER->Get(
+        groupname          => 'example_group',
+        recover_privileges => 1
+    );
+    die $maybe_group->ErrorMessage if $maybe_group->IsError;
+    my $group = $maybe_group->Content;
+    ok $group->isa('BeastBB::Model::Group'), 'We can recover groups.';
+    is_deeply $group->Hash,
+      {
+        groupname  => 'example_group',
+        id_group   => 1,
+        privileges => { example_privilege => 1, example_privilege_1 => 1 }
+      },
+      'The group hash after groupname recovery is ok.';
+}

t/Model/00-user.t

@@ -18,6 +18,7 @@ const my %REQUIRED_FIELDS_USER => (
     creation_date   => DateTime->new( year => 2021, month => 06, day => 3 ),
     last_connection => DateTime->now,
 );
+
 {
     use_ok 'BeastBB::Model::User';
 }

test/BeastBB/Mock/Controller.pm

@@ -0,0 +1,34 @@
+package BeastBB::Mock::Controller;
+
+use Mojo::Base 'Mojolicious::Controller';
+
+use 5.32.1;
+
+use strict;
+use warnings;
+
+use Params::ValidationCompiler 'validation_for';
+
+use BeastBB::Types qw/IsClassTypeGenerator/;
+use BeastBB::Mock::Database;
+
+{
+    my $validator = validation_for(
+        params => {
+            db => { type => IsClassTypeGenerator('BeastBB::Database'), optional => 1},
+        }
+    );
+
+    sub new {
+        my $class  = shift;
+        my %params = $validator->(@_);
+        my $db     = $params{db} // BeastBB::Mock::Database->new;
+        return bless { db => $db }, $class;
+    }
+}
+
+sub db {
+    my $self = shift;
+    return $self->{db};
+}
+1;

test/BeastBB/Mock/Database.pm

@@ -0,0 +1,44 @@
+package BeastBB::Mock::Database;
+
+use Mojo::Base 'BeastBB::Database';
+
+use 5.32.1;
+
+use strict;
+use warnings;
+
+use Params::ValidationCompiler 'validation_for';
+use Types::Standard qw/Str ArrayRef/;
+
+sub new {
+    my $class = shift;
+    return $class->SUPER::new(
+        dsn             => 'dbi:Mock:',
+        auto_migrate    => 0,
+        max_connections => 1
+    );
+}
+
+{
+    my $validator = validation_for(
+        params => {
+            sql     => { type => Str, optional => 1 },
+            results => { type => ArrayRef },
+        }
+    );
+
+    sub Mock {
+        my $self   = shift;
+        my %params = $validator->(@_);
+
+        my $results = $params{results};
+        my $sql     = $params{sql};
+        my $dbh     = $self->Pg->db->dbh;
+        $dbh->{mock_add_resultset} = {
+            ( ( defined $sql ) ? ( sql => $sql ) : () ),
+            results => $results,
+        };
+        return;
+    }
+}
+1;