tCMS/lib/Trog/SQLite/TagIndex.pm

package Trog::SQLite::TagIndex;

use strict;
use warnings;

no warnings 'experimental';
use feature qw{signatures};

use URI::Escape;
use List::Util qw{uniq};
use Trog::SQLite;

=head1 Trog::SQLite::TagIndex

An SQLite3 index of posts by tag and date.
Used to speed up the flat-file data model.

Also used to retrieve cached routes from posts.

=head1 FUNCTIONS

=cut

sub posts_for_tags (@tags) {
    my $dbh    = _dbh();
    my $clause = @tags ? "WHERE tag IN (" . join( ',', ( map { '?' } @tags ) ) . ")" : '';
    my $rows   = $dbh->selectall_arrayref( "SELECT DISTINCT id FROM posts $clause ORDER BY created DESC", { Slice => {} }, @tags );
    return () unless ref $rows eq 'ARRAY' && @$rows;
    return map { $_->{id} } @$rows;
}

sub routes {
    my $dbh  = _dbh();
    my $rows = $dbh->selectall_arrayref( "SELECT id, route, method, callback FROM all_routes", { Slice => {} } );
    return () unless ref $rows eq 'ARRAY' && @$rows;

    #XXX not sure how this gets escaped going in.
    my %routes = map { URI::Escape::uri_unescape( $_->{route} ) => $_ } @$rows;
    return %routes;
}

sub aliases {
    my $dbh  = _dbh();
    my $rows = $dbh->selectall_arrayref( "SELECT actual,alias FROM aliases", { Slice => {} } );
    return () unless ref $rows eq 'ARRAY' && @$rows;
    my %aliases = map { $_->{alias} => $_->{actual} } @$rows;
    return %aliases;
}

sub tags {
    my $dbh  = _dbh();
    my $rows = $dbh->selectall_arrayref( "SELECT name FROM tag", { Slice => {} } );
    return () unless ref $rows eq 'ARRAY' && @$rows;
    return map { $_->{name} } @$rows;
}

sub add_post ( $post, $data_obj ) {
    my $dbh = _dbh();
    build_index( $data_obj, [$post] );
    build_routes( $data_obj, [$post] );
    return 1;
}

sub remove_post ($post) {
    my $dbh = _dbh();

    # Deleting the post will cascade to the post index & primary route, which cascades to the aliases
    $dbh->do( "DELETE FROM post WHERE uuid=?", undef, $post->{id} );

    # Now that we've wasted the routes and post, let's reap any dangling tags or callbacks.
    # We won't ever reap methods, because they're just HTTP methods in an enum table.
    $dbh->do("DELETE from callbacks WHERE id NOT IN (SELECT DISTINCT callback_id FROM routes)");
    $dbh->do("DELETE from tag WHERE id NOT IN (SELECT DISTINCT tag_id FROM posts_index)");
    return 1;
}

sub build_index ( $data_obj, $posts = [] ) {
    my $dbh = _dbh();
    $posts = $data_obj->read( { limit => 0, acls => ['admin'] } ) unless @$posts;

    # First, slap in the UUIDs
    my @uuids = map { $_->{id} } @$posts;
    Trog::SQLite::bulk_insert( $dbh, 'post', ['uuid'], 'IGNORE', @uuids );
    my $pids = _id_for_uuid( $dbh, @uuids );
    foreach my $post (@$posts) {
        $post->{post_id} = $pids->{ $post->{id} }{id};
    }

    # Slap in the tags, plus the aclname in the event this is a series
    my @tags = uniq map { @{ $_->{tags} }, $_->{aclname} } @$posts;
    Trog::SQLite::bulk_insert( $dbh, 'tag', ['name'], 'IGNORE', @tags );

    #TODO restrict query to only the specific tags we care about
    my $t = $dbh->selectall_hashref( "SELECT id,name FROM tag", 'name' );
    foreach my $k ( keys(%$t) ) { $t->{$k} = $t->{$k}->{id} }

    # Finally, index the posts
    Trog::SQLite::bulk_insert(
        $dbh,
        'posts_index',
        [qw{post_id post_time tag_id}],
        'IGNORE',
        map {
            my $subj = $_;
            map { ( $subj->{post_id}, $subj->{created}, $t->{$_} ) } @{ $subj->{tags} }
        } @$posts
    );
}

sub _id_for_uuid ( $dbh, @uuids ) {
    my $bind = join( ',', ( map { '?' } @uuids ) );
    Trog::SQLite::bulk_insert( $dbh, 'post', ['uuid'], 'IGNORE', @uuids );
    return $dbh->selectall_hashref( "SELECT id,uuid FROM post WHERE uuid IN ($bind)", 'uuid', {}, @uuids );
}

# It is important we use get() instead of read() because of incomplete data.
sub build_routes ( $data_obj, $posts = [] ) {
    my $dbh = _dbh();
    @$posts = $data_obj->get( limit => 0, acls => ['admin'] ) unless @$posts;

    my @uuids = map { $_->{id} } @$posts;
    my $pids  = _id_for_uuid( $dbh, @uuids );
    foreach my $post (@$posts) {
        $post->{post_id} = $pids->{ $post->{id} }{id};
    }

    # Ensure the callbacks we need are installed
    Trog::SQLite::bulk_insert( $dbh, 'callbacks', [qw{callback}], 'IGNORE', ( uniq map { $_->{callback} } @$posts ) );

    my $m = $dbh->selectall_hashref( "SELECT id, method FROM methods", 'method' );
    foreach my $k ( keys(%$m) ) { $m->{$k} = $m->{$k}->{id} }
    my $c = $dbh->selectall_hashref( "SELECT id, callback FROM callbacks", 'callback' );
    foreach my $k ( keys(%$c) ) { $c->{$k} = $c->{$k}->{id} }
    @$posts = map {
        $_->{method_id}   = $m->{ $_->{method} };
        $_->{callback_id} = $c->{ $_->{callback} };
        $_
    } @$posts;

    my @routes = map { ( $_->{post_id}, $_->{local_href}, $_->{method_id}, $_->{callback_id} ) } @$posts;
    Trog::SQLite::bulk_insert( $dbh, 'routes', [qw{post_id route method_id callback_id}], 'IGNORE', @routes );

    # Now, compile the post aliases
    my %routes_actual = routes();
    foreach my $post (@$posts) {
        next unless ( ref $post->{aliases} eq 'ARRAY' ) && @{ $post->{aliases} };
        my $route = $post->{local_href};
        Trog::SQLite::bulk_insert( $dbh, 'post_aliases', [qw{route_id alias}], 'IGNORE', map { ( $routes_actual{$route}{id}, $_ ) } @{ $post->{aliases} } );
    }
}

# Ensure the db schema is OK, and give us a handle
sub _dbh {
    my $file   = 'schema/flatfile.schema';
    my $dbname = "data/posts.db";
    return Trog::SQLite::dbh( $file, $dbname );
}

1;