Use Trog::SQLite from CPAN, and keep the failures that callers answer

tCMS carried its own copy of Trog::SQLite, and trog-provisioner carried
another, and the two had drifted.  The module is now one distribution on
CPAN, so tCMS declares it in Makefile.PL at 0.001 and the copy in lib/ goes,
together with its test.  The distribution has its own tests.

The CPAN module connects with RaiseError on and PrintError off.  The old copy
did the opposite, so a failed statement returned false and printed a warning.
Several callers in tCMS turned that false into an answer.  Under RaiseError
those branches never run, and the statement dies instead.  The changes here
are what each caller needs under the new contract:

- Trog::Vault::set, Trog::Auth::spend_totp and Trog::Auth::totp return a
  message that the page shows.  They now catch the error, log it with WARN,
  and return the same message as before.  A TOTP step that cannot be
  recorded as spent still refuses the code.
- Trog::Log::DBI::log_message runs inside every log call.  A metrics row
  that cannot be written now warns on stderr and returns undef, so a busy
  log database does not kill the request that logged.
- Trog::Data::SQLite catches the error of each write and each index change
  to name the post or the field, as its messages did before.
- useradd, add_change_request, _store_password and mksession had checks of
  a return value that cannot be false any more.  They go, and these subs
  die on a database failure, as the Termination Conditions of Trog::Auth
  already say.  Every caller of useradd and add_change_request already dies
  or catches.

The CPAN module also runs versioned updates.  It records a version in the
table trog_sqlite_schema_version, and runs each NAME.vN.update.sql beside the
schema once.  The schemas of tCMS end in .schema, so an update of
schema/sqlite.schema is schema/sqlite.schema.v1.update.sql.  No update
exists yet, so no file moves.  The POD, the Readme and the schema comment
said that a new queryable field is an ALTER TABLE in schema/sqlite.schema.
That file runs on every new handle, and an ALTER TABLE fails on the second
run, so they now point at the update file.

An existing database opens without loss.  Databases built with the old copy,
with rows in each and a column that index_fields added, open with version 0.
Their schema and rows are the same before and after, and integrity_check and
foreign_key_check are clean.  An update file placed beside the schema runs
once on such a database and moves it to version 1.

Trog::SQLite::TagIndex stays in tCMS.  It is the tag and route index of the
FlatFile model, and it uses Trog::SQLite rather than being part of it.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>

Makefile.PL

@@ -21,6 +21,7 @@ WriteMakefile(
     },
     PREREQ_PM => {
         'Trog::TOTP'                          => '1.007',
+        'Trog::SQLite'                        => '0.001',
         'CGI::Cookie'                         => '0',
         'Capture::Tiny'                       => '0',
         'Carp'                                => '0',

Readme.md

@@ -139,8 +139,10 @@ site, a search goes from about 2.5 seconds to about 3 milliseconds.  Search is a
 FTS5 index built with the trigram tokenizer, so it keeps the case insensitive
 substring matching the search box always had.
 
-Adding a queryable field is one ALTER TABLE and one CREATE INDEX in
-schema/sqlite.schema.  No migration, because the data itself never moves:
+Adding a queryable field is one ALTER TABLE and one CREATE INDEX in the next
+update file beside the schema, such as schema/sqlite.schema.v1.update.sql.
+Trog::SQLite runs each update file once per database, in order.  No migration of
+the data, because the data itself never moves:
 
     ALTER TABLE posts ADD COLUMN subhead TEXT
         GENERATED ALWAYS AS (json_extract(post_data, '$.subhead')) VIRTUAL;

lib/Trog/Auth.pm

@@ -219,7 +219,10 @@ sub totp ( $user, $domain ) {
         # returns 0 for a file that was never there, it does not warn or die.
         unlink "totp/$qr";
 
-        $dbh->do( "UPDATE user SET totp_secret=? WHERE name=?", undef, $secret, $user ) or return ( undef, undef, 1, "Failed to store TOTP secret." );
+        eval { $dbh->do( "UPDATE user SET totp_secret=? WHERE name=?", undef, $secret, $user ); 1 } or do {
+            WARN("Could not store the TOTP secret of $user: $@");
+            return ( undef, undef, 1, "Failed to store TOTP secret." );
+        };
     }
 
     # This is subsequently served via authenticated _serve() in TCMS.pm.
@@ -334,8 +337,10 @@ sub spend_totp ( $user, $code ) {
         return ( 0, 'that code has already been used; wait for the next one' );
     }
 
-    $dbh->do( "INSERT OR REPLACE INTO totp_spent (username, step) VALUES (?,?)", undef, $user, $matched )
-      or return ( 0, 'could not record the code as used, so it is refused' );
+    eval { $dbh->do( "INSERT OR REPLACE INTO totp_spent (username, step) VALUES (?,?)", undef, $user, $matched ); 1 } or do {
+        WARN("Could not record the TOTP step of $user as spent: $@");
+        return ( 0, 'could not record the code as used, so it is refused' );
+    };
 
     return ( 1, '' );
 }
@@ -409,7 +414,8 @@ sub _hash_password ($pass) {
 sub _store_password ( $user, $pass ) {
     my ( $hash, $salt ) = _hash_password($pass);
     my $dbh = _dbh();
-    return $dbh->do( "UPDATE user SET hash=?, salt=? WHERE name=?", undef, $hash, $salt, $user ) ? 1 : 0;
+    $dbh->do( "UPDATE user SET hash=?, salt=? WHERE name=?", undef, $hash, $salt, $user );
+    return 1;
 }
 
 =head2 mksession(user, pass, token) = STRING
@@ -447,7 +453,7 @@ sub mksession ( $user, $pass, $token, $ip_addr = '' ) {
 
     # Issue cookie
     my $uuid = Trog::Utils::uuid();
-    $dbh->do( "INSERT OR REPLACE INTO session (id,username) VALUES (?,?)", undef, $uuid, $uid ) or return '';
+    $dbh->do( "INSERT OR REPLACE INTO session (id,username) VALUES (?,?)", undef, $uuid, $uid );
     log_event( 'login_success', $user, $ip_addr, $uuid );
     return $uuid;
 }
@@ -470,7 +476,8 @@ sub killsession ( $user, $ip_addr = '' ) {
 Adds a user identified by the provided password into the auth DB.
 Also used to alter users.
 
-Returns True or False (likely false when user already exists).
+Returns true.  Dies if the user cannot be stored, as the rest of this module
+does when the auth database fails.
 
 =cut
 
@@ -490,20 +497,19 @@ sub useradd ( $user, $displayname, $pass, $acls, $contactemail ) {
 
     my $dbh = _dbh();
     ( $hash, $salt ) = _hash_password($pass) if $pass;
-    my $res = $dbh->do( "INSERT OR REPLACE INTO user (name, display_name, salt, hash, contact_email, totp_secret) VALUES (?,?,?,?,?,?)", undef, $user, $displayname, $salt, $hash, $contactemail, $t_secret );
-    return unless $res && ref $acls eq 'ARRAY';
+    $dbh->do( "INSERT OR REPLACE INTO user (name, display_name, salt, hash, contact_email, totp_secret) VALUES (?,?,?,?,?,?)", undef, $user, $displayname, $salt, $hash, $contactemail, $t_secret );
 
     #XXX this is clearly not normalized with an ACL mapping table, will be an issue with large number of users
     foreach my $acl (@$acls) {
-        return unless $dbh->do( "INSERT OR REPLACE INTO user_acl (username,acl) VALUES (?,?)", undef, $user, $acl );
+        $dbh->do( "INSERT OR REPLACE INTO user_acl (username,acl) VALUES (?,?)", undef, $user, $acl );
     }
     return 1;
 }
 
 sub add_change_request (%args) {
     my $dbh = _dbh();
-    my $res = $dbh->do( "INSERT INTO change_request (username,token,type,secret) VALUES (?,?,?,?)", undef, $args{user}, $args{token}, $args{type}, $args{secret} );
-    return !!$res;
+    $dbh->do( "INSERT INTO change_request (username,token,type,secret) VALUES (?,?,?,?)", undef, $args{user}, $args{token}, $args{type}, $args{secret} );
+    return 1;
 }
 
 sub process_change_request ($token) {
@@ -524,16 +530,14 @@ sub process_change_request ($token) {
             #XXX The fact that this is an INSERT OR REPLACE means all the entries in change_request for this user will get cascade wiped.  Which is good, as the secrets aren't salted.
             # This is also why we have to snag the user's ACLs or they will be wiped.
             my @acls = acls4user($user);
-            useradd( $user, $display, $pass, \@acls, $contactemail ) or do {
-                return '';
-            };
+            useradd( $user, $display, $pass, \@acls, $contactemail );
             killsession($user);
             return "Password set to $pass for $user";
         },
     );
     my $res = $dispatch{$type}->( $user, $secret );
-    $dbh->do( "UPDATE change_request SET processed=1 WHERE token=?", undef, $token ) or do {
-        FATAL("Could not set job with token $token to completed!");
+    eval { $dbh->do( "UPDATE change_request SET processed=1 WHERE token=?", undef, $token ); 1 } or do {
+        FATAL("Could not set job with token $token to completed: $@");
     };
     return $res;
 }

lib/Trog/Data/SQLite.pm

@@ -36,8 +36,12 @@ What that buys is get(): the filtering Trog::DataModule::filter() does in Perl
 over every post on disk happens here in one indexed query.  See _where() for
 the mapping, which is filter() clause for clause.
 
-Adding a queryable field is one ALTER TABLE and one CREATE INDEX in
-schema/sqlite.schema, with no migration, because the data itself never moves.
+Adding a queryable field is one ALTER TABLE and one CREATE INDEX, with no
+migration of the data, because the data itself never moves.  They go in the
+next update file beside the schema, such as
+schema/sqlite.schema.v1.update.sql, and not in schema/sqlite.schema itself.
+Trog::SQLite applies the schema on every new handle, and an ALTER TABLE fails
+the second time.  It runs each update file once per database, in order.
 
 =head1 Termination Conditions
 
@@ -348,12 +352,11 @@ sub _insert ( $dbh, $data ) {
         delete @stored{qw{version_max modified display_name user_class post_id}};
         $stored{version} //= 0;
 
-        # Checked rather than fired and forgotten: DBI is not in RaiseError mode
-        # here, so a rejected write -- the unique index catching two workers on
-        # the same version, most of all -- would otherwise be a warning on
-        # stderr and a save the user was told had succeeded.
-        $insert->execute( $parser->encode( \%stored ) )
-          or confess "Could not write post '$post->{id}' version $stored{version}: " . $dbh->errstr;
+        # Caught to name the post: a rejected write -- the unique index catching
+        # two workers on the same version, most of all -- otherwise dies with
+        # the message of DBI alone, which does not say which post it was.
+        eval { $insert->execute( $parser->encode( \%stored ) ); 1 }
+          or confess "Could not write post '$post->{id}' version $stored{version}: $@";
     }
 
     return 1;
@@ -466,13 +469,13 @@ sub index_fields ( $self, @fields ) {
     foreach my $field ( sort keys %want ) {
         if ( !$have{$field} ) {
             ## no critic(ValuesAndExpressions::PreventSQLInjection) -- $field is the anchored capture above
-            $dbh->do("ALTER TABLE posts ADD COLUMN $field TEXT GENERATED ALWAYS AS (json_extract(post_data, '\$.$field')) VIRTUAL")
-              or confess "Could not add a column for '$field': " . $dbh->errstr;
+            eval { $dbh->do("ALTER TABLE posts ADD COLUMN $field TEXT GENERATED ALWAYS AS (json_extract(post_data, '\$.$field')) VIRTUAL"); 1 }
+              or confess "Could not add a column for '$field': $@";
         }
 
         ## no critic(ValuesAndExpressions::PreventSQLInjection) -- as above
-        $dbh->do("CREATE INDEX IF NOT EXISTS $index_prefix$field ON posts($field)")
-          or confess "Could not index '$field': " . $dbh->errstr;
+        eval { $dbh->do("CREATE INDEX IF NOT EXISTS $index_prefix$field ON posts($field)"); 1 }
+          or confess "Could not index '$field': $@";
         $built++;
     }
 
@@ -489,7 +492,7 @@ sub index_fields ( $self, @fields ) {
         next if $want{$field};
 
         ## no critic(ValuesAndExpressions::PreventSQLInjection) -- $index came out of sqlite_master
-        $dbh->do("DROP INDEX IF EXISTS $index") or confess "Could not drop the index on '$field': " . $dbh->errstr;
+        eval { $dbh->do("DROP INDEX IF EXISTS $index"); 1 } or confess "Could not drop the index on '$field': $@";
         $dropped++;
     }
 

lib/Trog/Log/DBI.pm

@@ -71,7 +71,8 @@ my %buffer;
 Record one log line.
 
 Returns the request insert's result for a request line, 1 for a message that
-got buffered, and undef for a line we couldn't make sense of.
+got buffered, and undef for a line we couldn't make sense of or could not write.
+A write that fails is a warning on stderr, and never dies.
 
 =cut
 
@@ -113,22 +114,29 @@ sub log_message {
     $ua      //= 'none';
     $urchin  //= {};
 
-    # TODO track bytes in the DB
-    my $res = $self->{sth}->execute( $uuid, $epoch, $ip, $user, $method, $route, $referer, $ua, $code );
-
-    # Dump in the accumulated messages
-    if ( is_arrayref( $buffer{$uuid} ) && @{ $buffer{$uuid} } ) {
-        $self->{sth2}->bind_param_array( 1, $uuid );
-        $self->{sth2}->bind_param_array( 2, $buffer{$uuid} );
-        $self->{sth2}->execute_array( {} );
-        delete $buffer{$uuid};
-
-    }
+    # The handle raises, and this runs inside every log call, so a failed write warns rather than dies.
+    my $messages = delete $buffer{$uuid};
+    my $res;
+    eval {
+        # TODO track bytes in the DB
+        $res = $self->{sth}->execute( $uuid, $epoch, $ip, $user, $method, $route, $referer, $ua, $code );
+
+        # Dump in the accumulated messages
+        if ( is_arrayref($messages) && @$messages ) {
+            $self->{sth2}->bind_param_array( 1, $uuid );
+            $self->{sth2}->bind_param_array( 2, $messages );
+            $self->{sth2}->execute_array( {} );
+        }
 
-    # Record urchin data if there is any.
-    if ( %$urchin && $urchin->{utm_source} ) {
-        $self->{sth3}->execute( $uuid, $urchin->{utm_source}, $urchin->{utm_medium}, $urchin->{utm_campaign}, $urchin->{utm_term}, $urchin->{utm_content} );
-    }
+        # Record urchin data if there is any.
+        if ( %$urchin && $urchin->{utm_source} ) {
+            $self->{sth3}->execute( $uuid, $urchin->{utm_source}, $urchin->{utm_medium}, $urchin->{utm_campaign}, $urchin->{utm_term}, $urchin->{utm_content} );
+        }
+        1;
+    } or do {
+        warn "Could not record request $uuid in the metrics database: $@";
+        return;
+    };
 
     return $res;
 }

lib/Trog/SQLite.pm

@@ -1,128 +0,0 @@
-package Trog::SQLite;
-
-use v5.36;
-use re '/aa';
-
-use POSIX qw{floor};
-
-use DBI;
-use DBD::SQLite;
-use File::Slurper();
-use List::Util qw{any};
-
-=head1 Name
-
-Trog::SQLite - Abstracts the boilerpain away!
-
-=head1 SYNOPSIS
-
-    my $dbh = Trog::SQLite::dbh("my_schema.sql", "my_sqlite3.db");
-    ...
-
-=head1 FUNCTIONS
-
-Everything in this module throws when something goes wrong.
-
-=head2 dbh
-
-Get you a database handle with fkeys turned on, and schema consistency enforced.
-Caches the handle past the first call.
-
-Be careful when first calling, the standard fork-safety concerns with sqlite apply
-
-=cut
-
-# We need to make sure this is different across forks, AND consistent within them.
-my $dbh = {};
-
-# Ensure the db schema is OK, and give us a handle
-# WARNING: do not ever call during BEGIN or outside a sub.
-# Otherwise, we can't preload_app.
-sub dbh {
-    my ( $schema, $dbname ) = @_;
-    $dbh //= {};
-    return $dbh->{$dbname} if $dbh->{$dbname};
-
-    # No touch first: DBI:SQLite creates the file on connect.  It also cannot
-    # simply be made unconditional, as that would bump mtime on a live database.
-    my $db = DBI->connect( "dbi:SQLite:dbname=$dbname", "", "" );
-
-    if ($schema) {
-
-        # No pre-flight test: read_text dies with "Cannot open <path>: <errno>",
-        # which says more than the guard did and covers unreadable as well as absent.
-        my $qq = File::Slurper::read_text($schema);
-        $db->{sqlite_allow_multiple_statements} = 1;
-        $db->do($qq) or die "Could not ensure database consistency: " . $db->errstr;
-        $db->{sqlite_allow_multiple_statements} = 0;
-    }
-
-    $dbh->{$dbname} = $db;
-
-    # Turn on fkeys
-    $db->do("PRAGMA foreign_keys = ON") or die "Could not enable foreign keys";
-
-    # Turn on WALmode
-    $db->do("PRAGMA journal_mode = WAL") or die "Could not enable WAL mode";
-
-    # Turn on normal sync mode
-    $db->do("PRAGMA synchronous = NORMAL") or die "Could not enable sync mode normal";
-
-    # 5s busy timeout
-    $db->do("PRAGMA busy_timeout = 5000") or die "Could not set busy_timeout";
-
-    return $db;
-}
-
-=head2 bulk_insert(DBI $dbh, STRING $table, ARRAYREF $keys, STRING $action='IGNORE', MIXED @values)
-
-Insert the values into specified table corresponding to the provided keys.
-Values must be repeating tuples corresponding to the values. Example:
-
-    my $keys   = [qw{A B C}];
-    my @values = qw{1 2 3 4 5 6 7 8 9};
-
-Essentially works around the 999 named param limit and executes by re-using prepared statements.
-This results in a quick insert/update of lots of data, such as when building an index or importing data.
-
-For the vast majority of in-practice usage, this will be swatting flies with an elephant gun.
-That said, it should always do the job correctly and quickly, even for trivial datasets.
-
-If you don't put fkeys in place (or simply turn them off),
-you can use REPLACE as your action to do upserts without causing destructive consequences.
-It's less code than writing an ON CONFLICT UPDATE clause, and faster.
-
-Batch your values to whatever is appropriate given your available heap.
-
-=cut
-
-sub bulk_insert ( $dbh, $table, $keys, $ACTION = 'IGNORE', @values ) {
-    die "unsupported insert action $ACTION" unless any { $ACTION eq $_ } qw{ROLLBACK ABORT FAIL IGNORE REPLACE};
-
-    die "keys must be nonempty ARRAYREF" unless ref $keys eq 'ARRAY' && @$keys;
-    die "#Values must be a multiple of #keys" if @values % @$keys;
-
-    my ( $smt, $query ) = ( '', '' );
-    while (@values) {
-
-        #Must have even multiple of #keys, so floor divide and chop remainder
-        my $nkeys = scalar(@$keys);
-        my $limit = floor( 999 / $nkeys );
-        $limit = $limit - ( $limit % $nkeys );
-        $smt   = '' if scalar(@values) < $limit;
-        my @params = splice( @values, 0, $limit );
-        if ( !$smt ) {
-            my @value_tuples;
-            my @huh = map { '?' } @params;
-            while (@huh) {
-                push( @value_tuples, "(" . join( ',', ( splice( @huh, 0, $nkeys ) ) ) . ")" );
-            }
-            ## no critic(ValuesAndExpressions::PreventSQLInjection)
-            $query = "INSERT OR $ACTION INTO $table (" . join( ',', @$keys ) . ") VALUES " . join( ',', @value_tuples );
-            $smt   = $dbh->prepare($query);
-        }
-        $smt->execute(@params);
-    }
-}
-
-1;

lib/Trog/Vault.pm

@@ -214,10 +214,16 @@ sub set ( $user, $name, $secret ) {
     my $tag        = $gcm->encrypt_done();
 
     my $dbh = _dbh();
-    $dbh->do(
-        "INSERT OR REPLACE INTO user_secret (username, name, key_id, salt, ciphertext, tag, created) VALUES (?,?,?,?,?,?,?)",
-        undef, $user, $name, key_id(), $salt, $ciphertext, $tag, time()
-    ) or return ( 0, 'could not store it' );
+    eval {
+        $dbh->do(
+            "INSERT OR REPLACE INTO user_secret (username, name, key_id, salt, ciphertext, tag, created) VALUES (?,?,?,?,?,?,?)",
+            undef, $user, $name, key_id(), $salt, $ciphertext, $tag, time()
+        );
+        1;
+    } or do {
+        WARN("Could not store the secret '$name' of $user: $@");
+        return ( 0, 'could not store it' );
+    };
 
     Trog::Auth::log_event( 'secret_write', $user );
     return ( 1, "'$name' stored" );

schema/sqlite.schema

@@ -5,7 +5,9 @@
 /* Every column but the blob is GENERATED ALWAYS ... VIRTUAL, so it costs no   */
 /* storage, cannot drift from the post it was drawn from, and can be indexed.  */
 /* Adding a queryable field later is one ALTER TABLE plus one CREATE INDEX --  */
-/* no migration of the data itself, because the data never moves.              */
+/* no migration of the data itself, because the data never moves.  They go in  */
+/* the next update file, sqlite.schema.vN.update.sql, and not in this file:    */
+/* Trog::SQLite runs this file on every new handle, and each update only once. */
 
 CREATE TABLE IF NOT EXISTS posts (
     id        INTEGER PRIMARY KEY AUTOINCREMENT,

t/Trog-Log-DBI.t

@@ -0,0 +1,45 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Test::Fatal   qw{exception};
+use Capture::Tiny qw{capture_stderr};
+use File::Temp    qw{tempdir};
+use FindBin;
+
+use lib "$FindBin::Bin/../lib";
+
+use Trog::SQLite;
+
+require_ok('Trog::Log::DBI') or BAIL_OUT("Can't find SUT");
+
+# The metrics database the way Trog::Log opens it, in a directory of its own.
+my $dir    = tempdir( CLEANUP => 1 );
+my $dbh    = Trog::SQLite::dbh( "$FindBin::Bin/../schema/log.schema", "$dir/log.db" );
+my $output = Trog::Log::DBI->new( name => 'dbi', min_level => 'info', dbh => $dbh );
+
+my $line = "2026-09-29T12:00:00Z [INFO]: RequestId r-1 From 192.0.2.1 |nobody| GET 200 512 /posts\n";
+
+subtest 'a request line is a row' => sub {
+    ok( $output->log_message( message => $line ), 'the write reports success' );
+    my ($count) = $dbh->selectrow_array("SELECT count(*) FROM all_requests WHERE uuid='r-1'");
+    is( $count, 1, 'and the request is in all_requests' );
+};
+
+# The handle raises on every error, and log_message runs inside every log
+# call, so a refused write must not take the caller down with it.
+subtest 'a write the database refuses is a warning, not a die' => sub {
+    $dbh->do("CREATE TEMP TRIGGER refuse_request BEFORE INSERT ON requests BEGIN SELECT RAISE(ABORT, 'refused for the test'); END");
+
+    my ( $res, $died );
+    my $stderr = capture_stderr {
+        $died = exception { $res = $output->log_message( message => $line =~ s/r-1/r-2/r ) };
+    };
+    $dbh->do("DROP TRIGGER temp.refuse_request");
+
+    is( $died, undef, 'the caller of the log does not die' );
+    is( $res,  undef, 'the write reports that it failed' );
+    like( $stderr, qr/Could not record request r-2 in the metrics database: .*refused for the test/, 'and says why on stderr' );
+};
+
+done_testing();

t/Trog-SQLite.t

@@ -1,56 +0,0 @@
-use strict;
-use warnings;
-
-use Test::More;
-use Test::MockModule qw{strict};
-use Test::Deep;
-use Test::Fatal qw{exception};
-use FindBin;
-
-use lib "$FindBin::Bin/../lib";
-
-require_ok('Trog::SQLite') or BAIL_OUT("Can't find SUT");
-
-subtest 'dbh' => sub {
-    my $readmock = Test::MockModule->new('File::Slurper');
-    $readmock->redefine( 'read_text', sub { "SELECT me FROM candidates" } );
-    my $dbimock = Test::MockModule->new("DBI");
-    $dbimock->redefine( 'connect', sub { bless( {}, 'TrogDBD' ) } );
-
-    my $works = 0;
-    no warnings qw{redefine once};
-    local *TrogDBD::do     = sub { $works };
-    local *TrogDBD::errstr = sub { 'bogus' };
-
-    like( exception { Trog::SQLite::dbh( 'bogus', 'bogus' ) }, qr/ensure/i, "Failure to enforce schema throws" );
-    $works = 1;
-
-    # Otherwise it works
-    isa_ok( Trog::SQLite::dbh( 'bogus', 'bogus' ), 'TrogDBD' );
-    unlink 'bogus';
-};
-
-subtest bulk_insert => sub {
-    like( exception { Trog::SQLite::bulk_insert( {}, 'bogus', [qw{a b c}], 'PROCASTINATE' ) },      qr/unsupported/i, "insert OR keyword consistency enforced" );
-    like( exception { Trog::SQLite::bulk_insert( {}, 'bogus', [] ) },                               qr/nonempty/,     "keys must be provided" );
-    like( exception { Trog::SQLite::bulk_insert( {}, 'bogus', [qw{a b c}], 'IGNORE', qw{jello} ) }, qr/multiple of/i, "sufficient values must be provided" );
-
-    my $smt;
-    my $dbh = bless( {}, 'TrogDBH' );
-    no warnings qw{redefine once};
-    local *TrogDBH::prepare = sub { $smt .= $_[1]; return bless( {}, 'TrogSMT' ) };
-    local *TrogSMT::execute = sub { };
-
-    is( exception { Trog::SQLite::bulk_insert( $dbh, 'bogus', [qw{moo cows}], 'IGNORE', qw{a b c d} ) }, undef,                                                       "can do bulk insert" );
-    is( $smt,                                                                                            "INSERT OR IGNORE INTO bogus (moo,cows) VALUES (?,?),(?,?)", "Expected query prepared" );
-
-    # Million insert
-    $smt = '';
-    my $keys   = [ ("a") x 10 ];
-    my @values = ("b") x ( 10**6 );
-    Trog::SQLite::bulk_insert( $dbh, 'bogus', $keys, 'IGNORE', @values );
-    my $expected = "INSERT OR IGNORE INTO bogus (a,a,a,a,a,a,a,a,a,a) VALUES (?,?,?,?,?,?,?,?,?,?),(?,?,?,?,?,?,?,?,?,?),(?,?,?,?,?,?,?,?,?,?),(?,?,?,?,?,?,?,?,?,?),(?,?,?,?,?,?,?,?,?,?),(?,?,?,?,?,?,?,?,?,?),(?,?,?,?,?,?,?,?,?,?),(?,?,?,?,?,?,?,?,?,?),(?,?,?,?,?,?,?,?,?,?)INSERT OR IGNORE INTO bogus (a,a,a,a,a,a,a,a,a,a) VALUES (?,?,?,?,?,?,?,?,?,?)";
-    is( $smt, $expected, "As expected, only two statements are necessary to be prepared, no matter how many rows to insert." );
-};
-
-done_testing;

t/Trog-Vault.t

@@ -406,4 +406,23 @@ subtest 'the page a user manages them from' => sub {
     is( Trog::Vault::get( 'bob', 'keepass' ), 'correct horse battery staple', "bob's is untouched by eve asking to forget it" );
 };
 
+# The handle raises on every error, so these two are the writes whose failure
+# must still come back as an answer rather than as a die.
+subtest 'a write the database refuses is an answer, not a crash' => sub {
+    my ( $ok, $why ) = Trog::Vault::set( 'nobody', 'thing', 'a secret for a user who does not exist' );
+    is( $ok,  0,                    'a secret for a user the foreign key does not know is refused' );
+    is( $why, 'could not store it', 'with the message the page shows' );
+
+    my $dbh = Trog::SQLite::dbh( 'schema/auth.schema', 'config/auth.db' );
+    $dbh->do("DELETE FROM totp_spent WHERE username='bob'");
+    $dbh->do("CREATE TEMP TRIGGER refuse_spend BEFORE INSERT ON totp_spent BEGIN SELECT RAISE(ABORT, 'refused for the test'); END");
+
+    my ( undef, undef, undef, undef, $totp ) = Trog::Auth::totp( 'bob', 'vault.example.com' );
+    ( $ok, $why ) = Trog::Auth::spend_totp( 'bob', $totp->expected_totp_code( time() ) );
+    $dbh->do("DROP TRIGGER temp.refuse_spend");
+
+    is( $ok, 0, 'a right code that cannot be recorded as spent is refused' );
+    like( $why, qr/could not record the code/, 'saying why' );
+};
+
 done_testing();