#!/usr/bin/env perl use 5.040; use re '/aasx'; use warnings FATAL => 'all'; use Test::More; use Test::Fatal qw{exception}; use Cwd (); use File::Copy (); use File::Path (); use File::Temp (); use FindBin; use FindBin::libs; 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 { use parent -norequire, '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() ); my $err = exception { Trog::SQLite::TagIndex::rebuild($broken) }; ok( $err, 'a rebuild that fails part way dies' ); like( $err, qr/fell[ ]over/, 'with the error that stopped it' ); is_deeply( index_rows(), $before, 'and leaves the index as it was' ); }; chdir $oldcwd; done_testing();