Trog-Log-DBI.t 1.8 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546
  1. use 5.040;
  2. use re '/aasx';
  3. use warnings;
  4. use Test::More;
  5. use Test::Fatal qw{exception};
  6. use Capture::Tiny qw{capture_stderr};
  7. use File::Temp qw{tempdir};
  8. use FindBin;
  9. use lib "$FindBin::Bin/../lib";
  10. use Trog::SQLite;
  11. require_ok('Trog::Log::DBI') or BAIL_OUT("Can't find SUT");
  12. # The metrics database the way Trog::Log opens it, in a directory of its own.
  13. my $dir = tempdir( CLEANUP => 1 );
  14. my $dbh = Trog::SQLite::dbh( "$FindBin::Bin/../schema/log.schema", "$dir/log.db" );
  15. my $output = Trog::Log::DBI->new( name => 'dbi', min_level => 'info', dbh => $dbh );
  16. my $line = "2026-09-29T12:00:00Z [INFO]: RequestId r-1 From 192.0.2.1 |nobody| GET 200 512 /posts\n";
  17. subtest 'a request line is a row' => sub {
  18. ok( $output->log_message( message => $line ), 'the write reports success' );
  19. my ($count) = $dbh->selectrow_array("SELECT count(*) FROM all_requests WHERE uuid='r-1'");
  20. is( $count, 1, 'and the request is in all_requests' );
  21. };
  22. # The handle raises on every error, and log_message runs inside every log
  23. # call, so a refused write must not take the caller down with it.
  24. subtest 'a write the database refuses is a warning, not a die' => sub {
  25. $dbh->do("CREATE TEMP TRIGGER refuse_request BEFORE INSERT ON requests BEGIN SELECT RAISE(ABORT, 'refused for the test'); END");
  26. my ( $res, $died );
  27. my $stderr = capture_stderr {
  28. $died = exception { $res = $output->log_message( message => $line =~ s/r-1/r-2/r ) };
  29. };
  30. $dbh->do("DROP TRIGGER temp.refuse_request");
  31. is( $died, undef, 'the caller of the log does not die' );
  32. is( $res, undef, 'the write reports that it failed' );
  33. like( $stderr, qr/Could[ ]not[ ]record[ ]request[ ]r-2[ ]in[ ]the[ ]metrics[ ]database:[ ]\N*refused[ ]for[ ]the[ ]test/, 'and says why on stderr' );
  34. };
  35. done_testing();