DUMMY.pm 1.5 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273
  1. package Trog::Data::DUMMY;
  2. use v5.36;
  3. use re '/aa';
  4. use Carp qw{confess};
  5. use JSON::MaybeXS;
  6. use File::Slurper;
  7. use List::Util qw{uniq};
  8. use Path::Tiny();
  9. use parent qw{Trog::DataModule};
  10. =head1 WARNING
  11. Do not use this as a production data model. It is *not* safe to race conditions, and is only here for testing.
  12. =cut
  13. our $datastore = 'data/DUMMY.json';
  14. sub lang { 'Perl Regex in Quotemeta' }
  15. sub help { 'https://perldoc.perl.org/functions/quotemeta.html' }
  16. our $posts;
  17. sub read ( $self, $query = {} ) {
  18. if ( !-f $datastore ) {
  19. open( my $fh, '>', $datastore );
  20. print $fh '[]';
  21. close $fh;
  22. }
  23. my $slurped = File::Slurper::read_text($datastore);
  24. $posts = JSON::MaybeXS::decode_json($slurped);
  25. # Sort everything by date DESC
  26. @$posts = sort { $b->{created} <=> $a->{created} } @$posts;
  27. return $posts;
  28. }
  29. sub count ($self) {
  30. $posts //= $self->read();
  31. return scalar(@$posts);
  32. }
  33. sub write ( $self, $data, $overwrite = 0 ) {
  34. my $orig = [];
  35. if ($overwrite) {
  36. $orig = $data;
  37. }
  38. else {
  39. $orig = $self->read();
  40. push( @$orig, @$data );
  41. }
  42. open( my $fh, '>', $datastore ) or confess;
  43. print $fh JSON::MaybeXS::encode_json($orig);
  44. close $fh;
  45. }
  46. sub delete ( $self, @posts ) {
  47. my $example_posts = $self->read();
  48. foreach my $update (@posts) {
  49. @$example_posts = grep { $_->{id} ne $update->{id} } @$example_posts;
  50. }
  51. $self->write( $example_posts, 1 );
  52. return 0;
  53. }
  54. sub tags ($self) {
  55. return ( uniq map { @{ $_->{tags} } } @$posts );
  56. }
  57. 1;