123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298 |
- package Trog::DataModule;
- use strict;
- use warnings;
- use List::Util;
- use File::Copy;
- use Mojo::File;
- no warnings 'experimental';
- use feature qw{signatures};
- =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.
- =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.
- =head1 CONSTRUCTOR
- =head2 new(Config::Simple $config)
- Try not to do expensive things here.
- =cut
- sub new ($class, $config) {
- $config = $config->vars();
- return bless($config, $class);
- }
- #It is required that subclasses implement this
- sub lang ($self) { ... }
- sub help ($self) { ... }
- sub read ($self,$query={}) { ... }
- sub write ($self) { ... }
- sub count ($self) { ... }
- =head1 METHODS
- =head2 get(%request)
- Queries the data model. Should return the following:
- 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).
- version => if id is passed, return the provided post version rather than the most recent one
- 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.
- author => filter by post author
- If it is more efficient to filter within your data storage engine, you probably should override this method.
- As implemented, this takes the data as a given and filters in post.
- =cut
- sub get ($self, %request) {
- my $posts = $self->read(\%request);
- my @filtered = $self->filter(\%request, @$posts);
- @filtered = $self->_fixup(@filtered);
- @filtered = $self->paginate(\%request,@filtered);
- return @filtered;
- }
- sub _fixup ($self, @filtered) {
- @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 @filtered;
- }
- sub filter ($self, $query, @filtered) {
- my %request = %$query; #XXX update varnames instead
- $request{acls} //= [];
- $request{tags} //=[];
- # If an ID is passed, just get that (and all it's prior versions)
- if ($request{id}) {
- @filtered = grep { $_->{id} eq $request{id} } @filtered if $request{id};
- @filtered = _dedup_versions($request{version}, @filtered);
- return @filtered;
- }
- @filtered = _dedup_versions(undef, @filtered);
- #Filter out posts which are too old
- @filtered = grep { $_->{created} < $request{older} } @filtered if $request{older};
- #XXX Heal bad data -- probably not needed
- @filtered = map { my $t = $_->{tags}; @$t = grep { defined $_ } @$t; $_ } @filtered;
- # 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 { $_->{title} =~ m/\Q$request{like}\E/i || $_->{data} =~ m/\Q$request{like}\E/i } @filtered if $request{like};
- @filtered = grep { $_->{user} eq $request{author} } @filtered if $request{author};
- return @filtered;
- }
- sub paginate ($self, $query, @filtered) {
- my %request = %$query; #XXX change varnames
- my $offset = int($request{limit} // 25);
- $offset = @filtered < $offset ? @filtered : $offset;
- @filtered = splice(@filtered, ( int($request{page}) -1) * $offset, $offset) if $request{page} && $request{limit};
- return @filtered;
- }
- sub _dedup_versions ($version=-1, @posts) {
- #ASSUMPTION made here - if we pass version this is direct ID query
- if (defined $version) {
- my $version_max = List::Util::max(map { $_->{version} } @posts);
- return map {
- $_->{version_max} //= $version_max;
- $_
- } grep { $_->{version} eq $version } @posts;
- }
- my @uniqids = List::Util::uniq(map { $_->{id} } @posts);
- my %posts_deduped;
- for my $id (@uniqids) {
- my @ofid = sort { $b->{version} cmp $a->{version} } grep { $_->{id} eq $id } @posts;
- my $version_max = List::Util::max(map { $_->{version } } @ofid);
- $posts_deduped{$id} = $ofid[0];
- $posts_deduped{$id}{version_max} = $version_max;
- }
- my @deduped = @posts_deduped{@uniqids};
- return @deduped;
- }
- #XXX this probably should be re-factored to be baked into the data from the get-go
- 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 'about' } @{$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->{content_type} //= '';
- $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->{is_profile} = 1 if grep {$_ eq 'about' } @{$post->{tags}};
- $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;
- }
- =head2 count() = INT $num
- Returns the total number of posts.
- Used to determine paginator parameters.
- =cut
- =head2 add(@posts) = BOOL $failed_or_not
- Add the provided posts to the datastore.
- If any post already exists with the same id, a new post with a version higher than it will be added.
- Passes an array of new posts to add to the data store module's write() function.
- You probably won't want to override this.
- =cut
- sub add ($self, @posts) {
- require UUID::Tiny;
- my @to_write;
- foreach my $post (@posts) {
- $post->{id} //= UUID::Tiny::create_uuid_as_string(UUID::Tiny::UUID_V1, UUID::Tiny::UUID_NS_DNS);
- $post->{created} = time();
- my @existing_posts = $self->get( id => $post->{id} );
- if (@existing_posts) {
- my $existing_post = $existing_posts[0];
- $post->{version} = $existing_post->{version};
- $post->{version}++;
- }
- $post->{version} //= 0;
- $post = _process($post);
- push @to_write, $post;
- }
- $self->write(\@to_write);
- return 0;
- }
- #XXX this level of post-processing seems gross, but may be unavoidable
- # Not actually a subprocess, kek
- sub _process ($post) {
- $post->{href} = _handle_upload($post->{file}, $post->{id}) if $post->{file};
- $post->{preview} = _handle_upload($post->{preview_file}, $post->{id}) if $post->{preview_file};
- $post->{wallpaper} = _handle_upload($post->{wallpaper_file}, $post->{id}) if $post->{wallpaper_file};
- $post->{preview} = $post->{href} if $post->{app} eq 'image';
- delete $post->{app};
- delete $post->{file};
- delete $post->{preview_file};
- delete $post->{route};
- delete $post->{domain};
- # Handle acls/tags
- $post->{tags} //= [];
- @{$post->{tags}} = grep { my $subj = $_; !grep { $_ eq $subj} qw{public private unlisted} } @{$post->{tags}};
- push(@{$post->{tags}}, delete $post->{acls}) if $post->{visibility} eq 'private';
- push(@{$post->{tags}}, delete $post->{visibility});
- #Filter adding the same acl twice
- @{$post->{tags}} = List::Util::uniq(@{$post->{tags}});
- # Handle multimedia content types
- if ($post->{href}) {
- my $mf = Mojo::File->new("www/$post->{href}");
- my $ext = '.'.$mf->extname();
- $post->{content_type} = Plack::MIME->mime_type($ext) if $ext;
- }
- if ($post->{video_href}) {
- my $mf = Mojo::File->new("www/$post->{video_href}");
- my $ext = '.'.$mf->extname();
- $post->{video_content_type} = Plack::MIME->mime_type($ext) if $ext;
- }
- if ($post->{audio_href}) {
- my $mf = Mojo::File->new("www/$post->{audio_href}");
- my $ext = '.'.$mf->extname();
- $post->{audio_content_type} = Plack::MIME->mime_type($ext) if $ext;
- }
- return $post;
- }
- sub _handle_upload ($file, $uuid) {
- my $f = $file->{tempname};
- my $newname = "$uuid.$file->{filename}";
- File::Copy::move($f, "www/assets/$newname");
- return "/assets/$newname";
- }
- =head2 delete(@posts)
- Delete the following posts.
- Will remove all versions of said post.
- You should override this, it is a stub here.
- =cut
- sub delete ($self) { die 'stub' }
- 1;
|