tCMS/lib/Trog/Data/FlatFile.pm

package Trog::Data::FlatFile;

use v5.36;
use re '/aa';

use Carp  qw{confess};
use Fcntl qw{LOCK_EX SEEK_SET};
use JSON::MaybeXS;
use File::Slurper;
use File::Copy;
use Path::Tiny();
use Capture::Tiny qw{capture_merged};

use lib 'lib';
use Trog::SQLite::TagIndex;

use parent qw{Trog::DataModule};

our $datastore = 'data/files';
sub lang { 'Perl Regex in Quotemeta' }
sub help { 'https://perldoc.perl.org/functions/quotemeta.html' }

=head1 Trog::Data::FlatFile

This data model has multiple drawbacks, but is "good enough" for most low-content and few editor applications.
You can only post once per second due to it storing each post as a file named after the timestamp.

=cut

our $parser = JSON::MaybeXS->new( utf8 => 1 );

# Initialize the list of posts by tag for all known tags.
# This is because the list won't ever change between HUPs
our @tags = Trog::SQLite::TagIndex::tags();
our %posts_by_tag;

sub read ( $self, $query = {} ) {
    $query->{limit} //= 25;

    #Optimize direct ID
    my @index;
    if ( $query->{id} ) {
        @index = ("$datastore/$query->{id}");
    }
    else {
        # Remove tags which we don't care about and sort to keep memoized memory usage down
        @{ $query->{tags} } = sort grep {
            my $t = $_;
            grep { $t eq $_ } @tags
        } @{ $query->{tags} };
        my $tagkey = join( '&', @{ $query->{tags} } );

        # Check against memoizer
        $posts_by_tag{$tagkey} //= [];
        @index = @{ $posts_by_tag{$tagkey} } if @{ $posts_by_tag{$tagkey} };

        if ( !@index && -f 'data/posts.db' ) {    ## no critic (ProhibitFiletest_f) -- use the tag index, else fall back to _index()
            @index = map { "$datastore/$_" } Trog::SQLite::TagIndex::posts_for_tags( @{ $query->{tags} } );
            $posts_by_tag{$tagkey} = \@index;
        }
        @index = $self->_index() unless @index;
    }

    my @items;
    foreach my $item (@index) {
        my $slurped = eval { File::Slurper::read_text($item) };
        if ( !$slurped ) {
            print "Failed to Read $item:\n$@\n";
            next;
        }
        my $parsed;
        capture_merged {
            $parsed = eval { $parser->decode($slurped) }
        };
        if ( !$parsed ) {

            # Try and read it in binary in case it was encoded incorrectly the first time
            $slurped = eval { File::Slurper::read_binary($item) };
            $parsed  = eval { $parser->decode($slurped) };
            if ( !$parsed ) {
                print "JSON Decode error on $item:\n$@\n";
                next;
            }
        }

        #XXX this imposes an inefficiency in itself, get() will filter uselessly again here
        my @filtered = $query->{raw} ? @$parsed : $self->filter( $query, @$parsed );

        push( @items, @filtered ) if @filtered;
        next                      if $query->{limit} == 0;                # 0 = unlimited
        last                      if scalar(@items) == $query->{limit};
    }

    return \@items;
}

sub _index ($self) {
    confess "Can't find datastore in $datastore !" unless -d $datastore;
    opendir( my $dh, $datastore ) or confess;
    my @index = grep { -f } map { "$datastore/$_" } readdir $dh;    ## no critic (ProhibitFiletest_f) -- listing names, nothing is opened
    closedir $dh;
    return sort { $b cmp $a } @index;
}

sub routes ($self) {
    return Trog::SQLite::TagIndex::routes();
}

sub aliases ($self) {
    return Trog::SQLite::TagIndex::aliases();
}

sub write ( $self, $data ) {
    foreach my $post (@$data) {
        my $file   = "$datastore/$post->{id}";
        my $update = [$post];

        mkdir $datastore;

        # One locked handle for the whole read-modify-write.  This used to be a
        # -f, then a separate read, then a separate truncating open; two workers
        # saving the same post could both read the existing revisions and then
        # each write back only their own, silently dropping the post's history.
        # '+>>' creates the file if it is not there, and never truncates.
        open( my $fh, '+>>', $file ) or confess "Could not open $file: $!";
        flock( $fh, LOCK_EX )        or confess "Could not lock $file: $!";

        seek( $fh, 0, SEEK_SET ) or confess "Could not rewind $file: $!";
        my $slurped = do { local $/; <$fh> };
        $update = [ ( @{ $parser->decode($slurped) }, $post ) ] if length( $slurped // '' );

        seek( $fh, 0, SEEK_SET ) or confess "Could not rewind $file: $!";
        truncate( $fh, 0 )       or confess "Could not truncate $file: $!";
        print {$fh} $parser->encode($update);
        close $fh;

        Trog::SQLite::TagIndex::add_post( $post, $self );
    }
}

sub count ($self) {
    my @index = $self->_index();
    return scalar(@index);
}

sub delete ( $self, @posts ) {
    foreach my $update (@posts) {
        unlink "$datastore/$update->{id}" or confess;
        Trog::SQLite::TagIndex::remove_post($update);
    }

    return 0;
}

sub tags ($self) {
    return Trog::SQLite::TagIndex::tags();
}

1;