tCMS/lib/Trog/Data/DUMMY.pm

package Trog::Data::DUMMY;

use strict;
use warnings;

no warnings 'experimental';
use feature qw{signatures};

use Carp qw{confess};
use JSON::MaybeXS;
use File::Slurper;

=head1 WARNING

Do not use this as a production data model.  It is *not* safe to race conditions, and is only here for testing.

=head1 QUERY FORMAT

The $query_language and $query_help variables are presented to the user as to how to use the search box in the tCMS header.

=cut

our $datastore      = 'data/DUMMY.json';
our $query_language = 'Perl Regex in Quotemeta';
our $query_help     = 'https://perldoc.perl.org/functions/quotemeta.html';

=head1 POST STRUCTURE

Posts generally need to have the following:

    data: Brief description of content, or the content itself.
    content_type: What this content actually is.  Used to filter into the appropriate pages.
    href: Primary link.  This is the subject of a news post, or a link to the item itself.  Can be local or remote.
    local_href: Backup link.  Automatically created link to a static cache of the content.
    title: Title of the content.  Used as link name for the 'href' attribute.
    user: User was banned for this post
    id: Internal identifier in datastore for the post.
    tags: array ref of appropriate tags.
    created: timestamp of creation of this version of the post
    version: revision # of this post.

=cut

=head1 CONSTRUCTOR

=head2 new(Config::Simple $config)

Try not to do expensive things here.  

=cut

sub new ($class, $config) {
    $config = $config->vars();
    $config->{lang} = $query_language;
    $config->{help} = $query_help;
    return bless($config,__PACKAGE__);
}

=head1 METHODS

=head2 get(%request)

Queries the data model in the way a "real" data model module ought to.

    id   => Filter down to just the post by ID.  May be subsequently filtered by ACL, resulting in a 404 (which is good, as it does not disclose info).

    tags => ARRAYREF of tags, any one of which is required to give a result.  If none are passed, no filtering is performed.

    acls => ARRAYREF of acl tags, any one of which is required to give result. Filter applies after tags.  'admin' ACL being present skips this filter.

    page => Offset multiplier for pagination.

    limit => Offset for pagination.

    like => Search query, as might be passed in the search bar.

=cut

sub _read {
    confess "Can't find datastore!" unless -f $datastore;
    my $slurped = File::Slurper::read_text($datastore);
    return JSON::MaybeXS::decode_json($slurped);
}

sub _write($data) {
    open(my $fh, '>', $datastore) or confess;
    print $fh JSON::MaybeXS::encode_json($data);
    close $fh;
}

# These have to be sorted as requested by the client
sub get ($self, %request) {

    my $example_posts = _read();

    my @filtered = @$example_posts;

    # If an ID is passed, just get that
    @filtered = grep { $_->{id} eq $request{id} } @filtered if $request{id};

    # Next, handle the query, tags and ACLs
    @filtered = grep { my $tags = $_->{tags}; grep { my $t = $_; grep {$t eq $_ } @{$request{tags}} } @$tags } @filtered if @{$request{tags}};
    @filtered = grep { my $tags = $_->{tags}; grep { my $t = $_; grep {$t eq $_ } @{$request{acls}} } @$tags } @filtered unless grep { $_ eq 'admin' } @{$request{acls}};    
    @filtered = grep { $_->{data} =~ m/\Q$request{like}\E/i } @filtered if $request{like};

    # Finally, paginate
    my $offset = int($request{limit});
    $offset = @filtered < $offset ? @filtered : $offset;
    my $pages = int(scalar(@filtered) / ($offset || 1) );

    @filtered = splice(@filtered, ( int($request{page}) -1) * $offset, $offset) if $request{page} && $request{limit};
    
    # Next, go ahead and build the "post type"
    @filtered = _add_post_type(@filtered);
    # Next, add the type of post this is
    @filtered = _add_media_type(@filtered);
    # Finally, add visibility
    @filtered = _add_visibility(@filtered);

    return ($pages,\@filtered);
}

sub total_posts {
    my $example_posts = _read();
    return scalar(@$example_posts);
}

sub _add_post_type (@posts) {
    return map {
        my $post = $_;
        my $type = 'file';
        $type = 'blog'      if grep { $_ eq 'blog' }    @{$post->{tags}};
        $type = 'microblog' if grep { $_ eq 'news' }    @{$post->{tags}};
        $type = 'profile'   if grep { $_ eq 'profile' } @{$post->{tags}};
        $type = 'series'    if grep { $_ eq 'series'  } @{$post->{tags}};
        $post->{type} = $type;
        $post
    } @posts;
}

sub _add_media_type (@posts) {
    return map {
        my $post = $_;
        $post->{is_video} = 1 if $post->{content_type} =~ m/^video\//;
        $post->{is_audio} = 1 if $post->{content_type} =~ m/^audio\//;
        $post->{is_image} = 1 if $post->{content_type} =~ m/^image\//;
        $post
    } @posts;
}

sub _add_visibility (@posts) {
    return map {
        my $post = $_;
        my @visibilities = grep { my $tag = $_; grep { $_ eq $tag } qw{private unlisted public} } @{$post->{tags}};
        $post->{visibility} = $visibilities[0];
        $post
    } @posts;
}

sub add ($self, @posts) {
    require UUID::Tiny;
    my $example_posts = _read();
    foreach my $post (@posts) {
        $post->{id} //= UUID::Tiny::create_uuid_as_string(UUID::Tiny::UUID_V1, UUID::Tiny::UUID_NS_DNS);
        my (undef, $existing_posts) = $self->get( id => $post->{id} );
        if (@$existing_posts) {
            my $existing_post = $existing_posts->[0];
            $post->{version}  = $existing_post->{version};
            $post->{version}++;
        }
        push @$example_posts, $post;
    }
    _write($example_posts);
    return 0;
}

sub delete($self, @posts) {
    my $example_posts = _read();
    foreach my $update (@posts) {
        @$example_posts = grep { $_->{id} ne $update->{id} } @$example_posts;
    }
    _write($example_posts);
    return 0;
}

1;