Replace perl-promised-mysqld by serverset

.gitmodules

@@ -26,10 +26,6 @@
 	path = t_deps/modules/test-moremore
 	url = https://github.com/wakaba/perl-test-moremore
 	track = master
-[submodule "t_deps/modules/promised-mysqld"]
-	path = t_deps/modules/promised-mysqld
-	url = https://github.com/wakaba/perl-promised-mysqld
-	track = master
 [submodule "t_deps/modules/promise"]
 	path = t_deps/modules/promise
 	url = https://github.com/wakaba/perl-promise
@@ -50,3 +46,15 @@
 	path = modules/web-encodings
 	url = https://github.com/manakai/perl-web-encodings
 	track = master
+[submodule "t_deps/modules/serverset"]
+	path = t_deps/modules/serverset
+	url = https://github.com/pawjy/serverset
+[submodule "t_deps/modules/web-url"]
+	path = t_deps/modules/web-url
+	url = https://github.com/manakai/perl-web-url
+[submodule "t_deps/modules/web-resource"]
+	path = t_deps/modules/web-resource
+	url = https://github.com/manakai/perl-web-resource
+[submodule "t_deps/modules/web-datetime"]
+	path = t_deps/modules/web-datetime
+	url = https://github.com/manakai/perl-web-datetime

Makefile

@@ -40,7 +40,6 @@ test: test-deps test-main
 test-deps: deps
 	perl local/bin/pmbp.pl $(PMBP_OPTIONS) \
 	    --install \
-            --install-commands "mysqld" \
             --create-perl-command-shortcut prove
 
 test-main:

config/perl/pmbp-exclusions.txt

@@ -10,4 +10,7 @@
 - "../../t_deps/modules/streams" build tests
 - "../../t_deps/modules/promised-file" build tests
 - "../../t_deps/modules/anyevent-mysql-client.2" build tests
-- "../../modules/web-encodings" build tests
+- "../../modules/web-encodings" build tests
+- "../../t_deps/modules/web-url" build tests
+- "../../t_deps/modules/web-resource" build tests
+- "../../t_deps/modules/web-datetime" build tests

t/database/ae-connect-2.t

