DataModule.pm 26 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775
  1. package Trog::DataModule;
  2. use strict;
  3. use warnings;
  4. use FindBin::libs;
  5. use List::Util;
  6. use File::Copy;
  7. use Path::Tiny();
  8. use Ref::Util();
  9. use File::Basename qw{basename};
  10. use File::Slurper();
  11. use JSON::MaybeXS();
  12. use JSON::Validator::Schema::Troglodyne();
  13. use Trog::Themes();
  14. use Trog::Log qw{:all};
  15. use Trog::Utils;
  16. use Trog::Auth();
  17. no warnings 'experimental';
  18. use feature qw{signatures state};
  19. =head1 QUERY FORMAT
  20. The $query_language and $query_help variables are presented to the user as to how to use the search box in the tCMS header.
  21. =head1 POST STRUCTURE
  22. Posts generally need to have the following:
  23. data: Brief description of content, or the content itself.
  24. content_type: What this content actually is. Used to filter into the appropriate pages.
  25. href: Primary link. This is the subject of a news post, or a link to the item itself. Can be local or remote.
  26. local_href: Backup link. Automatically created link to a static cache of the content.
  27. title: Title of the content. Used as link name for the 'href' attribute.
  28. user: User was banned for this post
  29. id: Internal identifier in datastore for the post.
  30. tags: array ref of appropriate tags.
  31. created: timestamp of creation of this version of the post
  32. version: revision # of this post.
  33. =head1 CONSTRUCTOR
  34. =head2 new(Config::Simple $config)
  35. Try not to do expensive things here.
  36. =cut
  37. sub new ( $class, $config ) {
  38. $config = $config->vars();
  39. return bless( $config, $class );
  40. }
  41. =head1 ABSTRACT METHODS
  42. Subclasses must implement all of these; the stubs here do nothing but die.
  43. count() belongs to this set as well, and is documented with the rest of the
  44. querying interface below.
  45. =head2 lang() = STRING $language
  46. The name of the query language this data model understands, shown to the user
  47. beside the search bar.
  48. =head2 help() = STRING $help
  49. Documentation for that query language, shown to the user alongside it.
  50. =head2 read($query) = ARRAYREF $posts
  51. Every post the data model holds, as an arrayref of hashrefs. Filtering is
  52. get()'s job unless your storage engine can do it more cheaply itself, in which
  53. case honour $query here and override get() too.
  54. =head2 write($posts)
  55. Commit an arrayref of posts to storage. Called by add() once the posts have
  56. been filtered and validated; don't validate again here.
  57. =head2 tags() = ARRAYREF $tags
  58. Every tag known to the datastore, for building tag pickers.
  59. =cut
  60. #It is required that subclasses implement this
  61. sub lang ($self) { ... }
  62. sub help ($self) { ... }
  63. sub read ( $self, $query = {} ) { ... }
  64. sub write ($self) { ... }
  65. sub count ($self) { ... }
  66. sub tags ($self) { ... }
  67. =head1 METHODS
  68. =head2 get(%request)
  69. Queries the data model. Should return the following:
  70. 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).
  71. version => if id is passed, return the provided post version rather than the most recent one
  72. tags => ARRAYREF of tags, any one of which is required to give a result. If none are passed, no filtering is performed.
  73. 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.
  74. page => Offset multiplier for pagination.
  75. limit => Offset for pagination.
  76. like => Search query, as might be passed in the search bar.
  77. author => filter by post author
  78. If it is more efficient to filter within your data storage engine, you probably should override this method.
  79. As implemented, this takes the data as a given and filters in post.
  80. =cut
  81. sub get ( $self, %request ) {
  82. my $posts = $self->read( \%request );
  83. return @$posts if $request{raw};
  84. my @filtered = $self->filter( \%request, @$posts );
  85. @filtered = $self->_fixup(@filtered);
  86. @filtered = $self->paginate( \%request, @filtered );
  87. return @filtered;
  88. }
  89. sub _fixup ( $self, @filtered ) {
  90. my %user2display;
  91. # urlencode spaces in filenames
  92. @filtered = map {
  93. my $subj = $_;
  94. foreach my $param (qw{href preview video_href audio_href local_href wallpaper}) {
  95. next unless exists $subj->{$param};
  96. #XXX I don't remember what this fixes, but it also breaks things. URI::Escape usage instead is indicated.
  97. $subj->{$param} =~ s/ /%20/g;
  98. }
  99. $user2display{ $subj->{user} } //= Trog::Auth::username2display( $subj->{user} );
  100. $subj->{display_name} = $user2display{ $subj->{user} };
  101. #XXX Add dynamic routing data for posts which don't have them (/posts/$id) and (/users/$user)
  102. my $is_user_page = List::Util::any { ($_ // '') eq 'about' } @{ $subj->{tags} };
  103. if ( !exists $subj->{local_href} ) {
  104. $subj->{local_href} = "/posts/$subj->{id}";
  105. #XXX this needs to be correctly populated in the form?
  106. if ($is_user_page) {
  107. my $display_name = $user2display{ $subj->{user} };
  108. die "No display name for user!" unless $display_name;
  109. $subj->{local_href} = "/users/$display_name";
  110. }
  111. }
  112. if ( !exists $subj->{callback} ) {
  113. $subj->{callback} = "Trog::Routes::HTML::posts";
  114. $subj->{callback} = "Trog::Routes::HTML::users" if $is_user_page;
  115. }
  116. $subj->{method} = 'GET' unless exists( $subj->{method} );
  117. $subj->{user_class} = Trog::Auth::username2classname( $subj->{user} );
  118. $subj
  119. } @filtered;
  120. return @filtered;
  121. }
  122. sub _filter_param ( $query, $param, @filtered ) {
  123. @filtered = grep { ( $_->{$param} || '' ) eq $query->{$param} } @filtered;
  124. @filtered = _dedup_versions( $query->{version}, @filtered );
  125. return @filtered;
  126. }
  127. =head2 filter($query, @posts) = @filtered
  128. Apply a get() request's filters to a list of posts: tags, exclude_tags, acls,
  129. visibility, id, title, form, search terms and author.
  130. The ACL check is the load bearing one -- a post is only visible if the caller
  131. holds one of its acls, or the post is public or unlisted. Callers holding the
  132. 'admin' acl skip that filter entirely.
  133. =cut
  134. sub filter ( $self, $query, @filtered ) {
  135. $query->{acls} //= [];
  136. $query->{tags} //= [];
  137. $query->{exclude_tags} //= [];
  138. # If an ID or title or acl is passed, just get that (and all it's prior versions)
  139. foreach my $key (qw{id title aclname}) {
  140. next unless $query->{$key};
  141. return _filter_param( $query, $key, @filtered );
  142. }
  143. @filtered = _dedup_versions( undef, @filtered );
  144. #Filter out posts which are too old
  145. #Coerce older into numeric
  146. if ( $query->{older} ) {
  147. $query->{older} =~ s/[^0-9]//g;
  148. @filtered = grep { $_->{created} < $query->{older} } @filtered;
  149. }
  150. if ( $query->{newer} ) {
  151. $query->{newer} =~ s/[^0-9]//g;
  152. @filtered = grep { $_->{created} > $query->{newer} } @filtered;
  153. }
  154. # Filter posts not matching the passed tag(s), if any
  155. @filtered = grep {
  156. my $tags = $_->{tags};
  157. grep {
  158. my $t = $_;
  159. grep { ($t // '') eq $_ } @{ $query->{tags} }
  160. } @$tags
  161. } @filtered if @{ $query->{tags} };
  162. # Filter posts *matching* the passed exclude_tag(s), if any
  163. @filtered = grep {
  164. my $tags = $_->{tags};
  165. !grep {
  166. my $t = $_;
  167. grep { $t eq $_ } @{ $query->{exclude_tags} }
  168. } @$tags
  169. } @filtered if @{ $query->{exclude_tags} };
  170. # Filter posts without the proper ACLs
  171. @filtered = grep {
  172. my $tags = $_->{tags};
  173. grep {
  174. my $t = $_;
  175. grep { $t eq $_ } @{ $query->{acls} }
  176. } @$tags
  177. } @filtered unless grep { $_ eq 'admin' } @{ $query->{acls} };
  178. @filtered = grep { ($_->{form} || '') eq $query->{form} } @filtered if $query->{form};
  179. @filtered = grep { $_->{title} =~ m/\Q$query->{like}\E/i || $_->{data} =~ m/\Q$query->{like}\E/i } @filtered if $query->{like};
  180. @filtered = grep { $_->{user} eq $query->{author} } @filtered if $query->{author};
  181. return @filtered;
  182. }
  183. =head2 paginate($query, @posts) = @page
  184. The slice of @posts named by the request's page and limit. Both have to be
  185. present to page at all; limit defaults to 25 when computing the offset.
  186. =cut
  187. sub paginate ( $self, $query, @filtered ) {
  188. my $offset = int( $query->{limit} // 25 );
  189. $offset = @filtered < $offset ? @filtered : $offset;
  190. @filtered = splice( @filtered, ( int( $query->{page} ) - 1 ) * $offset, $offset ) if $query->{page} && $query->{limit};
  191. return @filtered;
  192. }
  193. sub _dedup_versions ( $version = -1, @posts ) {
  194. #ASSUMPTION made here - if we pass version this is direct ID query
  195. if ( defined $version ) {
  196. my $version_max = List::Util::max( map { $_->{version} } @posts );
  197. return map {
  198. $_->{version_max} //= $version_max;
  199. $_
  200. } grep { $_->{version} eq $version } @posts;
  201. }
  202. my @uniqids = List::Util::uniq( map { $_->{id} } @posts );
  203. my %posts_deduped;
  204. for my $id (@uniqids) {
  205. my @ofid = sort { $b->{version} <=> $a->{version} } grep { $_->{id} eq $id } @posts;
  206. my $version_max = List::Util::max( map { $_->{version} } @ofid );
  207. $posts_deduped{$id} = $ofid[0];
  208. $posts_deduped{$id}{version_max} = $version_max;
  209. # Show orig creation date, and original author.
  210. # XXX this doesn't show the mtime correctly for whatever reason, so I'm omitting it from the interface
  211. $posts_deduped{$id}{modified} = $ofid[0]{created};
  212. $posts_deduped{$id}{created} = $ofid[-1]{created};
  213. $posts_deduped{$id}{author} = $ofid[-1]{author};
  214. }
  215. my @deduped = @posts_deduped{@uniqids};
  216. return @deduped;
  217. }
  218. =head2 count() = INT $num
  219. Returns the total number of posts.
  220. Used to determine paginator parameters.
  221. =cut
  222. =head2 add(@posts) = BOOL $failed_or_not
  223. Add the provided posts to the datastore.
  224. If any post already exists with the same id, a new post with a version higher than it will be added.
  225. Passes an array of new posts to add to the data store module's write() function.
  226. These will have their parameters filtered to those described by the post type's
  227. schema (see schema_for()), and then validated against it. If the post doesn't
  228. hold up, this dies with an ARRAYREF of validation error strings -- a ref rather
  229. than a string so that Carp::Always doesn't staple a stack trace onto something
  230. we intend to show the user.
  231. You probably won't want to override this.
  232. =cut
  233. # The shape of a post, as an OpenAPIv3 object schema.
  234. #
  235. # This covers the fields every post has regardless of which form produced it.
  236. # Anything a *particular* post type ingests lives in that type's JSON sidecar
  237. # next to its template in the forms directory -- see _schema_for().
  238. our %post_schema = (
  239. type => 'object',
  240. properties => {
  241. ## Parameters which must be in every single post
  242. title => { type => 'string' },
  243. callback => { type => 'callback' },
  244. tags => { type => 'array', items => { type => 'string' } },
  245. version => { type => 'integer', minimum => 0 },
  246. visibility => { type => 'string', enum => [qw{public unlisted private}] },
  247. aliases => { type => 'array', items => { type => 'string' } },
  248. # title links here
  249. href => { type => 'string' },
  250. # Link to post locally
  251. local_href => { type => 'string' },
  252. # Post body. Multi-page types (presentations, invoices) send an array.
  253. data => {
  254. oneOf => [
  255. { type => 'string' },
  256. { type => 'array', items => { type => 'string' } },
  257. ],
  258. },
  259. # How do I edit this post?
  260. form => { type => 'string' },
  261. # Post is restricted to visibility to these ACLs if not public/unlisted
  262. acls => { type => 'array', items => { type => 'string' } },
  263. id => { type => 'string' },
  264. # Author of the post
  265. user => { type => 'string' },
  266. created => { type => 'integer' },
  267. # Posts are always GET, but it's stored, so it has to be describable.
  268. method => { type => 'string' },
  269. },
  270. );
  271. # Uploads arrive as an HTTP::Body hashref on the way in, and as the href string
  272. # they were turned into on the way back out of the datastore. Sidecars say
  273. # 'upload' and mean this.
  274. our %upload_schema = (
  275. oneOf => [
  276. { type => 'string' },
  277. { type => 'object' },
  278. ],
  279. );
  280. =head2 schema_for($form)
  281. Return the OpenAPIv3 schema describing what the named post type ingests: the
  282. base post schema above, with the type's JSON sidecar merged over the top.
  283. Sidecars live beside their templates (blog.tx has blog.json) and are written
  284. either by hand or by the Post Type Wizard. A post with no form, or a form with
  285. no sidecar, just gets the base schema.
  286. Cached, but keyed on the mtimes of the component dirs rather than memoized
  287. outright: adding or editing a sidecar bumps one of them, so every forked worker
  288. picks the change up on its very next add() with no restart needed.
  289. =cut
  290. # Stat the forms dirs, not their parents -- writing blog.json bumps the mtime
  291. # of forms/, and nothing above it. Both candidates, since either one gaining a
  292. # sidecar changes the answer.
  293. sub _sidecar_generation {
  294. return join( ':', map { ( stat("$_/forms") )[9] // 0 } Trog::Themes::template_dirs( 'text/html', 1 ) );
  295. }
  296. # A signature default only covers an absent arg, and plenty of posts have an
  297. # explicitly undef form.
  298. sub _type_of ($form) {
  299. $form = '' if !defined $form || ref $form;
  300. my ($type) = $form =~ m/^([A-Za-z0-9_-]+)\.tx$/;
  301. return $type // '';
  302. }
  303. =head2 type_meta_for($form)
  304. The parts of a post type's sidecar which aren't schema: x-tcms-relations,
  305. x-tcms-post-type and friends.
  306. schema_for() deliberately keeps only properties and required, since everything
  307. else would be noise to the validator -- but the relation tables and the post
  308. type's own metadata live out there and something has to read them.
  309. =cut
  310. sub type_meta_for ( $form = '' ) {
  311. state %cache;
  312. my $generation = _sidecar_generation();
  313. %cache = () unless exists $cache{$generation};
  314. my $type = _type_of($form);
  315. return $cache{$generation}{$type} if exists $cache{$generation}{$type};
  316. my $path = $type ? Trog::Themes::themed_file_in_dir( 'forms', "$type.json", 'text/html', 1 ) : undef;
  317. my $sidecar = $path ? _read_sidecar($path) : undef;
  318. my %meta;
  319. if ($sidecar) {
  320. %meta = map { $_ => $sidecar->{$_} } grep { $_ ne 'properties' && $_ ne 'required' && $_ ne 'type' } keys(%$sidecar);
  321. }
  322. $cache{$generation}{$type} = \%meta;
  323. return $cache{$generation}{$type};
  324. }
  325. =head2 relations_for($form)
  326. The x-tcms-relations table for a post type, as a hashref keyed on the template
  327. variable the resolved posts land in. Empty when the type declares none.
  328. Each entry is { form => 'other.tx', from => 'field_name' } -- 'from' naming the
  329. field holding a UUID to resolve, or absent to mean every post of that type.
  330. =cut
  331. sub relations_for ( $form = '' ) {
  332. my $relations = type_meta_for($form)->{'x-tcms-relations'};
  333. return {} unless Ref::Util::is_hashref($relations);
  334. return $relations;
  335. }
  336. sub schema_for ( $form = '' ) {
  337. state %cache;
  338. my $generation = _sidecar_generation();
  339. # Only ever keep the current generation around.
  340. %cache = () unless exists $cache{$generation};
  341. my $type = _type_of($form);
  342. return $cache{$generation}{$type} if exists $cache{$generation}{$type};
  343. my %merged = ( %post_schema, properties => { %{ $post_schema{properties} } } );
  344. # Themed like the templates themselves: a theme that overrides blog.tx can
  345. # ship its own blog.json alongside it, and one that doesn't still gets the
  346. # stock schema rather than nothing at all.
  347. my $path = $type ? Trog::Themes::themed_file_in_dir( 'forms', "$type.json", 'text/html', 1 ) : undef;
  348. my $sidecar = $path ? _read_sidecar($path) : undef;
  349. if ($sidecar) {
  350. # The base schema is merged *last*, so a sidecar can add fields but can
  351. # never redefine one of ours. That matters: a sidecar retyping
  352. # 'callback' as a plain string would defeat the check that the sub it
  353. # names actually exists, which is a privilege problem rather than a
  354. # cosmetic one.
  355. %{ $merged{properties} } = ( %{ $sidecar->{properties} // {} }, %{ $merged{properties} } );
  356. # A sidecar may insist on its own fields, but it can't relax anything
  357. # the base schema already demands.
  358. my @required = List::Util::uniq( @{ $post_schema{required} // [] }, @{ $sidecar->{required} // [] } );
  359. # An empty required list isn't legal OpenAPI, so don't emit one.
  360. $merged{required} = \@required if @required;
  361. }
  362. $cache{$generation}{$type} = \%merged;
  363. return $cache{$generation}{$type};
  364. }
  365. sub _read_sidecar ($path) {
  366. return undef unless -f $path;
  367. local $@;
  368. my $spec = eval { JSON::MaybeXS::decode_json( File::Slurper::read_text($path) ) };
  369. if ( !$spec ) {
  370. WARN("Could not parse post type sidecar '$path': $@");
  371. return undef;
  372. }
  373. return undef unless Ref::Util::is_hashref($spec);
  374. _expand_pseudo_types($spec);
  375. return $spec;
  376. }
  377. # A relation is stored as the referenced post's UUID, and resolved into the
  378. # post itself at render time -- see the x-tcms-relations table a sidecar
  379. # declares alongside it, and Trog::Routes::HTML::_enrich_post. The pseudo-type
  380. # exists so a sidecar can say what a field *means* rather than just that it
  381. # happens to be a string.
  382. our %relation_schema = ( type => 'string' );
  383. # Sugar: a sidecar says {"type":"upload"} rather than spelling out the
  384. # string-or-hashref dance every upload field would otherwise need. Uploads are
  385. # a hashref on the way in from the browser and the href string they became on
  386. # the way back out of the datastore.
  387. sub _expand_pseudo_types ($node) {
  388. return unless Ref::Util::is_hashref($node);
  389. my %pseudo = (
  390. upload => \%upload_schema,
  391. relation => \%relation_schema,
  392. );
  393. my $type = $node->{type} // '';
  394. if ( $pseudo{$type} ) {
  395. delete $node->{type};
  396. %$node = ( %$node, %{ $pseudo{$type} } );
  397. return;
  398. }
  399. _expand_pseudo_types($_) foreach values( %{ $node->{properties} // {} } );
  400. _expand_pseudo_types( $node->{items} ) if $node->{items};
  401. foreach my $key (qw{oneOf anyOf allOf}) {
  402. next unless Ref::Util::is_arrayref( $node->{$key} );
  403. _expand_pseudo_types($_) foreach @{ $node->{$key} };
  404. }
  405. return;
  406. }
  407. =head2 validate($post)
  408. Filter a post down to the fields its type actually describes, then run what's
  409. left through the schema.
  410. Returns the list of validation errors, which is empty when the post is good.
  411. Note that filtering happens first and silently: the query hash handed to us by
  412. the router is full of things which aren't post fields at all, and never was
  413. meant to round-trip.
  414. =cut
  415. sub validate ($post) {
  416. state $validator;
  417. $validator //= JSON::Validator::Schema::Troglodyne->new();
  418. my $schema = schema_for( $post->{form} );
  419. foreach my $key ( keys(%$post) ) {
  420. # Drop everything the schema doesn't describe.
  421. my $property = $schema->{properties}{$key};
  422. if ( !$property ) {
  423. delete $post->{$key};
  424. next;
  425. }
  426. # An untouched form input submits the empty string, which is HTML for
  427. # "I wasn't filled in" rather than a number, a boolean or a file. We
  428. # leave it alone for actual string fields, which is what got stored
  429. # before any of this was typed.
  430. delete $post->{$key}
  431. if defined $post->{$key}
  432. && !ref $post->{$key}
  433. && $post->{$key} eq ''
  434. && ( $property->{type} // '' ) ne 'string';
  435. }
  436. # OpenAPIv3 coerces as it goes, so "4" lands in the datastore as 4 and
  437. # checkbox values land as real booleans.
  438. return $validator->validate( $post, $schema );
  439. }
  440. sub add ( $self, @posts ) {
  441. my @to_write;
  442. foreach my $post (@posts) {
  443. # Filter to what this post type actually describes, then validate it.
  444. my @errors = validate($post);
  445. # An arrayref rather than a string on purpose. These errors get shown
  446. # to whoever submitted the post, and Carp::Always decorates a string
  447. # die with a stack trace they have no use for.
  448. die [ map { "$_" } @errors ] if @errors;
  449. $post->{id} //= Trog::Utils::uuid();
  450. $post->{aliases} //= [];
  451. $post->{aliases} = [ $post->{aliases} ] unless ref $post->{aliases} eq 'ARRAY';
  452. if ( $post->{aclname} ) {
  453. # Then this is a series
  454. $post->{local_href} //= "/$post->{aclname}";
  455. push( @{ $post->{aliases} }, "/posts/$post->{id}", "/series/$post->{id}" );
  456. }
  457. # Every post needs one: _process pushes it into the tags, and an
  458. # undef there is a tag no query will ever match, which makes the post
  459. # invisible to everyone but an admin. A post type built without a
  460. # visibility selector would otherwise produce exactly that. Private
  461. # rather than public, because guessing wrong in the other direction
  462. # publishes something nobody asked to publish.
  463. $post->{visibility} //= 'private';
  464. $post->{callback} //= 'Trog::Routes::HTML::posts';
  465. # If this is a user creation post, add in the /user/ route
  466. if ( $post->{callback} eq 'Trog::Routes::HTML::users' ) {
  467. $post->{local_href} //= "/users/$post->{display_name}";
  468. $post->{title} //= $post->{display_name};
  469. }
  470. $post->{local_href} //= "/posts/$post->{id}";
  471. $post->{method} //= 'GET';
  472. $post->{created} = time();
  473. my @existing_posts = $self->get( id => $post->{id} );
  474. if (@existing_posts) {
  475. my $existing_post = $existing_posts[0];
  476. $post->{version} = $existing_post->{version};
  477. $post->{version}++;
  478. }
  479. $post->{version} //= 0;
  480. #XXX if local_href has /secure paths in it, fix this. We don't want to save that.
  481. if (index($post->{local_href}, '/secure/') == 0) {
  482. $post->{local_href} =~ s|/secure||gmx;
  483. }
  484. $post = _process($post);
  485. push @to_write, $post;
  486. }
  487. $self->write( \@to_write );
  488. return 0;
  489. }
  490. #XXX this level of post-processing seems gross, but may be unavoidable
  491. # Not actually a subprocess, kek
  492. sub _process ($post) {
  493. # If the post is private, make sure it's associated assets are too.
  494. my $is_private_post = $post->{visibility} eq 'private';
  495. $post->{href} = _handle_upload( $post->{file}, $post->{id}, $is_private_post ) if $post->{file};
  496. $post->{preview} = _handle_upload( $post->{preview_file}, $post->{id}, $is_private_post ) if $post->{preview_file};
  497. $post->{wallpaper} = _handle_upload( $post->{wallpaper_file}, $post->{id}, $is_private_post ) if $post->{wallpaper_file};
  498. @{ $post->{attachments} } = map { _handle_upload( $_, $post->{id}, $is_private_post ) } @{ $post->{attachments} } if $post->{attachments};
  499. $post->{preview} = $post->{href} if $post->{app} && $post->{app} eq 'image';
  500. delete $post->{app};
  501. delete $post->{file};
  502. delete $post->{preview_file};
  503. delete $post->{wallpaper_file};
  504. delete $post->{scheme};
  505. delete $post->{route};
  506. delete $post->{domain};
  507. # Handle acls/tags
  508. $post->{tags} //= [];
  509. $post->{acls} //= [];
  510. @{ $post->{tags} } = grep {
  511. my $subj = $_;
  512. !grep { $_ eq $subj } qw{public private unlisted}
  513. } @{ $post->{tags} };
  514. push( @{ $post->{tags} }, @{ $post->{acls} } ) if $is_private_post;
  515. delete $post->{acls};
  516. push( @{ $post->{tags} }, $post->{visibility} );
  517. # Add the 'series' tag if we are in a series, restrict to relevant acl
  518. if ( $post->{series} ) {
  519. push( @{ $post->{tags} }, 'series' );
  520. push( @{ $post->{tags} }, $post->{series} );
  521. }
  522. #Filter adding the same acl twice
  523. @{ $post->{tags} } = List::Util::uniq( @{ $post->{tags} } );
  524. @{ $post->{aliases} } = List::Util::uniq( @{ $post->{aliases} } );
  525. # Handle multimedia content types
  526. $post->{content_type} = Trog::Utils::mime_type("www/$post->{href}") if $post->{href};
  527. $post->{video_content_type} = Trog::Utils::mime_type("www/$post->{video_href}") if $post->{video_href};
  528. $post->{audio_content_type} = Trog::Utils::mime_type("www/$post->{audio_href}") if $post->{audio_href};
  529. $post->{content_type} ||= 'text/html';
  530. $post->{is_video} = 1 if $post->{content_type} =~ m/^video\//;
  531. $post->{is_audio} = 1 if $post->{content_type} =~ m/^audio\//;
  532. $post->{is_image} = 1 if $post->{content_type} =~ m/^image\//;
  533. $post->{is_profile} = 1 if grep { $_ eq 'about' } @{ $post->{tags} };
  534. return $post;
  535. }
  536. # Browsers try and save time in the event that the same file is sent twice, so handle that.
  537. my %seen_files;
  538. sub _handle_upload ( $file, $uuid, $private=0 ) {
  539. my $fname;
  540. if ( ref $file ne 'HASH' ) {
  541. use Data::Dumper;
  542. $file =~ s/\\/\//g;
  543. $fname = basename($file);
  544. FATAL("Did not expect bogus file before its real counterpart!") unless $seen_files{$fname};
  545. return $seen_files{$fname};
  546. }
  547. my $f = $file->{tempname};
  548. $fname = basename( $file->{filename} );
  549. my $newname = "$uuid.$file->{filename}";
  550. $newname = "private/$newname" if $private;
  551. File::Copy::move( $f, "www/assets/$newname" );
  552. # Regrettably, we have no control over the perms of the temp file that starman creates for uploads.
  553. chmod(0755, "www/assets/$newname");
  554. $seen_files{$fname} = "/assets/$newname";
  555. return $seen_files{$fname};
  556. }
  557. =head2 delete(@posts)
  558. Delete the following posts.
  559. Will remove all versions of said post.
  560. You should override this, it is a stub here.
  561. =cut
  562. sub delete ($self) { die 'stub' }
  563. =head2 routes() = HASH
  564. Returns the routes to each post.
  565. You should override this for performance reasons, as it's just a wrapper around get() by defualt.
  566. =cut
  567. sub routes ($self) {
  568. my %routes = map { $_->{local_href} => { method => $_->{method}, callback => \&{ $_->{callback} } } } ( $self->get( limit => 0, acls => ['admin'] ) );
  569. return %routes;
  570. }
  571. =head2 aliases() = HASH
  572. Returns the aliases for each post, indexed by aliases.
  573. You should override this for performance reasons, as it's just a wrapper around get() by defualt.
  574. =cut
  575. sub aliases ($self) {
  576. my @posts = $self->get( limit => 0, acls => ['admin'] );
  577. my %aliases;
  578. foreach my $post (@posts) {
  579. @aliases{ @{ $post->{aliases} } } = $post->{local_href};
  580. }
  581. return %aliases;
  582. }
  583. 1;