Replace the migrate scripts with one that moves a site to SQLite

The six migrate scripts were a chain of one-offs for tCMS1 and for schema
changes in 2021, each assuming the one before it had been run.  No site still
running needs any of them, so they go, along with migrate-to-sqlite.pl, whose
job this takes over under the name the old chain left free.

bin/migrate.pl carries a FlatFile site's posts into the SQLite model: every
version of every post, oldest first, so the version bookkeeping ends up as it
would have had the posts been written there all along.  Nothing is deleted --
data/files and the flat file tag index are left as they were, so the way back is
to put data_model back.

Safe to re-run, which is the point rather than a nicety: run it once against the
live site, then again after a final quiet period to pick up whatever was written
in between.  --dry-run says what it would do, --batch sizes the transactions and
--quiet suits a cron.  It reports what data/files holds against what the database
now holds, rather than only what it believed it did, and exits non-zero if those
disagree.

Two supporting changes.  write() now puts a batch in a transaction, so a
multi-post write either lands or doesn't -- add() hands it everything it was
given at once, and half a save is not a state anyone asked for.  It is also what
takes 20,000 posts from minutes to 3.1 seconds, SQLite otherwise committing once
per row.  And versions_present() answers "what is already here" in one query, so
a bulk import does not ask once per post.

t/bin-migrate.t runs the script the way an operator would and then asks both
models the same eight questions, since copying rows is not the point -- the site
answering the same afterwards is.  It also covers the dry run, the re-run, the
pick-up-what-changed run, and that the flat files are still readable by the old
model when it is done.

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01T6Q1gRJ2Rr85S8FQ47EjnQ

Readme.md

@@ -118,9 +118,12 @@ on every save and some disk.
 On a data model with no notion of an index the checkbox simply does nothing, so
 the wizard doesn't have to know which model the site is running.
 
-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.
+To move an existing flat file site over, run bin/migrate.pl from the tCMS root
+and then set data_model=SQLite and restart.  It copies rather than moves, so
+data/files is left alone and the way back is to set data_model back.  It is safe
+to re-run -- run it once against the live site, then again after a final quiet
+period to pick up whatever was written in between.  --dry-run tells you what it
+would do.
 
 Data Sources
 ============

bin/migrate-to-sqlite.pl

@@ -1,84 +0,0 @@
-#!/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 );

bin/migrate.pl

@@ -1,253 +1,181 @@
 #!/usr/bin/env perl
 
-#Migrate tCMS1 data to tCMS2 flat file data model
-
 use v5.36;
 use re '/aa';
 
-use JSON::MaybeXS;
-use File::Slurper();
-use HTML::Parser;
-use UUID::Tiny ':std';
-use File::Copy;
-use DateTime;
+use FindBin;
+use lib "$FindBin::Bin/../lib";
 
-=head1 SYNOPSIS
+use Getopt::Long qw{GetOptions};
+use Time::HiRes  ();
 
-Migrate tCMS1 data to the tCMS2 flat file data model.
+use Trog::Config;
+use Trog::Data::FlatFile;
+use Trog::Data::SQLite;
+
+=head1 SYNOPSIS
 
-Walks a tCMS1 docroot and writes each microblog entry and blog post out as a
-tCMS2 post under data/files, keyed by the original creation time so that the
-ordering survives.
+Move a site from the FlatFile data model to the SQLite one.
 
 =head2 USAGE
 
-Edit $docroot and $dir below to point at the tCMS1 site, then:
+    bin/migrate.pl [--dry-run] [--batch N] [--quiet]
 
-    bin/migrate.pl
+Must be run from the tCMS root, as the data paths are relative to it.
 
-Run from the tCMS root; the output paths are relative to it.  Follow up with
-bin/build_index.pl, as this writes the flat files directly and leaves the post
-index untouched.
+    --dry-run   Say what would be carried over, and write nothing.
+    --batch N   Posts per transaction.  Default 500.
+    --quiet     Only complain; say nothing on success.
 
-=head2 CAVEATS
+=head2 WHAT IT DOES
 
-Historical.  This is the first of the migrate scripts and only applies to a
-tCMS1 site; anything newer wants migrate2.pl onwards.
+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 ends up
+the way it would have if the posts had been written there all along.
 
-Microblog entries come in two flavours -- JSON, and hand written HTML from
-before that -- so each file is tried as JSON first and parsed as HTML if that
-fails.  Post authorship is recovered from file ownership, with www-data and
-nologin owners becoming 'nobody'.
+Nothing is deleted.  data/files is left exactly as it found it, and so is the
+flat file model's tag index in data/posts.db, so the way back is to put
+data_model back to FlatFile.
 
-There is an C<exit 0> partway through, before the video migration.  That code
-is unreachable as written and has never been run against anything current.
+Safe to re-run.  Post versions 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
+When it has finished, switch the site over in config/main.cfg:
 
-#Edit this to be whatever you need it to be
-my $docroot = "/var/www/teodesian.net/doc";
+    [general]
+        data_model=SQLite
 
-my $dir = "/var/www/teodesian.net/doc/microblog/";
+...and restart, so the workers build the new model rather than the old one.
 
-opendir( my $dh, $dir ) or die;
-my @days = grep { !/^\./ } readdir $dh;
-closedir $dh;
+=head2 TERMINATION CONDITIONS
 
