Merge pull request #356 from Troglodyne-Internet-Widgets/rebuild-index-from-scratch

Rebuild the tag index from scratch, as build_index.pl says it does

Makefile.PL

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

bin/build_index.pl

@@ -10,12 +10,15 @@ use Trog::SQLite::TagIndex;
 
 =head1 SYNOPSIS
 
-Rebuild the post index and the route table from the posts on disk.
+Rebuild the FlatFile model's tag index and route table, data/posts.db, from the
+posts in data/files.
 
-Use this to build the post index after you import data, otherwise it's not
-needed -- the index is maintained as posts are written, so the only time it
-gets out of step with the flat files is when something other than tCMS put them
-there.
+Use this to build the index after you import posts, otherwise it is not needed:
+tCMS keeps the index up to date as it writes posts, so the only time it gets out
+of step with the flat files is when something other than tCMS put them there.
+
+The SQLite model keeps its tags and routes with the posts, and has no separate
+index.  On a site served from it, this says so and changes nothing.
 
 =head2 USAGE
 
@@ -24,12 +27,15 @@ there.
 Takes no arguments, and must be run from the tCMS root, as the data paths in
 the configuration are relative to it.
 
-Safe to re-run; it rebuilds from scratch rather than adding to what's there.
+Safe to re-run.  It empties the index first and builds it again, in one
+transaction, so tags and routes that no post has any more are gone afterwards.
 
 =cut
 
-my $conf   = Trog::Config::get();
-my $search = Trog::Data->new($conf);
+my $data = Trog::Data->new( Trog::Config::get() );
+if ( !$data->isa('Trog::Data::FlatFile') ) {
+    say "This site serves from " . ref($data) . ", which has no separate index.  Nothing to do.";
+    exit 0;
+}
 
-Trog::SQLite::TagIndex::build_index($search);
-Trog::SQLite::TagIndex::build_routes($search);
+Trog::SQLite::TagIndex::rebuild($data);

lib/Trog/Data/SQLite.pm

@@ -321,24 +321,7 @@ and taking minutes, since SQLite otherwise commits once per row.
 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;
-    };
-
+    Trog::SQLite::transaction( $dbh, sub { _insert( $dbh, $data ) } );
     return 1;
 }
 

lib/Trog/SQLite/TagIndex.pm

