FlatFile.pm 3.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130
  1. package Trog::Data::FlatFile;
  2. use strict;
  3. use warnings;
  4. no warnings 'experimental';
  5. use feature qw{signatures};
  6. use Carp qw{confess};
  7. use JSON::MaybeXS;
  8. use File::Slurper;
  9. use File::Copy;
  10. use Mojo::File;
  11. use lib 'lib';
  12. use Trog::SQLite::TagIndex;
  13. use parent qw{Trog::DataModule};
  14. our $datastore = 'data/files';
  15. sub lang { 'Perl Regex in Quotemeta' }
  16. sub help { 'https://perldoc.perl.org/functions/quotemeta.html' }
  17. =head1 Trog::Data::FlatFile
  18. This data model has multiple drawbacks, but is "good enough" for most low-content and few editor applications.
  19. You can only post once per second due to it storing each post as a file named after the timestamp.
  20. =cut
  21. our $parser = JSON::MaybeXS->new( utf8 => 1);
  22. sub read ($self, $query={}) {
  23. $query->{limit} //= 25;
  24. #Optimize direct ID
  25. my @index;
  26. if ($query->{id}) {
  27. @index = ("$datastore/$query->{id}");
  28. } else {
  29. if (-f 'data/posts.db') {
  30. @index = map { "$datastore/$_" } Trog::SQLite::TagIndex::posts_for_tags(@{$query->{tags}})
  31. }
  32. @index = $self->_index() unless @index;
  33. }
  34. my @items;
  35. foreach my $item (@index) {
  36. next unless -f $item;
  37. my $slurped = eval { File::Slurper::read_text($item) };
  38. if (!$slurped) {
  39. print "Failed to Read $item:\n$@\n";
  40. next;
  41. }
  42. my $parsed = eval { $parser->decode($slurped) };
  43. if (!$parsed) {
  44. # Try and read it in binary in case it was encoded incorrectly the first time
  45. $slurped = eval { File::Slurper::read_binary($item) };
  46. $parsed = eval { $parser->decode($slurped) };
  47. if (!$parsed) {
  48. print "JSON Decode error on $item:\n$@\n";
  49. next;
  50. }
  51. }
  52. #XXX this imposes an inefficiency in itself, get() will filter uselessly again here
  53. my @filtered = $query->{raw} ? @$parsed : $self->filter($query,@$parsed);
  54. push(@items,@filtered) if @filtered;
  55. next if $query->{limit} == 0; # 0 = unlimited
  56. last if scalar(@items) == $query->{limit};
  57. }
  58. return \@items;
  59. }
  60. sub _index ($self) {
  61. confess "Can't find datastore in $datastore !" unless -d $datastore;
  62. opendir(my $dh, $datastore) or confess;
  63. my @index = grep { -f } map { "$datastore/$_" } readdir $dh;
  64. closedir $dh;
  65. return sort { $b cmp $a } @index;
  66. }
  67. sub routes ($self) {
  68. return Trog::SQLite::TagIndex::routes();
  69. }
  70. sub aliases ($self) {
  71. return Trog::SQLite::TagIndex::aliases();
  72. }
  73. sub write($self,$data) {
  74. foreach my $post (@$data) {
  75. my $file = "$datastore/$post->{id}";
  76. my $update = [$post];
  77. if (-f $file) {
  78. my $slurped = File::Slurper::read_binary($file);
  79. my $parsed = $parser->decode($slurped);
  80. $update = [(@$parsed, $post)];
  81. }
  82. mkdir $datastore;
  83. open(my $fh, '>', $file) or confess "Could not open $file";
  84. print $fh $parser->encode($update);
  85. close $fh;
  86. Trog::SQLite::TagIndex::add_post($post,$self);
  87. }
  88. }
  89. sub count ($self) {
  90. my @index = $self->_index();
  91. return scalar(@index);
  92. }
  93. sub delete($self, @posts) {
  94. foreach my $update (@posts) {
  95. unlink "$datastore/$update->{id}" or confess;
  96. Trog::SQLite::TagIndex::remove_post($update);
  97. }
  98. return 0;
  99. }
  100. sub tags($self) {
  101. return Trog::SQLite::TagIndex::tags();
  102. }
  103. 1;