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;