-my $ring = JSON::MaybeXS->new();
-foreach my $day (@days) {
+Exits non-zero if any post could not be carried over, having written everything
+it could.  Each batch is a transaction, so a batch that fails is not half
+applied, and re-running picks up from what actually landed.
 
-    opendir( my $dht, "$dir/$day" ) or die;
-    my @times = grep { !/^\./ } readdir $dht;
-    closedir $dht;
+=cut
 
-    # Escaped on purpose: split compiles a string argument as a regex, so a
-    # bare '.' would match any character and hand back an empty list.
-    my ( $month, $date, $year ) = split( '\.', $day );
+# So that progress and complaints interleave in the order they happened when
+# this is piped to a log rather than watched.
+STDOUT->autoflush(1);
+STDERR->autoflush(1);
 
-    foreach my $time (@times) {
+my $usage = "Usage: bin/migrate.pl [--dry-run] [--batch N] [--quiet]\n";
 
-        my ( $hour, $min, $sec ) = split( ':', $time );
+# Printed and exited rather than died: Carp::Always is in the dependency chain,
+# and a usage message wearing a stack trace reads like a crash.
+sub usage_error (@complaint) {
+    print STDERR @complaint, $usage;
+    exit 2;
+}
+
+my ( $dry_run, $quiet, $batch_size ) = ( 0, 0, 500 );
+GetOptions(
+    'dry-run' => \$dry_run,
+    'quiet'   => \$quiet,
+    'batch=i' => \$batch_size,
+) or usage_error();
+
+usage_error("--batch must be a positive number of posts.\n") if $batch_size < 1;
+
+sub say_unless_quiet (@args) {
+    return if $quiet;
+    say @args;
+    return;
+}
+
+my $config = Trog::Config::get();
+my $from   = Trog::Data::FlatFile->new($config);
+my $to     = Trog::Data::SQLite->new($config);
+
+# raw, so we get the history rather than only the current version of each post,
+# and so that no acl filtering stands between a migration and the data it is
+# supposed to be moving.
+my $started = [ Time::HiRes::gettimeofday() ];
+my @posts   = $from->get( raw => 1, limit => 0 );
+if ( !@posts ) {
+    print STDERR "No posts found in data/files -- is this a tCMS root, and is it on the FlatFile model?\n";
+    exit 2;
+}
 
-        my $data;
-        my $file = "$dir/$day/$time";
+# Oldest first: write() appends, and the version bookkeeping is maintained as it
+# goes, so feeding it in order is what makes first_id and latest_id right.
+@posts = sort { ( $a->{id} // '' ) cmp ( $b->{id} // '' ) || ( $a->{version} // 0 ) <=> ( $b->{version} // 0 ) } @posts;
 
-        print "Migrate $file\n";
-        eval {
-            my $content = File::Slurper::read_text($file);
-            $data = $ring->decode($content);
-            $data = json_remap($data);
-        };
-        $data = html_post($file) unless $data;
+# One query rather than one per post.
+my $present = $to->versions_present();
 
-        my $dt = DateTime->new(
-            year   => $year + 2000,
-            month  => $month,
-            day    => $date,
-            hour   => $hour,
-            minute => $min,
-            second => $sec,
-        );
-        $data->{created} = $dt->epoch();
+# Separately: an array in a list assignment swallows everything after it.
+my @batch;
+my ( $written, $skipped, $failed ) = ( 0, 0, 0 );
 
-        $data->{id}      = $data->{created};
-        $data->{tags}    = [ 'public', 'news' ];
-        $data->{version} = 0;
+sub flush_batch () {
+    return unless @batch;
 
-        open( my $fh, '>', "data/files/$data->{created}" ) or die;
-        print $fh encode_json( [$data] );
-        close $fh;
+    if ($dry_run) {
+        $written += scalar(@batch);
+        @batch = ();
+        return;
     }
-}
 
-# Migrate blog posts
-$dir = "$docroot/blog";
-
-opendir( my $bh, $dir ) or die;
-my @blogs = grep { -f "$dir/$_" } readdir $bh;    ## no critic (ProhibitFiletest_f) -- picking which entries to read
-closedir $bh;
-
-my $offset = 0;
-
-foreach my $post (
-    sort {
-        my $anum = $a =~ m/^(\d*)-/;
-        my $bnum = $b =~ m/^(\d*)-/;
-        $b <=> $a
-    } @blogs
-) {
-    my $postname = $post;
-    $postname =~ s/^\d*-//g;
-    $postname =~ s/\.post$//g;
-    my $content = File::Slurper::read_text("$dir/$post");
-
-    my $data = {
-        title => $postname,
-        data  => $content,
-        tags  => [ 'blog', 'public' ],
+    local $@;
+    eval {
+        $to->write( \@batch );
+        $written += scalar(@batch);
+        1;
+    } or do {
+        my $error = $@;
+        $failed += scalar(@batch);
+
+        # The batch was a transaction, so none of it landed.  Name what was in
+        # it, or the operator has an error and no idea which posts to look at.
+        say STDERR "Could not write a batch of " . scalar(@batch) . " post version(s): $error";
+        say STDERR "  the batch held: " . join( ', ', map { "$_->{id}\@" . ( $_->{version} // 0 ) } @batch );
     };
 
-    my ( undef, undef, undef, undef, $uid, undef, undef, undef, undef, $ctime ) = stat("$dir/$post");
-    my $user = lc( getpwuid($uid) );
-    $user = scalar( grep { $user eq $_ } qw{/sbin/nologin www-data} ) ? 'nobody' : $user;
-    $data->{user} = $user;
-    $ctime += $offset;
-    $data->{created} = $ctime;
-    $data->{id}      = $ctime;
-    $data->{href}    = "/blog/$ctime";
-    $data->{version} = 0;
-
-    print "Migrate blog post '$post'\n";
-    open( my $fh, '>', "data/files/$data->{created}" ) or die;
-    print $fh encode_json( [$data] );
-    close $fh;
-
-    $offset--;
+    @batch = ();
+    return;
 }
-exit 0;
-my $vdir = "$docroot/fileshare/video";
-opendir( my $vh, $vdir ) or die;
-my @vidyas = grep { -f "$vdir/$_" && $_ =~ m/\.m4v$/ } readdir $vh;    ## no critic (ProhibitFiletest_f) -- picking which entries to read
-closedir $vh;
-
-foreach my $vid (@vidyas) {
-    my $postname = $vid;
-    $postname =~ s/_/ /g;
-    $postname =~ s/\.mv4$//g;
-
-    my $data = {
-        title   => $postname,
-        data    => "Description forthcoming",
-        tags    => [ 'video', 'public' ],
-        preview => "/img/sys/testpattern.jpg",
-    };
 
-    my ( undef, undef, undef, undef, $uid, undef, undef, undef, undef, $ctime ) = stat("$vdir/$vid");
-    my $user = lc( getpwuid($uid) );
-    $user            = scalar( grep { $user eq $_ } qw{/sbin/nologin www-data} ) ? 'nobody' : $user;
-    $data->{user}    = $user;
-    $data->{created} = $ctime;
-    $data->{id}      = $ctime;
-    $data->{href}    = "/assets/$ctime-$vid";
-    $data->{version} = 0;
-
-    #Copy over the video
-    File::Copy::copy( "$vdir/$vid", "www/assets/$ctime-$vid" );
-
-    print "Migrate video '$vid'\n";
-    open( my $fh, '>', "data/files/$data->{created}" ) or die;
-    print $fh encode_json( [$data] );
-    close $fh;
+foreach my $post (@posts) {
+    if ( !$post->{id} ) {
+        say STDERR "Skipping a post with no id, which is not something this can carry over";
+        $failed++;
+        next;
+    }
+
+    if ( $present->{ $post->{id} }{ $post->{version} // 0 } ) {
+        $skipped++;
+        next;
+    }
+
+    push( @batch, $post );
+    flush_batch() if @batch >= $batch_size;
 }
+flush_batch();
 
-sub json_remap {
-    my $json = shift;
-
-    return {
-        preview    => $json->{"image"},
-        data       => $json->{"comment"},
-        user       => lc( $json->{"poster"} ),
-        title      => $json->{"title"},
-        audio_href => $json->{"audio"},
-        href       => $json->{"url"},
-        video_href => $json->{"video"},
-    };
+my $elapsed = Time::HiRes::tv_interval($started);
+
+if ($dry_run) {
+    say_unless_quiet( sprintf( "Would carry over %d post version(s); %d already present.", $written, $skipped ) );
+    say_unless_quiet("Nothing was written.  Re-run without --dry-run to do it.");
+    exit( $failed ? 1 : 0 );
 }
 
-sub html_post {
-    my $file          = shift;
-    my $is_first_link = 1;
-    my $data          = { data => '', href => '' };
-
-    my $p = HTML::Parser->new(
-        handlers => [
-            start => [
-                sub {
-                    my ( $self, $attr, $text, $tagname ) = @_;
-                    if ( $tagname eq 'a' && $is_first_link ) {
-                        $data->{href} = $attr->{href};
-                        return;
-                    }
-                    return if $is_first_link;
-                    return if $tagname eq 'hr';
-                    $data->{data} .= $text;
-                },
-                'self, attr, text,tagname'
-            ],
-            text => [
-                sub {
-                    my ( $self, $attr, $text, $tagname ) = @_;
-                    if ($is_first_link) {
-                        $data->{title} .= $text;
-                        return;
-                    }
-                    $data->{data} .= $text;
-                },
-                'self, attr, text,tagname'
-            ],
-            end => [
-                sub {
-                    my ( $self, $attr, $text, $tagname ) = @_;
-                    if ( $tagname eq 'a' && $is_first_link ) {
-                        $is_first_link = 0;
-                        return;
-                    }
-                    return if $is_first_link;
-                    $data->{data} .= $text;
-                },
-                'self, attr, text,tagname'
-            ],
-        ],
-    );
-    $p->parse_file($file);
-
-    #Get the user name from ownership
-    my ( undef, undef, undef, undef, $uid, undef, undef, undef, undef, $ctime ) = stat($file);
-    my $user = lc( getpwuid($uid) );
-    $user = scalar( grep { $user eq $_ } qw{/sbin/nologin www-data} ) ? 'nobody' : $user;
-    $data->{user} = $user;
-
-    $data->{created} = $ctime;
-
-    return $data;
+# Worth stating plainly rather than trusting the counters: they say what this
+# thought it did, and the databases say what is actually there.
+my $expected = scalar( grep { $_->{id} } @posts );
+my $have     = 0;
+$have += scalar( keys %$_ ) foreach values %{ $to->versions_present() };
+
+say_unless_quiet( sprintf( "Carried over %d post version(s), skipped %d already present, in %.1fs.", $written, $skipped, $elapsed ) );
+say_unless_quiet( sprintf( "data/files holds %d post version(s); data/posts.sqlite now holds %d.", $expected, $have ) );
+
+if ( $failed || $have < $expected ) {
+    say STDERR sprintf( "%d post version(s) did not make it across.  Fix what the errors above name and re-run; what landed will be skipped.", $failed || ( $expected - $have ) );
+    exit 1;
 }
+
+say_unless_quiet("Set general.data_model to SQLite in config/main.cfg and restart to serve from it.");
+exit 0;

bin/migrate2.pl

@@ -1,183 +0,0 @@
-#!/usr/bin/env perl
-
-use v5.36;
-use re '/aa';
-
-# Migrate early on tcms3 flatfile sites to 'all posts are series code' (august 2021) code
-
-use FindBin;
-
-use lib "$FindBin::Bin/../lib";
-
-use Trog::Config;
-use Trog::Data;
-use List::Util;
-use UUID::Tiny;
-
-use Trog::SQLite;
-use Trog::SQLite::TagIndex;
-
-=head1 SYNOPSIS
-
-Migrate early tCMS3 flatfile sites to the 'all posts are series' code (August
-2021).
-
-Re-keys every post from a timestamp onto a UUID, keeping the old URL as an
-alias so nothing already linked breaks, and fills in the fields that release
-started requiring: local_href, callback, method, visibility and the form each
-post is edited with.  Then it rebuilds the index and adds the series posts
-(/series, /about, /config) that the new code expects to exist.
-
-=head2 USAGE
-
-Edit $user and @extra_series below to suit your installation, then:
-
-    bin/migrate2.pl
-
-Run from the tCMS root.
-
-=head2 CAVEATS
-
-Historical, and one way.  It deletes the timestamp keyed flat files as it
-rewrites them, so take a backup of data/ before running it.
-
-Also unlinks data/posts.db up front, as the index is rebuilt at the end
-regardless.
-
-The form a post gets is guessed from its tags and content type, and series
-child_form from the series title, so anything unusual will want checking
-afterwards.
-
-=cut
-
-# Kill the post index
-unlink "$FindBin::Bin/../data/posts.db";
-$ENV{NOHUP} = 1;
-
-sub uuid { return UUID::Tiny::create_uuid_as_string( UUID::Tiny::UUID_V1, UUID::Tiny::UUID_NS_DNS ); }
-
-# Modify these variables to suit your installation.
-my $user = 'george';
-my @extra_series;
-
-my $conf        = Trog::Config::get();
-my $search_info = Trog::Data->new($conf);
-
-my @all = $search_info->get( raw => 1, limit => 0 );
-
-my %posts;
-foreach my $post (@all) {
-    $posts{ $post->{id} } //= [];
-
-    # Re-do the IDs
-    push( @{ $posts{ $post->{id} } }, $post );
-}
-
-foreach my $timestamp ( keys(%posts) ) {
-    my $file_to_kill = "$FindBin::Bin/../data/files/$timestamp";
-    my $new_id       = uuid();
-
-    # Preserve old URLs
-    foreach my $post ( @{ $posts{$timestamp} } ) {
-        delete $post->{app};
-        delete $post->{preview_file};
-        delete $post->{wallpaper_file};
-
-        delete $post->{scheme};
-        delete $post->{route};
-        delete $post->{domain};
-
-        $post->{id}         = $new_id;
-        $post->{local_href} = "/posts/$new_id";
-        $post->{aliases}    = ["/posts/$timestamp"];
-        $post->{callback}   = "Trog::Routes::HTML::posts";
-        $post->{method}     = 'GET';
-        @{ $post->{tags} } = grep { defined $_ } @{ $post->{tags} };
-
-        $post->{content_type} //= 'text/html';
-        $post->{form} = 'microblog.tx';
-        $post->{form} = 'blog.tx' if grep { $_ eq 'blog' } @{ $post->{tags} };
-        $post->{form} = 'file.tx' if $post->{content_type} =~ m/^video\//;
-        $post->{form} = 'file.tx' if $post->{content_type} =~ m/^audio\//;
-        $post->{form} = 'file.tx' if $post->{content_type} =~ m/^image\//;
-        if ( grep { $_ eq 'about' } @{ $post->{tags} } ) {
-            $post->{form}       = 'profile.tx';
-            $post->{local_href} = "/users/$post->{user}";
-            $post->{callback}   = "Trog::Routes::HTML::users";
-        }
-        if ( grep { $_ eq 'series' } @{ $post->{tags} } ) {
-            $post->{form}       = 'series.tx';
-            $post->{callback}   = "Trog::Routes::HTML::series";
-            $post->{child_form} = 'microblog.tx';
-            $post->{child_form} = 'blog.tx' if $post->{title} =~ m/^blog/i;
-            $post->{child_form} = 'file.tx' if $post->{title} =~ m/^video\//;
-            $post->{child_form} = 'file.tx' if $post->{title} =~ m/^audio\//;
-            $post->{child_form} = 'file.tx' if $post->{title} =~ m/^image\//;
-            $post->{local_href} = "/$post->{aclname}";
-            $post->{aliases}    = [ "/series/$timestamp", "/series/$new_id" ];
-        }
-
-        $search_info->write( [$post] );
-        unlink $file_to_kill;
-    }
-}
-
-# Rebuild the index
-Trog::SQLite::TagIndex::build_index($search_info);
-Trog::SQLite::TagIndex::build_routes($search_info);
-
-# Add in the series
-my $series = [
-    {
-        "aclname"    => "series",
-        "acls"       => [],
-        aliases      => [],
-        "callback"   => "Trog::Routes::HTML::series",
-        method       => 'GET',
-        "data"       => "Series",
-        "href"       => "/series",
-        "local_href" => "/series",
-        "preview"    => "/img/sys/testpattern.jpg",
-        "tags"       => [qw{series topbar}],
-        visibility   => 'public',
-        "title"      => "Series",
-        user         => $user,
-        form         => 'series.tx',
-        child_form   => 'series.tx',
-    },
-    {
-        "aclname"    => "about",
-        "acls"       => [],
-        aliases      => [],
-        "callback"   => "Trog::Routes::HTML::series",
-        method       => 'GET',
-        "data"       => "About",
-        "href"       => "/about",
-        "local_href" => "/about",
-        "preview"    => "/img/sys/testpattern.jpg",
-        "tags"       => [qw{series topbar public}],
-        visibility   => 'public',
-        "title"      => "About",
-        user         => $user,
-        form         => 'series.tx',
-        child_form   => 'profile.tx',
-    },
-    {
-        "aclname"      => "admin",
-        acls           => [],
-        aliases        => [],
-        "callback"     => "Trog::Routes::HTML::config",
-        'method'       => 'GET',
-        "content_type" => "text/plain",
-        "data"         => "Config",
-        "href"         => "/config",
-        "local_href"   => "/config",
-        "preview"      => "/img/sys/testpattern.jpg",
-        "tags"         => [qw{admin}],
-        visibility     => 'private',
-        "title"        => "Configure tCMS",
-        user           => $user,
-    },
-];
-
-$search_info->add( @$series, @extra_series );

bin/migrate3.pl

@@ -1,103 +0,0 @@
-#!/usr/bin/env perl
-
-use v5.36;
-use re '/aa';
-
-# Migrate early on tcms3 flatfile sites to store rather than compute much data (dec 2021) code
-
-use FindBin;
-
-use lib "$FindBin::Bin/../lib";
-
-use Trog::Config;
-use Trog::Data;
-use List::Util;
-use UUID::Tiny;
-
-use Trog::SQLite;
-use Trog::SQLite::TagIndex;
-
-=head1 SYNOPSIS
-
-Migrate early tCMS3 flatfile sites to store rather than compute much data
-(December 2021).
-
-Visibility used to be worked out from a post's tags on every read, and whether
-a series tiled its children from its href.  This walks every post and writes
-those out as fields, so that the reading code doesn't have to derive them.
-
-=head2 USAGE
-
-Edit $user below to suit your installation, then:
-
-    bin/migrate3.pl
-
-Run from the tCMS root.  Assumes migrate2.pl has already been run.
-
-=head2 CAVEATS
-
-Historical.  Posts are re-saved through the data model, so this creates a new
-revision of every post on the site.
-
-Posts with no visibility tag at all are left without one, as there's no safe
-guess between public and private.
-
-The 'All Posts' series at the end is left commented out; uncomment it if your
-instance wants /posts to be a series of its own.
-
-=cut
-
-# Kill the post index
-unlink "$FindBin::Bin/../data/posts.db";
-$ENV{NOHUP} = 1;
-
-sub uuid { return UUID::Tiny::create_uuid_as_string( UUID::Tiny::UUID_V1, UUID::Tiny::UUID_NS_DNS ); }
-
-# Modify these variables to suit your installation.
-my $user = 'george';
-my @extra_series;
-
-my $conf        = Trog::Config::get();
-my $search_info = Trog::Data->new($conf);
-
-my @all = $search_info->get( raw => 1, limit => 0 );
-foreach my $post (@all) {
-    if ( defined $post->{form} && $post->{form} eq 'series.tx' ) {
-        $post->{tiled} = scalar( grep { $_ eq $post->{local_href} } qw{/files /audio /video /image /series /about} );
-    }
-    if ( !defined $post->{visibility} ) {
-        $post->{visibility} = 'public'   if grep { $_ eq 'public' } @{ $post->{tags} };
-        $post->{visibility} = 'private'  if grep { $_ eq 'private' } @{ $post->{tags} };
-        $post->{visibility} = 'unlisted' if grep { $_ eq 'unlisted' } @{ $post->{tags} };
-    }
-
-    # Otherwise re-save the posts with is_video etc
-    $search_info->add($post);
-}
-
-# Rebuild the index
-Trog::SQLite::TagIndex::build_index($search_info);
-Trog::SQLite::TagIndex::build_routes($search_info);
-
-# Add in the series
-my $series = [
-    {
-        "acls"       => [],
-        aliases      => [],
-        "callback"   => "Trog::Routes::HTML::posts",
-        method       => 'GET',
-        "data"       => "All Posts",
-        "href"       => "/posts",
-        "local_href" => "/posts",
-        "preview"    => "/img/sys/testpattern.jpg",
-        "tags"       => [qw{series}],
-        visibility   => 'unlisted',
-        "title"      => "All Posts",
-        user         => $user,
-        form         => 'series.tx',
-        child_form   => 'series.tx',
-        aclname      => 'posts',
-    },
-];
-
-#$search_info->add(@$series,@extra_series);

bin/migrate4.pl

@@ -1,45 +0,0 @@
-#!/usr/bin/env perl
-
-# Migrate to 2FA
-
-use v5.36;
-use re '/aa';
-
-use FindBin;
-
-use lib "$FindBin::Bin/../lib";
-
-use Trog::SQLite;
-
-=head1 SYNOPSIS
-
-Migrate to 2FA.
-
-Adds the totp_secret column to the auth database's user table, which is where
-Trog::Auth::totp() stores a user's TOTP secret once they enroll.
-
-=head2 USAGE
-
-    bin/migrate4.pl
-
-Run from the tCMS root, as the schema and database paths are relative to it.
-
-=head2 CAVEATS
-
-Historical, and not idempotent -- SQLite will refuse a second ALTER TABLE for a
-column which already exists, so re-running it dies rather than doing nothing.
-
-Existing users end up with a NULL secret, which is to say 2FA off, and can
-enroll whenever they like.
-
-=cut
-
-sub _dbh {
-    my $file   = 'schema/auth.schema';
-    my $dbname = "config/auth.db";
-    return Trog::SQLite::dbh( $file, $dbname );
-}
-
-my $dbh = _dbh();
-
-$dbh->do("ALTER TABLE user ADD COLUMN totp_secret TEXT DEFAULT NULL;");

bin/migrate5.pl

@@ -1,45 +0,0 @@
-#!/usr/bin/env perl
-
-# Password reset code
-
-use v5.36;
-use re '/aa';
-
-use FindBin;
-
-use lib "$FindBin::Bin/../lib";
-
-use Trog::SQLite;
-
-=head1 SYNOPSIS
-
-Password reset code.
-
-Adds the contact_email column to the auth database's user table, without which
-there is nowhere to send a password reset to.
-
-=head2 USAGE
-
-    bin/migrate5.pl
-
-Run from the tCMS root, as the schema and database paths are relative to it.
-
-=head2 CAVEATS
-
-Historical, and not idempotent -- SQLite will refuse a second ALTER TABLE for a
-column which already exists, so re-running it dies rather than doing nothing.
-
-Existing users end up with a NULL contact email and so can't reset their own
-password until one is set.  Fix that with bin/tcms-useradd --contact_email.
-
-=cut
-
-sub _dbh {
-    my $file   = 'schema/auth.schema';
-    my $dbname = "config/auth.db";
-    return Trog::SQLite::dbh( $file, $dbname );
-}
-
-my $dbh = _dbh();
-
-$dbh->do("ALTER TABLE user ADD COLUMN contact_email TEXT DEFAULT NULL;");

bin/migrate6.pl

@@ -1,95 +0,0 @@
-#!/usr/bin/env perl
-
-# Display names
-
-use v5.36;
-use re '/aa';
-
-use FindBin;
-
-use lib "$FindBin::Bin/../lib";
-
-use Trog::SQLite;
-
-=head1 SYNOPSIS
-
-Display names.
-
-Adds the display_name column to the auth database's user table, then walks the
-flat file posts and converts profile posts from being titled with the user's
-login name to being titled with their display name, moving them from
-/users/<login> to /users/<display name> in the process.
-
-=head2 USAGE
-
-    bin/migrate6.pl
-
-Run from the tCMS root.  Rebuild the post index afterwards, as the profile
-posts have changed their local_href and the routes table still points at the
-old one -- the script says so when it has actually changed something.
-
-=head2 CAVEATS
-
-Historical, and not idempotent -- SQLite will refuse a second ALTER TABLE for a
-column which already exists, so re-running it dies rather than doing nothing.
-
-Post revisions are rewritten in place rather than through the data model, so
-take a backup of data/ before running it.
-
-Users with no display name set are skipped, which leaves their profile post
-where it was.
-
-=cut
-
-sub _dbh {
-    my $file   = 'schema/auth.schema';
-    my $dbname = "config/auth.db";
-    return Trog::SQLite::dbh( $file, $dbname );
-}
-
-my $dbh = _dbh();
-
-$dbh->do("ALTER TABLE user ADD COLUMN display_name TEXT DEFAULT NULL;");
-
-# Update all the profile type posts to have correct display names
-use Trog::Auth;
-use JSON::MaybeXS;
-use File::Slurper;
-use File::Slurper::Temp;
-use URI::Escape;
-use Data::Dumper;
-
-my $global_changes;
-opendir( my $dh, 'data/files' );
-while ( my $entry = readdir $dh ) {
-    my $fname = "data/files/$entry";
-    next unless -f $fname;    ## no critic (ProhibitFiletest_f) -- skipping . and .. and any subdirs
-    my $contents = File::Slurper::read_binary($fname);
-    my $decoded  = JSON::MaybeXS::decode_json($contents);
-    next unless List::Util::any { $_->{is_profile} } @$decoded;
-
-    # If the title on the profile post responsds to a username, then let's change that to a display name
-    my $made_changes;
-    foreach my $revision (@$decoded) {
-        my $user         = $revision->{title};
-        my $display_name = Trog::Auth::username2display($user);
-        next unless $display_name;
-        print "converting $user to display name $display_name\n";
-        $revision->{title}      = $display_name;
-        $revision->{local_href} = "/users/$display_name";
-        $made_changes           = 1;
-    }
-    next unless $made_changes;
-
-    print "Writing changes to $fname\n";
-    my $encoded = JSON::MaybeXS::encode_json($decoded);
-
-    # Temp:: rather than plain File::Slurper -- it writes to a tempfile and
-    # renames over the target, so a crash partway can't leave a half written
-    # post behind.
-    File::Slurper::Temp::write_binary( $fname, $encoded );
-
-    # Next, waste and rebuild the posts index for these user posts
-    $global_changes = 1;
-}
-print "Changes made.  Please rebuild the posts index.\n" if $global_changes;

config/default.cfg

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

lib/Trog/Data/SQLite.pm

@@ -232,7 +232,7 @@ sub _where ($query) {
     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.
+        # Only bin/migrate.pl and an index rebuild ask for it.
     }
     elsif ( @$acls && !any { $_ eq 'admin' } @$acls ) {
         my $binds = join( ',', map { '?' } @$acls );
@@ -305,11 +305,38 @@ 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.
 
+Several posts go in as one transaction, so a batch either lands or it doesn't --
+add() hands us everything it was given at once, and half a save is not a state
+anybody asked for.  It is also the difference between a migration taking seconds
+and taking minutes, since SQLite otherwise commits once per row.
+
 =cut
 
 sub write ( $self, $data ) {
     my $dbh = _dbh();
 
+    # Only if we are not already inside someone else's transaction: begin_work
+    # dies rather than nesting.
+    my $mine = $dbh->{AutoCommit} ? $dbh->begin_work : 0;
+
+    local $@;
+    eval {
+        _insert( $dbh, $data );
+        $dbh->commit if $mine;
+        1;
+    } or do {
+        my $error = $@;
+        if ($mine) {
+            local $@;
+            eval { $dbh->rollback; 1 } or WARN("Could not roll back a failed write: $@");
+        }
+        confess $error;
+    };
+
+    return 1;
+}
+
+sub _insert ( $dbh, $data ) {
     my $insert = $dbh->prepare('INSERT INTO posts (post_data) VALUES (?)');
 
     foreach my $post (@$data) {
@@ -332,6 +359,23 @@ sub write ( $self, $data ) {
     return 1;
 }
 
+=head2 versions_present() = HASHREF
+
+Every (uuid, version) already stored, as C<< { uuid => { version => 1 } } >>.
+
+For bulk importers, which would otherwise ask the database once per post
+whether it has seen it before.  See bin/migrate.pl.
+
+=cut
+
+sub versions_present ($self) {
+    my $rows = _dbh()->selectall_arrayref( 'SELECT uuid, version FROM posts', { Slice => {} } ) // [];
+
+    my %present;
+    $present{ $_->{uuid} }{ $_->{version} } = 1 foreach @$rows;
+    return \%present;
+}
+
 =head2 delete(@posts)
 
 Remove every version of each post.  The triggers in the schema take the tag rows

t/Trog-Data-SQLite.t

@@ -186,7 +186,7 @@ subtest 'versions' => sub {
     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.
+    # 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' );

t/bin-migrate.t

@@ -0,0 +1,205 @@
+#!/usr/bin/env perl
+
+# bin/migrate.pl carries a FlatFile site's posts into the SQLite model.  The
+# thing worth asserting is not that it copies rows, it is that the site answers
+# the same questions afterwards -- so this builds a corpus through the FlatFile
+# model, migrates, and compares the two models query for query.
+
+use strict;
+use warnings;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+
+use Test::More;
+use Test::MockModule qw{strict};
+
+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-migrate-XXXXXX', TMPDIR => 1, CLEANUP => 1 );
+
+    $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::FlatFile') or BAIL_OUT("Can't find the model to migrate from");
+require_ok('Trog::Data::SQLite')   or BAIL_OUT("Can't find the model to migrate to");
+require Trog::Config;
+require Trog::SQLite::TagIndex;
+
+my $auth = Test::MockModule->new('Trog::Auth');
+$auth->redefine( username2display   => sub { return "Display $_[0]" } );
+$auth->redefine( username2classname => sub { return "class-$_[0]" } );
+
+my $config = Trog::Config::get();
+my $flat   = Trog::Data::FlatFile->new($config);
+my $sqlite = Trog::Data::SQLite->new($config);
+
+# The script is the thing under test, so run it the way an operator would.
+sub migrate {
+    my (@args) = @_;
+    my $out = qx{$^X "-I$REPO/lib" "$REPO/bin/migrate.pl" @args 2>&1};
+    return ( $?, $out );
+}
+
+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,
+        tags => [ @{ $o{tags} // ['blog'] }, $o{visibility} // 'public' ],
+
+        # What add() would have filled in.  Without them the flat file model's
+        # index build warns about a post it cannot route.
+        local_href => $o{local_href} // "/posts/$o{id}",
+        callback   => 'Trog::Routes::HTML::posts',
+        method     => 'GET',
+    };
+}
+
+subtest 'nothing to migrate' => sub {
+    my ( $rc, $out ) = migrate();
+    isnt( $rc, 0, 'an empty datastore is an error rather than a silent success' );
+    like( $out, qr/No posts found/, 'and says so' );
+    unlike( $out, qr/ at \S+ line \d+/, 'without a stack trace, since it is not a crash' );
+};
+
+# A corpus with the awkward bits: several versions of one post, a private one,
+# a post whose body is an array, and one carrying a tag nothing else has.
+my @corpus = (
+    post( id => 'p-one',    title => 'The First',    data => 'quick brown fox',            tags       => [qw{blog topbar}] ),
+    post( id => 'p-one',    title => 'The First v2', data => 'quick brown fox, revised',   tags       => [qw{blog topbar}], version => 1 ),
+    post( id => 'p-one',    title => 'The First v3', data => 'quick brown fox, again',     tags       => [qw{blog topbar}], version => 2 ),
+    post( id => 'p-secret', title => 'Hidden',       data => 'not for you',                visibility => 'private' ),
+    post( id => 'p-deck',   title => 'A Deck',       data => [ 'slide one', 'slide two' ], form       => 'presentation.tx' ),
+    post( id => 'p-ann',    title => 'By Ann',       data => 'ann wrote this',             user       => 'ann', author => 'ann', tags => [qw{blog rare}] ),
+);
+$flat->write( [$_] ) foreach @corpus;
+
+# FlatFile memoizes both the tag list and the posts for a given set of tags at
+# load time, and writing a post invalidates neither -- production gets away with
+# it because a save re-execs the worker.  Anything reading back what it just
+# wrote in one process has to do it by hand.
+sub reset_flatfile_cache {
+    no warnings qw{once};
+    @Trog::Data::FlatFile::tags         = Trog::SQLite::TagIndex::tags();
+    %Trog::Data::FlatFile::posts_by_tag = ();
+    return;
+}
+
+reset_flatfile_cache();
+
+subtest 'a dry run writes nothing' => sub {
+    my ( $rc, $out ) = migrate('--dry-run');
+    is( $rc, 0, 'it succeeds' ) or diag($out);
+    like( $out, qr/Would carry over 6 post version\(s\)/, 'and counts every version, not every post' );
+    like( $out, qr/Nothing was written/,                  'and says it wrote nothing' );
+
+    is( $sqlite->count(), 0, 'because it wrote nothing' );
+};
+
+subtest 'the migration itself' => sub {
+    my ( $rc, $out ) = migrate();
+    is( $rc, 0, 'it succeeds' ) or diag($out);
+    like( $out, qr/Carried over 6 post version\(s\), skipped 0/,                            'carrying over every version' );
+    like( $out, qr/data\/files holds 6 post version\(s\); data\/posts\.sqlite now holds 6/, 'and says what actually landed' );
+
+    is( $sqlite->count(), 4, 'four posts' );
+
+    my $present = $sqlite->versions_present();
+    is_deeply( [ sort keys %{ $present->{'p-one'} } ], [ 0, 1, 2 ], 'with the whole version history of the one that has one' );
+};
+
+subtest 'the two models now answer the same questions' => sub {
+    my @queries = (
+        [ 'everything an admin sees' => { limit => 0, acls => ['admin'] } ],
+        [ 'what a visitor sees'      => { limit => 0, acls => ['public'] } ],
+        [ 'by tag'           => { limit => 0, acls => ['admin'], tags   => ['topbar'] } ],
+        [ 'by a rare tag'    => { limit => 0, acls => ['admin'], tags   => ['rare'] } ],
+        [ 'by author'        => { limit => 0, acls => ['admin'], author => 'ann' } ],
+        [ 'by id'            => { limit => 0, id   => 'p-one' } ],
+        [ 'an older version' => { limit => 0, id   => 'p-one',   version => 1 } ],
+        [ 'by form'          => { limit => 0, acls => ['admin'], form    => 'presentation.tx' } ],
+    );
+
+    foreach my $case (@queries) {
+        my ( $name, $query ) = @$case;
+        my $want = [ sort map { "$_->{id}\@$_->{version}" } $flat->get(%$query) ];
+        my $got  = [ sort map { "$_->{id}\@$_->{version}" } $sqlite->get(%$query) ];
+        is_deeply( $got, $want, $name ) or diag("flatfile: @$want\nsqlite:   @$got");
+    }
+
+    # The rolled up fields have to survive the trip, not just the rows.
+    my ($current) = $sqlite->get( limit => 0, id => 'p-one' );
+    is( $current->{version},     2,                   'the newest version is the current one' );
+    is( $current->{version_max}, 2,                   'version_max came across' );
+    is( $current->{title},       'The First v3',      'with the newest content' );
+    is( $current->{created},     $corpus[0]{created}, 'created is still the post birthday' );
+    is( $current->{modified},    $corpus[2]{created}, 'and modified the last edit' );
+
+    # Search is built during the migration, not left to be rebuilt later.
+    my @found = map { $_->{id} } $sqlite->get( limit => 0, acls => ['admin'], like => 'own fox' );
+    is_deeply( [ sort @found ], ['p-one'], 'and the search index was built on the way in' );
+};
+
+subtest 'running it again' => sub {
+    my ( $rc, $out ) = migrate();
+    is( $rc, 0, 'succeeds' ) or diag($out);
+    like( $out, qr/Carried over 0 post version\(s\), skipped 6/, 'and carries nothing over twice' );
+    is( $sqlite->count(), 4, 'leaving the post count alone' );
+};
+
+subtest 'picking up what was written in between' => sub {
+
+    # The reason re-running has to work: run once against a live site, once more
+    # after a final quiet period.
+    $flat->write( [ post( id => 'p-late', title => 'Written Later', data => 'after the first pass' ) ] );
+    reset_flatfile_cache();
+
+    my ( $rc, $out ) = migrate();
+    is( $rc, 0, 'succeeds' ) or diag($out);
+    like( $out, qr/Carried over 1 post version\(s\), skipped 6/, 'carrying over only the new one' );
+
+    my ($late) = $sqlite->get( limit => 0, id => 'p-late' );
+    is( $late->{title}, 'Written Later', 'which is there afterwards' );
+};
+
+subtest 'the flat files are left alone' => sub {
+    opendir( my $dh, 'data/files' ) or die $!;
+    my @files = grep { !m/^\.\.?$/ } readdir($dh);
+    closedir $dh;
+
+    is( scalar(@files), 5, 'every post still has its file' );
+    ok( -f 'data/posts.db', "and the flat file model's own index is untouched" );
+
+    # Which is what makes going back possible.
+    my @still = $flat->get( limit => 0, acls => ['admin'] );
+    is( scalar(@still), 5, 'and the old model still reads them' );
+};
+
+done_testing();