@@ -54,8 +54,42 @@ sub tags {
 
 sub add_post ( $post, $data_obj ) {
     my $dbh = _dbh();
-    build_index( $data_obj, [$post] );
-    build_routes( $data_obj, [$post] );
+    Trog::SQLite::transaction(
+        $dbh,
+        sub {
+            # posts_index has no key for INSERT OR IGNORE to skip a duplicate on,
+            # so a save would add every tag again and keep the ones it removed.
+            $dbh->do( "DELETE FROM posts_index WHERE post_id IN (SELECT id FROM post WHERE uuid=?)", undef, $post->{id} );
+            build_index( $data_obj, [$post] );
+            build_routes( $data_obj, [$post] );
+        }
+    );
+    return 1;
+}
+
+=head2 rebuild($data_obj)
+
+Empty the index, the route table and the aliases, then fill them again from
+every post $data_obj holds.  It is one transaction, so a reader sees the old
+index or the new one, and never an empty one.
+
+The HTTP methods are kept, as the schema fills those rather than any post.
+
+=cut
+
+sub rebuild ($data_obj) {
+    my $dbh = _dbh();
+    Trog::SQLite::transaction(
+        $dbh,
+        sub {
+            # Cascades to posts_index, routes and post_aliases.
+            $dbh->do("DELETE FROM post");
+            $dbh->do("DELETE FROM tag");
+            $dbh->do("DELETE FROM callbacks");
+            build_index($data_obj);
+            build_routes($data_obj);
+        }
+    );
     return 1;
 }
 

t/Trog-Data-SQLite.t

@@ -352,6 +352,10 @@ subtest 'writing' => sub {
 
     like( exception { $sqlite->write( [ { title => 'No Id' } ] ) }, qr/no id/i, 'a post with no id is refused' );
 
+    my $count = $sqlite->count();
+    ok( exception { $sqlite->write( [ post( id => 'p-half', title => 'Half' ), { title => 'No Id' } ] ) }, 'a batch with a post it refuses is refused' );
+    is( $sqlite->count(), $count, 'and none of the batch lands' );
+
     # 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' );

t/Trog-SQLite-TagIndex.t

@@ -0,0 +1,102 @@
+use strict;
+use warnings;
+
+use Test::More;
+use Cwd        ();
+use File::Copy ();
+use File::Path ();
+use File::Temp ();
+use FindBin;
+
+use lib "$FindBin::Bin/../lib";
+
+use_ok('Trog::SQLite::TagIndex') or BAIL_OUT("Can't find SUT");
+
+# The index opens schema/ and data/ relative to the cwd, so it gets a root of
+# its own with the real schema in it.
+my $oldcwd = Cwd::getcwd();
+my $root   = File::Temp::tempdir( CLEANUP => 1 );
+File::Path::make_path( "$root/schema", "$root/data" );
+File::Copy::copy( "$FindBin::Bin/../schema/flatfile.schema", "$root/schema/flatfile.schema" ) or die "Could not copy the schema: $!";
+chdir $root                                                                                   or die "Could not chdir to $root: $!";
+
+# A data model holding whatever posts it is given, answering read() and get()
+# the way build_index() and build_routes() ask.
+package Fake::Data {
+    sub new  { my ( $class, @posts ) = @_; return bless( { posts => \@posts }, $class ) }
+    sub read { my ($self) = @_; return [ @{ $self->{posts} } ] }
+    sub get  { my ($self) = @_; return @{ $self->{posts} } }
+}
+
+# One that gets as far as the index, then falls over before the routes.
+package Broken::Data {
+    our @ISA = ('Fake::Data');
+    sub get { die "the data model fell over\n" }
+}
+
+sub post {
+    my (%over) = @_;
+    return {
+        id         => 'p-one',
+        tags       => [qw{blog public}],
+        created    => 1700000000,
+        local_href => '/posts/p-one',
+        method     => 'GET',
+        callback   => 'Trog::Routes::HTML::posts',
+        aliases    => [],
+        %over,
+    };
+}
+
+sub index_rows {
+    my $rows = Trog::SQLite::TagIndex::_dbh()->selectall_arrayref( 'SELECT id, tag FROM posts ORDER BY id, tag', { Slice => {} } );
+    return [ map { "$_->{id}:$_->{tag}" } @$rows ];
+}
+
+subtest 'add_post' => sub {
+    my $data = Fake::Data->new();
+
+    Trog::SQLite::TagIndex::add_post( post(), $data );
+    Trog::SQLite::TagIndex::add_post( post(), $data );
+    is_deeply( index_rows(), [qw{p-one:blog p-one:public}], 'saving a post twice indexes its tags once' );
+
+    Trog::SQLite::TagIndex::add_post( post( tags => ['public'] ), $data );
+    is_deeply( index_rows(),                                       ['p-one:public'], 'and a tag the edit removed is gone' );
+    is_deeply( [ Trog::SQLite::TagIndex::posts_for_tags('blog') ], [],               'so the post no longer turns up under it' );
+};
+
+subtest 'rebuild' => sub {
+    my $dbh = Trog::SQLite::TagIndex::_dbh();
+
+    # What an index looks like after something other than tCMS changed the
+    # posts: a post that is gone, and a route to it.
+    Trog::SQLite::TagIndex::add_post( post( id => 'p-gone', local_href => '/posts/p-gone', aliases => ['/gone'] ), Fake::Data->new() );
+    $dbh->do('INSERT INTO posts_index (post_id, post_time, tag_id) SELECT post_id, post_time, tag_id FROM posts_index');
+
+    my $data = Fake::Data->new( post( tags => [qw{blog public}] ), post( id => 'p-two', tags => ['public'], local_href => '/posts/p-two' ) );
+    Trog::SQLite::TagIndex::rebuild($data);
+
+    is_deeply( index_rows(), [qw{p-one:blog p-one:public p-two:public}], 'the index holds exactly the posts there are, once each' );
+
+    my %routes = Trog::SQLite::TagIndex::routes();
+    is_deeply( [ sort keys %routes ],                 [qw{/posts/p-one /posts/p-two}], 'and the routes of those posts only' );
+    is_deeply( { Trog::SQLite::TagIndex::aliases() }, {},                              'with the gone post\'s alias gone too' );
+
+    my ($methods) = $dbh->selectrow_array('SELECT COUNT(*) FROM methods');
+    ok( $methods, 'the HTTP methods the schema fills are kept' );
+
+    Trog::SQLite::TagIndex::rebuild($data);
+    is_deeply( index_rows(), [qw{p-one:blog p-one:public p-two:public}], 'running it again changes nothing' );
+};
+
+subtest 'rebuild is one transaction' => sub {
+    my $before = index_rows();
+
+    my $broken = Broken::Data->new( post() );
+    ok( !eval { Trog::SQLite::TagIndex::rebuild($broken); 1 }, 'a rebuild that fails part way dies' );
+    like( $@, qr/fell over/a, 'with the error that stopped it' );
+    is_deeply( index_rows(), $before, 'and leaves the index as it was' );
+};
+
+chdir $oldcwd;
+done_testing();