DUMMY.pm 1.4 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364
  1. package Trog::Data::DUMMY;
  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 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. confess "Can't find datastore!" unless -f $datastore;
  19. my $slurped = File::Slurper::read_text($datastore);
  20. $posts = JSON::MaybeXS::decode_json($slurped);
  21. # Sort everything by date DESC
  22. @$posts = sort { $b->{created} <=> $a->{created} } @$posts;
  23. return $posts;
  24. }
  25. sub count ($self) {
  26. $posts //= $self->read();
  27. return scalar(@$posts);
  28. }
  29. sub write($self,$data,$overwrite=0) {
  30. my $orig = [];
  31. if ($overwrite) {
  32. $orig = $data;
  33. } else {
  34. $orig = $self->read();
  35. push(@$orig,@$data);
  36. }
  37. open(my $fh, '>', $datastore) or confess;
  38. print $fh JSON::MaybeXS::encode_json($orig);
  39. close $fh;
  40. }
  41. sub delete($self, @posts) {
  42. my $example_posts = $self->read();
  43. foreach my $update (@posts) {
  44. @$example_posts = grep { $_->{id} ne $update->{id} } @$example_posts;
  45. }
  46. $self->write($example_posts,1);
  47. return 0;
  48. }
  49. 1;