@@ -6,7 +6,7 @@ use lib glob path (__FILE__)->parent->parent->parent->child ('t_deps/modules/*/l
 use Test::Dongry;
 use Dongry::Database;
 
-my $dsn = test_dsn 'hoge1';
+my $dsn = test_dsn 'root';
 
 test {
   my $c = shift;
@@ -382,7 +382,7 @@ RUN;
 
 =head1 LICENSE
 
-Copyright 2011-2022 Wakaba <[email protected]>.
+Copyright 2011-2024 Wakaba <[email protected]>.
 
 This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself.

t/lib/Test/Dongry.pm

@@ -4,8 +4,10 @@ use warnings;
 use Path::Tiny;
 use lib glob path (__FILE__)->parent->parent->parent->parent->child ('lib');
 use lib glob path (__FILE__)->parent->parent->parent->parent->child ('modules/*/lib');
+use lib glob path (__FILE__)->parent->parent->parent->parent->child ('t_deps/lib');
 use lib glob path (__FILE__)->parent->parent->parent->parent->child ('t_deps/modules/*/lib');
-use Promised::Mysqld;
+use AbortController;
+use Web::Encoding;
 
 use Exporter::Lite;
 our @EXPORT;
@@ -17,29 +19,59 @@ push @EXPORT, @Test::X1::EXPORT;
 
 require DBIx::ShowSQL;
 
-my $Mysqld = Promised::Mysqld->new;
-note "Start mysqld...";
-$Mysqld->start->to_cv->recv;
-note "Mysqld started";
+use DongrySS;
+
+#note "Servers...";
+my $ac = AbortController->new;
+my $v = DongrySS->run (
+  signal => $ac->signal,
+)->to_cv->recv;
+our $ServerData = $v->{data};
 
 ## For Test::Class tests
 push @EXPORT, qw(runtests);
 sub runtests {
-  Test::Class->runtests (@_);
-  note "Stop mysqld...";
-  $Mysqld->stop->to_cv->recv;
-  undef $Mysqld;
-  note "Mysqld stopped";
+  eval {
+    #note "Tests...";
+    Test::Class->runtests (@_);
+  };
+  my $error;
+  if ($@) {
+    #note "Failed";
+    warn $@;
+    $error = 1;
+  }
+
+  #note "Done";
+  $ac->abort;
+  $v->{done}->to_cv->recv;
+  undef $ac;
+  undef $ServerData;
+  undef $v;
+  exit 1 if $error;
 } # runtests
 
 ## For Test::X1 tests
 push @EXPORT, qw(RUN);
 sub RUN () {
-  run_tests;
-  note "Stop mysqld...";
-  $Mysqld->stop->to_cv->recv;
-  undef $Mysqld;
-  note "Mysqld stopped";
+  eval {
+    #note "Tests...";
+    run_tests;
+  };
+  my $error;
+  if ($@) {
+    #note "Failed";
+    warn $@;
+    $error = 1;
+  }
+
+  #note "Done";
+  $ac->abort;
+  $v->{done}->to_cv->recv;
+  undef $ac;
+  undef $ServerData;
+  undef $v;
+  exit 1 if $error;
 } # RUN
 
 my $DBNumber = 1;
@@ -50,14 +82,61 @@ sub reset_db_set () {
 } # reset_db_set
 
 push @EXPORT, qw(test_dsn);
-sub test_dsn ($) {
+sub test_dsn ($;%) {
   my $name = shift || die;
-  $name .= '_' . $DBNumber . '_test';
-  my $dsn = $Mysqld->get_dsn_string (dbname => $name);
-
-  $Mysqld->create_db_and_execute_sqls ($name, [])->to_cv->recv;
+  my %args = @_;
 
-  return $dsn;
+  my $dsn = {%{$ServerData->{local_dsn_options}->{root}}};
+  my $test_dsn = $ServerData->{local_dsn_options}->{test};
+  if ($name eq 'root') {
+    $test_dsn = $dsn;
+  }
+  $name .= '_' . $DBNumber . '_test';
+
+  my $client = AnyEvent::MySQL::Client->new;
+  my %connect;
+  if (defined $dsn->{port}) {
+    $connect{hostname} = $dsn->{host}->to_ascii;
+    $connect{port} = $dsn->{port};
+  } else {
+    $connect{hostname} = 'unix/';
+    $connect{port} = $dsn->{mysql_socket};
+  }
+  $client->connect (
+    %connect,
+    username => $dsn->{user},
+    password => $dsn->{password},
+    database => $dsn->{dbname},
+  )->then (sub {
+    my $escaped = $dsn->{dbname} = $name . '_test';
+    $escaped =~ s/`/``/g;
+    return $client->query ("CREATE DATABASE IF NOT EXISTS `$escaped`")->then (sub {
+      die $_[0] unless $_[0]->is_success;
+      return $client->query (
+        encode_web_utf8 sprintf q{grant all on `%s`.* to '%s'@'%s'},
+        $escaped, $test_dsn->{user}, '%',
+      );
+    })->then (sub {
+      die $_[0] unless $_[0]->is_success;
+    });
+  })->finally (sub {
+    return $client->disconnect;
+  })->to_cv->recv;
+
+  if ($args{unix} or not $args{tcp}) {
+    my $dsn = {%$test_dsn,
+               dbname => $dsn->{dbname}};
+    delete $dsn->{port};
+    delete $dsn->{host};
+    my $dsns = ServerSet->dsn ('mysql', $dsn);
+    return $dsns;
+  } else {
+    my $dsn = {%$test_dsn,
+               dbname => $dsn->{dbname}};
+    delete $dsn->{mysql_socket};
+    my $dsns = ServerSet->dsn ('mysql', $dsn);
+    return $dsns;
+  }
 } # test_dsn
 
 push @EXPORT, qw(new_db);
@@ -85,7 +164,7 @@ sub new_db (%) {
 
 =head1 LICENSE
 
-Copyright 2011-2017 Wakaba <[email protected]>.
+Copyright 2011-2024 Wakaba <[email protected]>.
 
 This library is free software; you can redistribute it and/or modify
 it under the same terms as Perl itself.

t_deps/lib/DongrySS.pm

@@ -0,0 +1,77 @@
+package DongrySS;
+use strict;
+use warnings;
+use Path::Tiny;
+use Promise;
+use ServerSet;
+
+my $RootPath = path (__FILE__)->parent->parent->parent->absolute;
+
+sub run ($%) {
+  ## Arguments:
+  ##   signal         AbortSignal canceling the server set.  Optional.
+  my $class = shift;
+  return ServerSet->run ({
+    proxy => {
+      start => sub {
+        return [undef, undef];
+      },
+    },
+    mysqld => {
+      handler => 'ServerSet::MySQLServerHandler',
+    },
+    _ => {
+      requires => ['mysqld'],
+      start => sub {
+        my ($handler, $self, %args) = @_;
+        return Promise->all ([
+          $args{receive_mysqld_data},
+        ])->then (sub {
+          my ($mysqld_data) = @{$_[0]};
+
+          my $data = {};
+          $data->{local_dsn_options} = $mysqld_data->{local_dsn_options};
+          $data->{local_dsn_options}->{root} = {%{$mysqld_data->{local_dsn_options}->{test}}};
+          $data->{local_dsn_options}->{root}->{user} = 'root';
+          $data->{local_dsn_options}->{root}->{password} = $self->key ('mysqld_root_password');
+
+          $data->{mysql_version} = $mysqld_data->{mysql_version};
+
+          return [$data, undef];
+        });
+      },
+    }, # _
+  }, sub {
+    my ($ss, $args) = @_;
+    my $result = {};
+
+    $result->{server_params} = {
+      proxy => {
+      },
+      mysqld => {
+        databases => {
+        },
+        no_dump => 1,
+        database_name_suffix => $args->{mysqld_database_name_suffix},
+        volume_path => $args->{path},
+        mycnf => $args->{mycnf},
+        mysql_version => $args->{mysql_version},
+        old_sql_mode => $args->{old_sql_mode},
+      },
+      _ => {},
+    }; # $result->{server_params}
+
+    return $result;
+  }, @_);
+} # run
+
+1;
+
+=head1 LICENSE
+
+Copyright 2024 Wakaba <[email protected]>.
+
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut