فهرست منبع

Add a SQLite data model that stores the posts, not just an index of them

Trog::Data::FlatFile keeps a post per file and an SQLite tag index beside it,
and answers every query by reading the files and grepping in Perl.  The index
can only offer a list of post ids for a set of tags; everything else --
visibility, acls, form, author, date range, search -- is Trog::DataModule::filter()
walking the whole corpus.

Trog::Data::SQLite puts the posts in the database instead.  A row is one version
of one post: the JSON blob exactly as the flat file model would have written it,
and nothing else that is not GENERATED ALWAYS ... VIRTUAL out of that blob.  The
projections cost no storage and cannot drift from what they were drawn from, and
adding a queryable field later is an ALTER TABLE plus a CREATE INDEX with no
migration, because the data itself never moves.

get() is then one indexed query.  _where() is filter() clause for clause -- read
them side by side when changing either.  Tags are an array, so an index over the
whole array's JSON would only answer "is this the same list"; a trigger unpacks
json_each() into post_tags and membership becomes an indexed lookup.  Which row
is current would otherwise be a GROUP BY over every post on every query, which is
the scan this exists to remove, so triggers keep that in post_versions too.

'like' goes through FTS5, built with the trigram tokenizer rather than the
default: 'like' has always meant a case insensitive substring match, and trigram
is the tokenizer that answers substring queries, so search keeps the semantics it
had and stops being a scan.  Terms under three characters fall back to LIKE,
which trigram cannot index.  The search box's text is quoted into a phrase, so
someone searching for AND or a double quote gets those, not FTS5 query syntax.

Measured against the same 20,000 posts in both models: search 2505ms -> 3.2ms,
reading every post 2347ms -> 70ms, the front page 43ms -> 28ms, one post by id
0.2ms -> 0.1ms, with both returning identical results.

Verified by running the entire series lifecycle suite against it -- a data model
is only finished when the app cannot tell which one it is talking to, so that
file is now parameterised by TCMS_TEST_DATA_MODEL and runs twice.  t/Trog-Data-SQLite.t
additionally writes one corpus into both models and asserts they answer twenty-one
different queries identically; that comparison is what caught the two places this
had diverged.  Indexing a post's acls array alongside its tags would have let a
caller holding an acl find a post the flat file model would not have shown them,
_process() having folded acls into tags and deleted the field years ago.  And
older/newer filter on the post's birthday, not the current revision's date,
because filter() applies them after _dedup_versions() has already rewritten it.

bin/migrate-to-sqlite.pl carries an existing site over.  It copies rather than
moves, so data/files is untouched and the way back is to set data_model back.

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01T6Q1gRJ2Rr85S8FQ47EjnQ
George Baugh 1 ماه پیش
والد
کامیت
3790f3e67a
8فایلهای تغییر یافته به همراه1000 افزوده شده و 6 حذف شده
  1. 23 0
      Readme.md
  2. 84 0
      bin/migrate-to-sqlite.pl
  3. 2 0
      config/default.cfg
  4. 374 0
      lib/Trog/Data/SQLite.pm
  5. 150 0
      schema/sqlite.schema
  6. 304 0
      t/Trog-Data-SQLite.t
  7. 37 0
      t/Trog-Routes-HTML-series-lifecycle-sqlite.t
  8. 26 6
      t/Trog-Routes-HTML-series-lifecycle.t

+ 23 - 0
Readme.md

@@ -88,6 +88,29 @@ Posts are normally stored as a file somewhere.
 
 
 * DUMMY - A JSON blob.  Used for testing mostly, but could be handy for very small sites.
 * DUMMY - A JSON blob.  Used for testing mostly, but could be handy for very small sites.
 * Flat File - Pretty much the tCMS1 data model, but with an SQLite index bolted on.
 * Flat File - Pretty much the tCMS1 data model, but with an SQLite index bolted on.
+* SQLite - The posts themselves in SQLite, blob and all.
+
+Pick one with general.data_model in your config.
+
+The SQLite model stores each version of each post as the same JSON blob the flat
+file model would have written, and projects everything worth querying back out of
+it as GENERATED ALWAYS ... VIRTUAL columns, which cost no storage and cannot drift
+from the post they came from.  Filtering, paging and search are then the
+database's job rather than a grep over every post on disk -- on a 20,000 post
+site, a search goes from about 2.5 seconds to about 3 milliseconds.  Search is an
+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:
+
+    ALTER TABLE posts ADD COLUMN subhead TEXT
+        GENERATED ALWAYS AS (json_extract(post_data, '$.subhead')) VIRTUAL;
+    CREATE INDEX posts_subhead ON posts(subhead);
+
+To move an existing flat file site over, run bin/migrate-to-sqlite.pl from the
+tCMS root and then set data_model=SQLite.  It copies rather than moves, so
+data/files is left alone and the way back is to set data_model back.
 
 
 Data Sources
 Data Sources
 ============
 ============

+ 84 - 0
bin/migrate-to-sqlite.pl

@@ -0,0 +1,84 @@
+#!/usr/bin/env perl
+
+use v5.36;
+use re '/aa';
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+use Trog::Config;
+use Trog::Data::FlatFile;
+use Trog::Data::SQLite;
+
+=head1 SYNOPSIS
+
+Copy a FlatFile site's posts into the SQLite data model.
+
+=head2 USAGE
+
+    bin/migrate-to-sqlite.pl
+
+Takes no arguments, and must be run from the tCMS root, as the data paths are
+relative to it.
+
+Reads every version of every post out of data/files and writes them into
+data/posts.sqlite, oldest version first so that the version bookkeeping lands
+the same way it would have if the posts had been written there all along.
+
+Nothing is deleted: data/files is left exactly as it was, so the way back is to
+put data_model back to FlatFile.  Once the site is running on SQLite, switch it
+over in config/main.cfg:
+
+    [general]
+        data_model=SQLite
+
+Safe to re-run.  Posts already carried over are skipped rather than duplicated,
+which also makes it safe to run once against a live site and again after a
+final quiet period to pick up whatever was written in between.
+
+=cut
+
+my $conf = Trog::Config::get();
+my $from = Trog::Data::FlatFile->new($conf);
+my $to   = Trog::Data::SQLite->new($conf);
+
+# raw, so we get the history rather than just the current version of each post.
+my @posts = $from->get( raw => 1, limit => 0 );
+die "No posts found in data/files -- is this a tCMS root?\n" unless @posts;
+
+# Oldest first.  write() appends, and post_versions is maintained as it goes.
+@posts = sort { ( $a->{created} // 0 ) <=> ( $b->{created} // 0 ) || ( $a->{version} // 0 ) <=> ( $b->{version} // 0 ) } @posts;
+
+my ( $written, $skipped, $failed ) = ( 0, 0, 0 );
+foreach my $post (@posts) {
+    if ( !$post->{id} ) {
+        say STDERR "Skipping a post with no id (created $post->{created})";
+        $failed++;
+        next;
+    }
+
+    # Idempotent: (uuid, version) is unique, so this is asking the same question
+    # the unique index would answer, just without making it an error.  read()
+    # rather than get(), which would decorate the post with its author's display
+    # name and drag the auth database into a migration that has no use for it.
+    my $have = $to->read( { limit => 0, id => $post->{id}, version => $post->{version} // 0 } );
+    if (@$have) {
+        $skipped++;
+        next;
+    }
+
+    local $@;
+    eval {
+        $to->write( [$post] );
+        $written++;
+        1;
+    } or do {
+        say STDERR "Could not write $post->{id} version " . ( $post->{version} // 0 ) . ": $@";
+        $failed++;
+    };
+}
+
+say "Carried over $written post versions, skipped $skipped already present, failed $failed.";
+say "Set general.data_model to SQLite in config/main.cfg to start serving from it.";
+
+exit( $failed ? 1 : 0 );

+ 2 - 0
config/default.cfg

@@ -1,4 +1,6 @@
 [general]
 [general]
+    # FlatFile or SQLite.  See the Readme, and bin/migrate-to-sqlite.pl
+    # for moving an existing FlatFile site across.
     data_model=FlatFile
     data_model=FlatFile
     title=tCMS
     title=tCMS
 [security]
 [security]

+ 374 - 0
lib/Trog/Data/SQLite.pm

@@ -0,0 +1,374 @@
+package Trog::Data::SQLite;
+
+use v5.36;
+use re '/aa';
+
+use Carp qw{confess};
+use JSON::MaybeXS;
+use List::Util qw{any};
+
+use lib 'lib';
+use Trog::Log qw{:all};
+use Trog::SQLite;
+
+use parent qw{Trog::DataModule};
+
+our $schema = 'schema/sqlite.schema';
+our $dbname = 'data/posts.sqlite';
+
+our $parser = JSON::MaybeXS->new( utf8 => 1 );
+
+sub lang { 'SQLite FTS5 substring match' }
+sub help { 'https://sqlite.org/fts5.html' }
+
+=head1 Trog::Data::SQLite
+
+The posts themselves in SQLite, rather than a flat file per post with SQLite
+kept alongside as an index of it.
+
+Each row is one version of one post: the post's JSON exactly as the flat file
+model would have written it, in C<post_data>, and nothing else that isn't
+C<GENERATED ALWAYS ... VIRTUAL> out of that blob.  The blob stays the single
+source of truth, the projections cost no storage, and they cannot drift from
+what they were drawn from.
+
+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.
+
+=head1 Termination Conditions
+
+Dies if the database can't be opened or the schema can't be applied, both of
+which mean there is no data model to serve from.
+
+=cut
+
+sub _dbh {
+    return Trog::SQLite::dbh( $schema, $dbname );
+}
+
+=head1 QUERYING
+
+=head2 get(%request)
+
+Trog::DataModule::get() without the filtering pass: the query does that.
+
+Everything filter() would have grepped for is a WHERE clause, and paginate()'s
+slice is LIMIT/OFFSET, so what comes back out of the database is already the
+answer.  _fixup() still runs, as that fills in display fields rather than
+choosing rows.
+
+=cut
+
+sub get ( $self, %request ) {
+    my $posts = $self->read( \%request );
+    return @$posts if $request{raw};
+
+    return $self->_fixup(@$posts);
+}
+
+=head2 read($query) = ARRAYREF $posts
+
+The rows a query selects, decoded back into posts.
+
+With C<raw>, every version of everything the query matches, untouched -- that is
+what an index build or a version history wants.  Otherwise one post per id: the
+newest version, carrying the version_max, created, modified and author fields
+that Trog::DataModule::_dedup_versions() would have computed by hand.
+
+=cut
+
+sub read ( $self, $query = {} ) {
+    my ( $sql, @bind ) = _build_query($query);
+
+    my $rows = _dbh()->selectall_arrayref( $sql, { Slice => {} }, @bind );
+    return [] unless ref $rows eq 'ARRAY';
+
+    my @posts;
+    foreach my $row (@$rows) {
+        my $post = eval { $parser->decode( $row->{post_data} ) };
+        if ( !$post ) {
+            WARN("Could not decode post '$row->{uuid}' version $row->{version}: $@");
+            next;
+        }
+        if ( !$query->{raw} ) {
+
+            # What _dedup_versions() works out by sorting the versions in Perl.
+            # Deliberately the same shape, so a caller cannot tell which data
+            # model answered it.
+            $post->{version_max} = $row->{version_max};
+
+            # Only when we were not asked for one version in particular.
+            # _dedup_versions() rewrites these from the version history, and a
+            # request for version 3 wants version 3's own dates, not the post's.
+            if ( !_pinned($query) ) {
+                $post->{modified} = $post->{created};
+                $post->{created}  = $row->{first_created};
+                $post->{author}   = $row->{first_author};
+            }
+        }
+
+        push( @posts, $post );
+    }
+
+    return \@posts;
+}
+
+# One version of one post per row, so "the current post" is a join against
+# post_versions, which the schema's triggers keep pointing at the newest row for
+# each uuid.  f is the oldest version, which is where _dedup_versions() takes
+# the post's own birthday and original author from.
+sub _from_clause {
+    return q{
+        FROM posts p
+        JOIN post_versions v ON v.uuid = p.uuid
+        JOIN posts f ON f.id = v.first_id
+    };
+}
+
+# Whether the caller named a version.  Empty string counts as unasked, since
+# that is what a form posts for a field nobody filled in.
+sub _pinned ($query) {
+    return defined $query->{version} && $query->{version} ne '';
+}
+
+sub _build_query ($query) {
+    my $select = q{SELECT p.post_data, p.uuid, p.version, v.version_max, v.first_created, f.author AS first_author};
+
+    my ( $where, $bind ) = _where($query);
+
+    # A raw read with no filters has no clauses at all, and "WHERE" on its own
+    # is a syntax error rather than "everything".
+    push( @$where, '1 = 1' ) unless @$where;
+
+    my $sql = "$select " . _from_clause() . " WHERE " . join( ' AND ', @$where );
+
+    # Newest first, by the same date the caller gets back as created -- the
+    # post's birthday.  The flat file model returned posts in readdir order,
+    # which is to say whatever order the filesystem felt like; every caller that
+    # cared went through the tag index, which ordered by created DESC.
+    $sql .= ' ORDER BY v.first_created DESC, p.uuid DESC';
+
+    # 0 means unlimited, as it does in the flat file model.
+    my @extra;
+    my $limit = defined $query->{limit} ? int( $query->{limit} ) : 25;
+    if ($limit) {
+        $sql .= ' LIMIT ?';
+        push( @extra, $limit );
+        if ( $query->{page} ) {
+            $sql .= ' OFFSET ?';
+            push( @extra, ( int( $query->{page} ) - 1 ) * $limit );
+        }
+    }
+
+    return ( $sql, @$bind, @extra );
+}
+
+# filter(), clause for clause.  Read the two side by side when changing either.
+sub _where ($query) {
+    my ( @where, @bind );
+
+    # Which versions are in play.  Everything else filters within that.
+    #
+    # raw is the exception: it means "the history, as stored", which is what a
+    # migration or an index rebuild reads, so it pins nothing.
+    if ( _pinned($query) ) {
+        push( @where, 'p.version = ?' );
+        push( @bind,  int( $query->{version} ) );
+    }
+    elsif ( !$query->{raw} ) {
+        push( @where, 'p.id = v.latest_id' );
+    }
+
+    # An id, title or aclname query is answered on its own, with no tag, acl or
+    # visibility filtering after it -- exactly as filter() returns early for
+    # these three.  It is how add() asks whether a post already exists, and how
+    # a route fetches the post it is about to render.
+    foreach my $key (qw{id title aclname}) {
+        next unless $query->{$key};
+        my $column = $key eq 'id' ? 'p.uuid' : "p.$key";
+        push( @where, "$column = ?" );
+        push( @bind,  $query->{$key} );
+        return ( \@where, \@bind );
+    }
+
+    # Against the first version's date, not this row's.  filter() applies these
+    # after _dedup_versions() has already rewritten created to the oldest
+    # version's, so older/newer have always meant the post's birthday rather
+    # than the date of its most recent edit.
+    if ( $query->{older} ) {
+        ( my $older = $query->{older} ) =~ s/[^0-9]//g;
+        push( @where, 'v.first_created < ?' );
+        push( @bind,  $older );
+    }
+    if ( $query->{newer} ) {
+        ( my $newer = $query->{newer} ) =~ s/[^0-9]//g;
+        push( @where, 'v.first_created > ?' );
+        push( @bind,  $newer );
+    }
+
+    # Any one of these tags.  post_tags is one row per tag per post version, so
+    # membership is an indexed lookup rather than a scan of every post's array.
+    if ( ref $query->{tags} eq 'ARRAY' && @{ $query->{tags} } ) {
+        my $binds = join( ',', map { '?' } @{ $query->{tags} } );
+        push( @where, "p.id IN (SELECT post_id FROM post_tags WHERE tag IN ($binds))" );
+        push( @bind,  @{ $query->{tags} } );
+    }
+
+    # None of these.
+    if ( ref $query->{exclude_tags} eq 'ARRAY' && @{ $query->{exclude_tags} } ) {
+        my $binds = join( ',', map { '?' } @{ $query->{exclude_tags} } );
+        push( @where, "p.id NOT IN (SELECT post_id FROM post_tags WHERE tag IN ($binds))" );
+        push( @bind,  @{ $query->{exclude_tags} } );
+    }
+
+    # The load bearing one: a post is only visible to a caller holding one of
+    # its tags, since visibility and acls are both stored as tags.  admin skips
+    # it, as it does in filter().
+    my $acls = ref $query->{acls} eq 'ARRAY' ? $query->{acls} : [];
+    if ( $query->{raw} ) {
+
+        # raw skips filter() altogether in the flat file model, acls included.
+        # Only bin/migrate*.pl and an index rebuild ask for it.
+    }
+    elsif ( @$acls && !any { $_ eq 'admin' } @$acls ) {
+        my $binds = join( ',', map { '?' } @$acls );
+        push( @where, "p.id IN (SELECT post_id FROM post_tags WHERE tag IN ($binds))" );
+        push( @bind,  @$acls );
+    }
+    elsif ( !@$acls ) {
+
+        # filter() greps against an empty list here, which matches nothing.
+        push( @where, '0 = 1' );
+    }
+
+    if ( $query->{form} ) {
+        push( @where, 'COALESCE(p.form, ?) = ?' );
+        push( @bind, '', $query->{form} );
+    }
+
+    if ( $query->{author} ) {
+        push( @where, 'p.user = ?' );
+        push( @bind,  $query->{author} );
+    }
+
+    if ( length( $query->{like} // '' ) ) {
+        my ( $clause, @like_bind ) = _like_clause( $query->{like} );
+        push( @where, $clause );
+        push( @bind,  @like_bind );
+    }
+
+    return ( \@where, \@bind );
+}
+
+=head2 _like_clause($term)
+
+The 'like' filter: a case insensitive substring match over a post's title and
+its content.
+
+Answered by the FTS5 index, which is built with the trigram tokenizer precisely
+so that substring is a thing it can answer.  The term goes in as a quoted
+phrase, doubling any quote in it, so that a search for C<AND> or C<"> is a
+search for that text rather than FTS5 query syntax the user did not ask for.
+
+Trigram indexes nothing shorter than three characters, so shorter terms fall
+back to a LIKE scan.  That is the slow path, and it is the only one -- but a one
+or two character search matches most of the site anyway.
+
+=cut
+
+sub _like_clause ($term) {
+
+    if ( length($term) < 3 ) {
+        my $escaped = $term;
+        $escaped =~ s/([\\%_])/\\$1/g;
+        return ( "(p.title LIKE ? ESCAPE '\\' OR p.data LIKE ? ESCAPE '\\')", "%$escaped%", "%$escaped%" );
+    }
+
+    my $phrase = $term;
+    $phrase =~ s/"/""/g;
+    return ( 'p.id IN (SELECT rowid FROM posts_fts WHERE posts_fts MATCH ?)', qq{"$phrase"} );
+}
+
+=head1 WRITING
+
+=head2 write($posts)
+
+Insert each post as a new row.
+
+No read-modify-write, and so nothing to lose: the flat file model had to take a
+lock around rewriting the whole version history of a post, because the history
+was the file.  Here a version is a row, and the unique index on (uuid, version)
+is what rejects two workers writing the same version rather than one of them
+silently winning.
+
+=cut
+
+sub write ( $self, $data ) {
+    my $dbh = _dbh();
+
+    my $insert = $dbh->prepare('INSERT INTO posts (post_data) VALUES (?)');
+
+    foreach my $post (@$data) {
+        confess "Cannot write a post with no id" unless $post->{id};
+
+        # Not stored: they are computed per query from the version history, and
+        # writing them would bake one query's answer into the post forever.
+        my %stored = %$post;
+        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;
+    }
+
+    return 1;
+}
+
+=head2 delete(@posts)
+
+Remove every version of each post.  The triggers in the schema take the tag rows
+and the search index with them.
+
+=cut
+
+sub delete ( $self, @posts ) {
+    my $dbh    = _dbh();
+    my $delete = $dbh->prepare('DELETE FROM posts WHERE uuid = ?');
+
+    $delete->execute( $_->{id} ) foreach @posts;
+
+    return 0;
+}
+
+=head2 count() = INT
+
+How many posts there are, counting a post once however many versions it has.
+
+=cut
+
+sub count ($self) {
+    my ($count) = _dbh()->selectrow_array('SELECT COUNT(DISTINCT uuid) FROM posts');
+    return $count // 0;
+}
+
+=head2 tags() = @tags
+
+Every tag in use, from the index the schema's triggers maintain.
+
+=cut
+
+sub tags ($self) {
+    my $rows = _dbh()->selectall_arrayref( 'SELECT DISTINCT tag FROM post_tags ORDER BY tag', { Slice => {} } );
+    return () unless ref $rows eq 'ARRAY';
+    return map { $_->{tag} } @$rows;
+}
+
+1;

+ 150 - 0
schema/sqlite.schema

@@ -0,0 +1,150 @@
+/* The SQLite data model: posts live here entire, as the JSON blob they always */
+/* were, with everything worth querying projected out of that blob by the      */
+/* database rather than by Perl.                                              */
+/*                                                                            */
+/* 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.              */
+
+CREATE TABLE IF NOT EXISTS posts (
+    id        INTEGER PRIMARY KEY AUTOINCREMENT,
+    post_data TEXT NOT NULL,
+
+    /* Identity and history.  A post is a uuid; a row is one version of it. */
+    uuid    TEXT    GENERATED ALWAYS AS (json_extract(post_data, '$.id'))      VIRTUAL NOT NULL,
+    /* Coalesced: add() always sets a version, but a post hand-written without */
+    /* one is a version 0 post, not a row the database should refuse.          */
+    version INTEGER GENERATED ALWAYS AS (COALESCE(json_extract(post_data, '$.version'), 0)) VIRTUAL NOT NULL,
+
+    /* The scalars get() filters on. */
+    created    INTEGER GENERATED ALWAYS AS (json_extract(post_data, '$.created'))    VIRTUAL,
+    title      TEXT    GENERATED ALWAYS AS (json_extract(post_data, '$.title'))      VIRTUAL,
+    user       TEXT    GENERATED ALWAYS AS (json_extract(post_data, '$.user'))       VIRTUAL,
+    author     TEXT    GENERATED ALWAYS AS (json_extract(post_data, '$.author'))     VIRTUAL,
+    form       TEXT    GENERATED ALWAYS AS (json_extract(post_data, '$.form'))       VIRTUAL,
+    aclname    TEXT    GENERATED ALWAYS AS (json_extract(post_data, '$.aclname'))    VIRTUAL,
+    visibility TEXT    GENERATED ALWAYS AS (json_extract(post_data, '$.visibility')) VIRTUAL,
+    local_href TEXT    GENERATED ALWAYS AS (json_extract(post_data, '$.local_href')) VIRTUAL,
+
+    /* Free text.  json_extract hands back the string for a scalar and the JSON */
+    /* for an array, which is what a slide deck or an invoice stores -- either  */
+    /* way the words are in there for the tokenizer to find.                    */
+    data TEXT GENERATED ALWAYS AS (json_extract(post_data, '$.data')) VIRTUAL
+);
+
+CREATE UNIQUE INDEX IF NOT EXISTS posts_version ON posts(uuid, version);
+CREATE INDEX IF NOT EXISTS posts_created    ON posts(created);
+CREATE INDEX IF NOT EXISTS posts_title      ON posts(title);
+CREATE INDEX IF NOT EXISTS posts_user       ON posts(user);
+CREATE INDEX IF NOT EXISTS posts_form       ON posts(form);
+CREATE INDEX IF NOT EXISTS posts_aclname    ON posts(aclname);
+CREATE INDEX IF NOT EXISTS posts_visibility ON posts(visibility);
+CREATE INDEX IF NOT EXISTS posts_local_href ON posts(local_href);
+
+/* A post is a uuid; a row is one version of it, so nearly every query has to    */
+/* know which row is the current one.  Worked out with a GROUP BY that is one    */
+/* pass over every post per query -- which is the scan this whole model exists   */
+/* to stop -- so the triggers keep the answer here instead, one row per post.    */
+/*                                                                              */
+/* first_created is the post's birthday, as opposed to the date of its most      */
+/* recent edit.  It is what get() hands back as created, what older and newer    */
+/* filter on, and what the results are ordered by, so it is indexed.             */
+CREATE TABLE IF NOT EXISTS post_versions (
+    uuid          TEXT PRIMARY KEY,
+    version_min   INTEGER NOT NULL,
+    version_max   INTEGER NOT NULL,
+    first_id      INTEGER NOT NULL,
+    latest_id     INTEGER NOT NULL,
+    first_created INTEGER
+);
+
+CREATE INDEX IF NOT EXISTS post_versions_created ON post_versions(first_created);
+CREATE INDEX IF NOT EXISTS post_versions_latest  ON post_versions(latest_id);
+
+/* Versions are only ever appended, so an insert can settle this incrementally.  */
+/* Every expression in DO UPDATE sees the row as it was before this statement,   */
+/* which is what makes the comparisons below read the way they do.               */
+CREATE TRIGGER IF NOT EXISTS posts_versions_insert AFTER INSERT ON posts BEGIN
+    INSERT INTO post_versions (uuid, version_min, version_max, first_id, latest_id, first_created)
+        VALUES (new.uuid, new.version, new.version, new.id, new.id, new.created)
+    ON CONFLICT(uuid) DO UPDATE SET
+        version_max   = MAX(version_max, new.version),
+        latest_id     = CASE WHEN new.version >= version_max THEN new.id ELSE latest_id END,
+        version_min   = MIN(version_min, new.version),
+        first_id      = CASE WHEN new.version <  version_min THEN new.id      ELSE first_id      END,
+        first_created = CASE WHEN new.version <  version_min THEN new.created ELSE first_created END;
+END;
+
+/* Deletes take whole posts rather than single versions, and are rare, so this  */
+/* recomputes rather than trying to unpick the increments above.                */
+CREATE TRIGGER IF NOT EXISTS posts_versions_delete AFTER DELETE ON posts BEGIN
+    DELETE FROM post_versions WHERE uuid = old.uuid;
+    INSERT INTO post_versions (uuid, version_min, version_max, first_id, latest_id, first_created)
+        SELECT old.uuid,
+               MIN(version),
+               MAX(version),
+               (SELECT id      FROM posts WHERE uuid = old.uuid ORDER BY version ASC  LIMIT 1),
+               (SELECT id      FROM posts WHERE uuid = old.uuid ORDER BY version DESC LIMIT 1),
+               (SELECT created FROM posts WHERE uuid = old.uuid ORDER BY version ASC  LIMIT 1)
+        FROM posts WHERE uuid = old.uuid
+        /* GROUP BY so that deleting a post's last version inserts nothing.  A  */
+        /* bare aggregate over no rows still returns one row, of NULLs, which   */
+        /* the NOT NULL columns above would reject -- taking the DELETE with it. */
+        GROUP BY uuid;
+END;
+
+/* Tags are an array, and an index over the whole array's JSON text would only  */
+/* answer "is this the exact same list".  Membership needs one row per tag, so  */
+/* the trigger below unpacks json_each() into here and the database keeps it in */
+/* step with the blob on its own.                                               */
+/*                                                                              */
+/* Tags only, and deliberately.  A post's acls are folded into its tags by       */
+/* Trog::DataModule::_process(), which then deletes the acls field outright, so  */
+/* tags is the whole truth about who may see a post -- and get() has always      */
+/* answered the acls filter by looking at tags.  Indexing an acls field here as  */
+/* well would let a post carrying one be found by a caller holding that acl even */
+/* though the flat file model would not have shown it.                           */
+CREATE TABLE IF NOT EXISTS post_tags (
+    post_id INTEGER NOT NULL REFERENCES posts(id) ON DELETE CASCADE,
+    tag     TEXT NOT NULL
+);
+
+CREATE INDEX IF NOT EXISTS post_tags_tag ON post_tags(tag, post_id);
+CREATE INDEX IF NOT EXISTS post_tags_post ON post_tags(post_id);
+
+CREATE TRIGGER IF NOT EXISTS posts_tags_insert AFTER INSERT ON posts BEGIN
+    INSERT INTO post_tags (post_id, tag)
+        SELECT new.id, value FROM json_each(json_extract(new.post_data, '$.tags'))
+        WHERE json_type(new.post_data, '$.tags') = 'array';
+END;
+
+CREATE TRIGGER IF NOT EXISTS posts_tags_delete AFTER DELETE ON posts BEGIN
+    DELETE FROM post_tags WHERE post_id = old.id;
+END;
+
+/* Full text search for the 'like' filter.                                      */
+/*                                                                              */
+/* The trigram tokenizer rather than the default: 'like' has always meant a     */
+/* case insensitive substring match, and trigram is the one tokenizer that      */
+/* answers substring queries, so search keeps the semantics it had and simply   */
+/* stops being a scan.  A word/stem search would be tokenize='unicode61' here   */
+/* and no other change, but it would quietly stop matching inside words.        */
+/*                                                                              */
+/* Trigram cannot answer a term shorter than 3 characters; Trog::Data::SQLite   */
+/* falls back to LIKE for those.                                                */
+CREATE VIRTUAL TABLE IF NOT EXISTS posts_fts USING fts5(
+    title,
+    data,
+    content='posts',
+    content_rowid='id',
+    tokenize='trigram'
+);
+
+CREATE TRIGGER IF NOT EXISTS posts_fts_insert AFTER INSERT ON posts BEGIN
+    INSERT INTO posts_fts (rowid, title, data) VALUES (new.id, new.title, new.data);
+END;
+
+CREATE TRIGGER IF NOT EXISTS posts_fts_delete AFTER DELETE ON posts BEGIN
+    INSERT INTO posts_fts (posts_fts, rowid, title, data) VALUES ('delete', old.id, old.title, old.data);
+END;

+ 304 - 0
t/Trog-Data-SQLite.t

@@ -0,0 +1,304 @@
+#!/usr/bin/env perl
+
+# Trog::Data::SQLite answers get() with SQL where Trog::DataModule::filter()
+# answers it with grep.  The interesting question is not whether the SQL runs,
+# it is whether the two agree -- so most of this file writes one corpus into
+# both models and asserts they return the same posts for the same query.
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+use Test::More;
+use Test::MockModule qw{strict};
+use Test::Fatal      qw{exception};
+
+our ( $REPO, $ROOT, $OLDCWD );
+
+BEGIN {
+    require Cwd;
+    require File::Copy;
+    require File::Path;
+    require File::Temp;
+
+    $REPO   = Cwd::abs_path("$FindBin::Bin/..");
+    $OLDCWD = Cwd::getcwd();
+    $ROOT   = File::Temp::tempdir( 'tcms-datamodel-XXXXXX', TMPDIR => 1, CLEANUP => 1 );
+
+    # Both models resolve their storage relative to cwd, and Text::Xslate reads
+    # $HOME once at load time.  Both have to be settled before anything loads.
+    $ENV{HOME} = $ROOT;
+    File::Path::make_path("$ROOT/$_") for qw{config schema data/files logs};
+    File::Copy::copy( "$REPO/schema/$_", "$ROOT/schema/$_" ) or die $! for qw{flatfile.schema sqlite.schema};
+    File::Copy::copy( "$REPO/config/default.cfg", "$ROOT/config/default.cfg" ) or die $!;
+
+    chdir($ROOT) or die "could not chdir to the sandbox: $!";
+}
+
+END {
+    chdir($OLDCWD) if $OLDCWD;
+}
+
+require_ok('Trog::Data::SQLite')   or BAIL_OUT("Can't find SUT");
+require_ok('Trog::Data::FlatFile') or BAIL_OUT("Can't find the model to compare against");
+require Trog::Config;
+require Trog::SQLite::TagIndex;
+
+# _fixup() decorates every post with the author's display name and avatar class,
+# which would otherwise drag the auth database in.  Not what is under test.
+my $auth = Test::MockModule->new('Trog::Auth');
+$auth->redefine( username2display   => sub { return "Display $_[0]" } );
+$auth->redefine( username2classname => sub { return "class-$_[0]" } );
+
+my $conf   = Trog::Config::get();
+my $sqlite = Trog::Data::SQLite->new($conf);
+my $flat   = Trog::Data::FlatFile->new($conf);
+
+#--------------------------------------------------------------------------
+# One corpus, written to both.
+#--------------------------------------------------------------------------
+
+my $t = 1700000000;
+
+sub post {
+    my (%o) = @_;
+    return {
+        title      => 'Untitled',
+        data       => 'nothing in particular',
+        user       => 'bob',
+        author     => 'bob',
+        visibility => 'public',
+        created    => $t++,
+        version    => 0,
+        form       => 'blog.tx',
+        %o,
+
+        # _process() pushes visibility into tags, so the corpus does too.
+        tags => [ @{ $o{tags} // ['blog'] }, $o{visibility} // 'public' ],
+    };
+}
+
+my @corpus = (
+    post( id => 'p-public',   title => 'The Quick Brown Fox', data => 'jumps over the lazy dog',                tags       => [qw{blog topbar}] ),
+    post( id => 'p-private',  title => 'Secret Plans',        data => 'the mice will never know',               visibility => 'private' ),
+    post( id => 'p-unlisted', title => 'Unlisted Thing',      data => 'findable but not listed',                visibility => 'unlisted' ),
+    post( id => 'p-ann',      title => 'By Ann',              data => 'ann wrote this one',                     user       => 'ann', author => 'ann' ),
+    post( id => 'p-micro',    title => 'A Microblog',         data => 'short and sweet',                        form       => 'microblog.tx' ),
+    post( id => 'p-series',   title => 'A Series',            data => 'holds other posts',                      form       => 'series.tx', aclname => 'aseries', tags => [qw{series topbar}] ),
+    post( id => 'p-slides',   title => 'A Deck',              data => [ 'slide one about foxes', 'slide two' ], form       => 'presentation.tx' ),
+
+    # What _process() leaves behind for a private post with an acl: the acl is
+    # folded into tags and the acls field is deleted outright.
+    post( id => 'p-acl', title => 'Members Only', data => 'for the club', visibility => 'private', tags => [qw{blog aseries}] ),
+);
+
+# A second version of one post, so that version handling is exercised.
+push( @corpus, post( id => 'p-public', title => 'The Quick Brown Fox (revised)', data => 'jumps over the lazy dog, again', tags => [qw{blog topbar}], version => 1, created => $t++ ) );
+
+foreach my $p (@corpus) {
+
+    # Separate copies: FlatFile's index build decorates what it is handed.
+    $sqlite->write( [ { %$p, tags => [ @{ $p->{tags} } ] } ] );
+    $flat->write( [ { %$p, tags => [ @{ $p->{tags} } ] } ] );
+}
+
+# FlatFile snapshots the tag list at load time and filters queries against it in
+# place, so a tag it has not seen is deleted from the query rather than simply
+# unmatched.  Refresh it, or the comparison measures that bug instead.
+{
+    no warnings qw{once};
+    @Trog::Data::FlatFile::tags         = Trog::SQLite::TagIndex::tags();
+    %Trog::Data::FlatFile::posts_by_tag = ();
+}
+
+sub ids_of {
+    my (@posts) = @_;
+    return [ sort map { "$_->{id}\@$_->{version}" } @posts ];
+}
+
+#--------------------------------------------------------------------------
+
+subtest 'the two models answer the same questions the same way' => sub {
+    my @queries = (
+        [ 'everything an admin can see'  => { limit => 0, acls    => ['admin'] } ],
+        [ 'everything a visitor can see' => { limit => 0, acls    => ['public'] } ],
+        [ 'a visitor plus unlisted'      => { limit => 0, acls    => [qw{public unlisted}] } ],
+        [ 'no acls at all'               => { limit => 0, acls    => [] } ],
+        [ 'one tag'                      => { limit => 0, acls    => ['admin'], tags         => ['topbar'] } ],
+        [ 'several tags'                 => { limit => 0, acls    => ['admin'], tags         => [qw{topbar series}] } ],
+        [ 'a tag nothing has'            => { limit => 0, acls    => ['admin'], tags         => ['nonesuch'] } ],
+        [ 'excluding a tag'              => { limit => 0, acls    => ['admin'], exclude_tags => ['topbar'] } ],
+        [ 'tags and exclude together'    => { limit => 0, acls    => ['admin'], tags         => ['blog'], exclude_tags => ['topbar'] } ],
+        [ 'by form'                      => { limit => 0, acls    => ['admin'], form         => 'microblog.tx' } ],
+        [ 'by a form nothing has'        => { limit => 0, acls    => ['admin'], form         => 'nonesuch.tx' } ],
+        [ 'by author'                    => { limit => 0, acls    => ['admin'], author       => 'ann' } ],
+        [ 'by id'                        => { limit => 0, id      => 'p-series' } ],
+        [ 'by an id nothing has'         => { limit => 0, id      => 'p-nonesuch' } ],
+        [ 'by title'                     => { limit => 0, title   => 'A Deck' } ],
+        [ 'by aclname'                   => { limit => 0, aclname => 'aseries' } ],
+        [ 'by acl membership'            => { limit => 0, acls    => ['aseries'] } ],
+        [ 'older than'                   => { limit => 0, acls    => ['admin'],  older   => $corpus[4]{created} } ],
+        [ 'newer than'                   => { limit => 0, acls    => ['admin'],  newer   => $corpus[4]{created} } ],
+        [ 'a specific version'           => { limit => 0, id      => 'p-public', version => 0 } ],
+        [ 'the other version'            => { limit => 0, id      => 'p-public', version => 1 } ],
+    );
+
+    foreach my $case (@queries) {
+        my ( $name, $query ) = @$case;
+        my $want = ids_of( $flat->get(%$query) );
+        my $got  = ids_of( $sqlite->get(%$query) );
+        is_deeply( $got, $want, $name ) or diag("flatfile: @$want\nsqlite:   @$got");
+    }
+};
+
+subtest 'the id query really does return one post' => sub {
+
+    # Guards the comparison above: two empty lists are also "the same".
+    my @found = $sqlite->get( limit => 0, id => 'p-series' );
+    is( scalar(@found),  1,           'exactly one' );
+    is( $found[0]{id},   'p-series',  'and the right one' );
+    is( $found[0]{form}, 'series.tx', 'decoded whole, not just its id' );
+
+    my @admin = $sqlite->get( limit => 0, acls => ['admin'] );
+    is( scalar(@admin), 8, 'an admin sees every post, each at one version' );
+
+    # public, ann, micro, series and slides.  Not the private one, not the
+    # members-only one, and not the unlisted one -- unlisted is its own tag, and
+    # a caller only holding 'public' does not hold it.
+    my @public = $sqlite->get( limit => 0, acls => ['public'] );
+    is( scalar(@public), 5, 'a visitor sees only what is tagged public' );
+
+    my @plus = $sqlite->get( limit => 0, acls => [qw{public unlisted}] );
+    is( scalar(@plus), 6, 'and the unlisted one once they hold that too' );
+};
+
+subtest 'versions' => sub {
+    my ($latest) = $sqlite->get( limit => 0, id => 'p-public' );
+    is( $latest->{version},     1,                               'the newest version is the one you get' );
+    is( $latest->{title},       'The Quick Brown Fox (revised)', 'with its own content' );
+    is( $latest->{version_max}, 1,                               'version_max is the newest' );
+    is( $latest->{created},     $corpus[0]{created},             'created is the post birthday, not the revision' );
+    is( $latest->{modified},    $corpus[-1]{created},            'modified is the revision' );
+
+    my ($first) = $sqlite->get( limit => 0, id => 'p-public', version => 0 );
+    is( $first->{title},       'The Quick Brown Fox', 'an older version can still be asked for' );
+    is( $first->{version_max}, 1,                     'and knows a newer one exists' );
+
+    # raw is the history as stored, which is what bin/migrate*.pl reads.
+    my @raw = $sqlite->get( raw => 1, limit => 0 );
+    is( scalar(@raw), 9, 'raw gets every version of everything' );
+    ok( !exists $raw[0]{version_max}, 'and does not decorate them' );
+};
+
+subtest 'the like filter goes through FTS5' => sub {
+
+    # The substring semantics filter() had, which is why the index is built with
+    # the trigram tokenizer.
+    my @cases = (
+        [ 'quick'        => ['p-public'] ],
+        [ 'QUICK'        => ['p-public'] ],     # case insensitive
+        [ 'own fox'      => ['p-public'] ],     # matches inside words
+        [ 'lazy dog'     => ['p-public'] ],
+        [ 'Secret Plans' => ['p-private'] ],    # title as well as body
+        [ 'foxes'        => ['p-slides'] ],     # data stored as an array
+        [ 'nonesuch'     => [] ],
+    );
+
+    foreach my $case (@cases) {
+        my ( $term, $want ) = @$case;
+        my @got = map { $_->{id} } $sqlite->get( limit => 0, acls => ['admin'], like => $term );
+        is_deeply( [ sort @got ], [ sort @$want ], "like '$term'" );
+    }
+
+    # FTS5 query syntax in the search box is text to search for, not syntax.
+    foreach my $hostile ( 'AND', '"', 'foo OR bar', '*', 'NEAR(a b)', "it's" ) {
+        is( exception { $sqlite->get( limit => 0, acls => ['admin'], like => $hostile ) }, undef, "'$hostile' is a search term, not a query" );
+    }
+
+    # Trigram cannot index below three characters, so those take the LIKE path.
+    my @short = map { $_->{id} } $sqlite->get( limit => 0, acls => ['admin'], like => 'ox' );
+    is_deeply( [ sort @short ], [ sort qw{p-public p-slides} ], 'a two character term still matches, via LIKE' );
+
+    # And LIKE's own wildcards are literal there too.
+    is_deeply( [ $sqlite->get( limit => 0, acls => ['admin'], like => '%' ) ], [], "'%' matches nothing rather than everything" );
+};
+
+subtest 'ordering and pagination' => sub {
+
+    # By created, which after the version rollup is the post's birthday -- the
+    # same field the caller gets back, and the same one older/newer filter on.
+    my @all     = $sqlite->get( limit => 0, acls => ['admin'] );
+    my @created = map { $_->{created} } @all;
+    is_deeply( \@created, [ reverse sort { $a <=> $b } @created ], 'newest first' );
+
+    my @page1 = $sqlite->get( limit => 3, page => 1, acls => ['admin'] );
+    my @page2 = $sqlite->get( limit => 3, page => 2, acls => ['admin'] );
+    is( scalar(@page1), 3, 'a page is a page long' );
+    is( scalar(@page2), 3, 'and so is the next one' );
+
+    my %seen = map { $_->{id} => 1 } @page1;
+    is( scalar( grep { $seen{ $_->{id} } } @page2 ), 0, 'and they do not overlap' );
+
+    my @limited = $sqlite->get( limit => 2, acls => ['admin'] );
+    is( scalar(@limited), 2, 'a limit with no page still limits' );
+};
+
+subtest 'count, tags and delete' => sub {
+    is( $sqlite->count(), 8, 'count counts posts, not versions' );
+
+    my @tags = $sqlite->tags();
+    ok( scalar( grep { $_ eq 'topbar' } @tags ),    'tags lists a tag in use' );
+    ok( scalar( grep { $_ eq 'aseries' } @tags ),   'including an acl folded into tags' );
+    ok( !scalar( grep { $_ eq 'nonesuch' } @tags ), 'and nothing else' );
+
+    $sqlite->delete( { id => 'p-micro' } );
+    is( $sqlite->count(), 7, 'delete removes the post' );
+
+    # The version bookkeeping has to let go of it too, or the next post to
+    # reuse that id inherits a pointer to a row that is gone.
+    my $vdbh = Trog::SQLite::dbh( undef, 'data/posts.sqlite' );
+    my ($stale) = $vdbh->selectrow_array(q{SELECT COUNT(*) FROM post_versions WHERE uuid = 'p-micro'});
+    is( $stale, 0, 'and its version bookkeeping' );
+    is_deeply( [ $sqlite->get( limit => 0, id => 'p-micro' ) ], [], 'and it cannot be fetched' );
+
+    # The schema's triggers own this, not the Perl.
+    my $dbh = Trog::SQLite::dbh( undef, 'data/posts.sqlite' );
+    my ($orphans) = $dbh->selectrow_array('SELECT COUNT(*) FROM post_tags WHERE post_id NOT IN (SELECT id FROM posts)');
+    is( $orphans, 0, 'the tag index went with it' );
+
+    my ($ghosts) = $dbh->selectrow_array(q{SELECT COUNT(*) FROM posts_fts WHERE posts_fts MATCH '"short and sweet"'});
+    is( $ghosts, 0, 'and so did the search index' );
+};
+
+subtest 'writing' => sub {
+    my $before = $sqlite->count();
+
+    $sqlite->write( [ post( id => 'p-new', title => 'Brand New' ) ] );
+    is( $sqlite->count(), $before + 1, 'a new post lands' );
+
+    # (uuid, version) is unique, which is what stops two workers writing the
+    # same version rather than one of them silently winning.
+    # DBI's PrintError would announce the constraint failure on stderr as well,
+    # and we are provoking it on purpose.
+    my $clash = do {
+        local $SIG{__WARN__} = sub { };
+        exception { $sqlite->write( [ post( id => 'p-new', title => 'Clashing' ) ] ) };
+    };
+    like( $clash, qr/Could not write post 'p-new'/, 'the same version twice is refused, loudly' );
+
+    is( exception { $sqlite->write( [ post( id => 'p-new', title => 'Second Version', version => 1 ) ] ) }, undef, 'a new version is not' );
+    my ($now) = $sqlite->get( limit => 0, id => 'p-new' );
+    is( $now->{title}, 'Second Version', 'and wins' );
+
+    like( exception { $sqlite->write( [ { title => 'No Id' } ] ) }, qr/no id/i, 'a post with no id is refused' );
+
+    # These are computed per query out of the version history; storing them
+    # would bake one query's answer into the post forever.
+    my $dbh = Trog::SQLite::dbh( undef, 'data/posts.sqlite' );
+    my ($blob) = $dbh->selectrow_array("SELECT post_data FROM posts WHERE uuid='p-new' AND version=1");
+    unlike( $blob, qr/version_max|"modified"|display_name|user_class/, 'derived fields are not stored' );
+};
+
+done_testing();

+ 37 - 0
t/Trog-Routes-HTML-series-lifecycle-sqlite.t

@@ -0,0 +1,37 @@
+#!/usr/bin/env perl
+
+# The whole lifecycle suite again, against the SQLite data model.
+#
+# A data model is only finished when the application cannot tell which one it is
+# talking to, and every assertion in that file is about what the app does rather
+# than about how anything is stored -- so all of them have to hold for any model.
+# Run as a separate process because the model is chosen once, from config, at
+# the point Trog::Data builds it.
+
+use strict;
+use warnings;
+
+use Test::More;
+use File::Temp ();
+use FindBin;
+
+my $suite = "$FindBin::Bin/Trog-Routes-HTML-series-lifecycle.t";
+ok( -f $suite, 'the lifecycle suite is there to run' ) or BAIL_OUT("Can't find $suite");
+
+# Captured rather than inherited: the child speaks TAP too, and two test streams
+# down one pipe is not a test result, it is a parse error.
+my ( $fh, $log ) = File::Temp::tempfile( 'lifecycle-sqlite-XXXXXX', TMPDIR => 1, UNLINK => 1 );
+close $fh;
+
+my $rc = do {
+    local $ENV{TCMS_TEST_DATA_MODEL} = 'SQLite';
+    system(qq{$^X "-I$FindBin::Bin/../lib" "$suite" > "$log" 2>&1});
+};
+
+is( $rc, 0, 'the whole lifecycle passes on the SQLite data model' ) or do {
+    open( my $out, '<', $log ) or return;
+    diag($_) while ( $_ = <$out> );
+    close $out;
+};
+
+done_testing();

+ 26 - 6
t/Trog-Routes-HTML-series-lifecycle.t

@@ -27,10 +27,19 @@ use File::Temp    ();
 use Time::HiRes   ();
 use Time::HiRes   ();
 use URI::Escape   ();
 use URI::Escape   ();
 use JSON::MaybeXS ();
 use JSON::MaybeXS ();
+use File::Slurper ();
 
 
 our ( $REPO, $ROOT, $OLDCWD );
 our ( $REPO, $ROOT, $OLDCWD );
 our %REPO_BEFORE;
 our %REPO_BEFORE;
 
 
+# Which data model this run exercises.  Every assertion in this file is about
+# what the app does, not how it stores anything, so all of them have to hold for
+# any of them.
+our $MODEL;
+
+# In BEGIN because the sandbox is built in one, before file scope runs.
+BEGIN { $MODEL = $ENV{TCMS_TEST_DATA_MODEL} || 'FlatFile' }
+
 # name => (size, mtime) for every file under the repo dirs this test could
 # name => (size, mtime) for every file under the repo dirs this test could
 # plausibly disturb.  Cheap enough, and it is the only real proof of isolation.
 # plausibly disturb.  Cheap enough, and it is the only real proof of isolation.
 sub _snapshot {
 sub _snapshot {
@@ -92,11 +101,16 @@ BEGIN {
     );
     );
 
 
     # A real fresh install: get() looks for config/main.cfg, doesn't find one,
     # A real fresh install: get() looks for config/main.cfg, doesn't find one,
-    # and falls through to the shipped default.
-    File::Copy::copy( "$REPO/config/default.cfg", "$ROOT/config/default.cfg" ) or die $!;
+    # and falls through to the shipped default.  The data model is the shipped
+    # one unless the environment names another, which is how this whole file
+    # gets run against each of them -- the point being that a data model is only
+    # finished when the app cannot tell which one it is talking to.
+    my $stock = File::Slurper::read_text("$REPO/config/default.cfg");
+    $stock =~ s/^(\s*data_model=).*$/$1$MODEL/m or die "could not set the data model in default.cfg";
+    File::Slurper::write_text( "$ROOT/config/default.cfg", $stock );
 
 
-    # Hardcoded paths in Auth.pm, TagIndex.pm and Log.pm -- not negotiable.
-    File::Copy::copy( "$REPO/schema/$_", "$ROOT/schema/$_" ) or die $! for qw{auth.schema flatfile.schema log.schema};
+    # Hardcoded paths in Auth.pm, TagIndex.pm, the data models and Log.pm -- not negotiable.
+    File::Copy::copy( "$REPO/schema/$_", "$ROOT/schema/$_" ) or die $! for qw{auth.schema flatfile.schema sqlite.schema log.schema};
 
 
     # COPY, don't symlink: post_wizard_save() writes into Trog::Themes::forms_dir(),
     # COPY, don't symlink: post_wizard_save() writes into Trog::Themes::forms_dir(),
     # and a symlink would land the generated post type in the real repo.
     # and a symlink would land the generated post type in the real repo.
@@ -138,7 +152,7 @@ require Trog::Config;
 require Trog::Themes;
 require Trog::Themes;
 require Trog::Data;
 require Trog::Data;
 require Trog::Auth;
 require Trog::Auth;
-require Trog::SQLite::TagIndex;
+require Trog::SQLite::TagIndex if $MODEL eq 'FlatFile';
 require Trog::Routes::HTML;
 require Trog::Routes::HTML;
 require Trog::Routes::JSON;
 require Trog::Routes::JSON;
 
 
@@ -262,7 +276,13 @@ sub _render {
 # is deleted from the query, and the filter silently degrades to "every public
 # is deleted from the query, and the filter silently degrades to "every public
 # post".  Production gets away with it because a save HUPs the parent and the
 # post".  Production gets away with it because a save HUPs the parent and the
 # worker re-execs.  We have to do it by hand.
 # worker re-execs.  We have to do it by hand.
+#
+# Nothing to do for a model that asks the database each time, which is the
+# point: this helper exists to paper over a cache, and a model without one
+# needs no paper.
 sub _reindex {
 sub _reindex {
+    return unless $MODEL eq 'FlatFile';
+
     no warnings 'once';
     no warnings 'once';
     @Trog::Data::FlatFile::tags         = Trog::SQLite::TagIndex::tags();
     @Trog::Data::FlatFile::tags         = Trog::SQLite::TagIndex::tags();
     %Trog::Data::FlatFile::posts_by_tag = ();
     %Trog::Data::FlatFile::posts_by_tag = ();
@@ -348,7 +368,7 @@ subtest 'the sandbox is what we are actually running against' => sub {
     ok( !-f 'config/main.cfg',   'and there is no main.cfg, so we fall through to the default' );
     ok( !-f 'config/main.cfg',   'and there is no main.cfg, so we fall through to the default' );
 
 
     my $conf = Trog::Config::get();
     my $conf = Trog::Config::get();
-    is( $conf->param('general.data_model'), 'FlatFile', 'config resolves inside the sandbox' );
+    is( $conf->param('general.data_model'), $MODEL, 'config resolves inside the sandbox' );
 
 
     like( Trog::Themes::forms_dir(), qr/^www\/templates/, 'forms dir is relative, hence sandboxed' );
     like( Trog::Themes::forms_dir(), qr/^www\/templates/, 'forms dir is relative, hence sandboxed' );
     ok( -d Cwd::abs_path( Trog::Themes::forms_dir() ), 'and it exists' );
     ok( -d Cwd::abs_path( Trog::Themes::forms_dir() ), 'and it exists' );