DUMMY.pm 1.3 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960
  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. return $posts;
  22. }
  23. sub count ($self) {
  24. $posts //= $self->read();
  25. return scalar(@$posts);
  26. }
  27. sub write($self,$data,$overwrite=0) {
  28. my $orig = [];
  29. if ($overwrite) {
  30. $orig = $data;
  31. } else {
  32. $orig = $self->read();
  33. push(@$orig,@$data);
  34. }
  35. open(my $fh, '>', $datastore) or confess;
  36. print $fh JSON::MaybeXS::encode_json($orig);
  37. close $fh;
  38. }
  39. sub delete($self, @posts) {
  40. my $example_posts = $self->read();
  41. foreach my $update (@posts) {
  42. @$example_posts = grep { $_->{id} ne $update->{id} } @$example_posts;
  43. }
  44. $self->write($example_posts,1);
  45. return 0;
  46. }
  47. 1;