Trog-Routes-HTML-series-lifecycle.t 51 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197
  1. #!/usr/bin/env perl
  2. # Stands up a genuinely fresh tCMS in a temp dir, then walks the loop a user
  3. # actually performs: register an admin, invent a post type in the wizard, and
  4. # for each content post type build a topbar series, confirm it lands in the
  5. # nav, add a child post and confirm the child renders on the series page.
  6. #
  7. # Verification goes through Trog::Routes::HTML::index() -- directly, or via
  8. # series() which delegates to it -- and matches on the returned HTML.
  9. use strict;
  10. use warnings;
  11. # FindBin MUST come first. $FindBin::Bin is derived from $0, which prove hands
  12. # us relatively, and it is computed once. chdir before this loads and every
  13. # module's `use FindBin::libs` resolves against the sandbox instead of the repo.
  14. use FindBin;
  15. use lib "$FindBin::Bin/../lib";
  16. use Test::More;
  17. use Cwd ();
  18. use Encode ();
  19. use File::Copy ();
  20. use File::Find ();
  21. use File::Path ();
  22. use File::Temp ();
  23. use Time::HiRes ();
  24. use URI::Escape ();
  25. use JSON::MaybeXS ();
  26. use File::Slurper ();
  27. our ( $REPO, $ROOT, $OLDCWD );
  28. our %REPO_BEFORE;
  29. # Which data model this run exercises. Every assertion in this file is about
  30. # what the app does, not how it stores anything, so all of them have to hold for
  31. # any of them.
  32. our $MODEL;
  33. # In BEGIN because the sandbox is built in one, before file scope runs.
  34. BEGIN { $MODEL = $ENV{TCMS_TEST_DATA_MODEL} || 'FlatFile' }
  35. # name => (size, mtime) for every file under the repo dirs this test could
  36. # plausibly disturb. Cheap enough, and it is the only real proof of isolation.
  37. sub _snapshot {
  38. my ($dir) = @_;
  39. my %seen;
  40. File::Find::find(
  41. {
  42. no_chdir => 1,
  43. wanted => sub {
  44. return unless -f $File::Find::name;
  45. my @st = stat(_);
  46. $seen{$File::Find::name} = "$st[7]:$st[9]";
  47. },
  48. },
  49. $dir
  50. );
  51. return %seen;
  52. }
  53. sub _copy_tree {
  54. my ( $from, $to ) = @_;
  55. File::Path::make_path($to);
  56. File::Find::find(
  57. {
  58. no_chdir => 1,
  59. wanted => sub {
  60. my $rel = substr( $File::Find::name, length($from) );
  61. return unless length $rel;
  62. my $dst = "$to$rel";
  63. if ( -d $File::Find::name ) { File::Path::make_path($dst) }
  64. elsif ( -f $File::Find::name ) { File::Copy::copy( $File::Find::name, $dst ) or die "copy $File::Find::name: $!" }
  65. },
  66. },
  67. $from
  68. );
  69. return;
  70. }
  71. # Everything the sandbox needs, in one BEGIN. The Trog:: modules are require()d
  72. # at runtime below, which is unconditionally after every BEGIN -- so no later
  73. # edit can accidentally load them before the chdir. That matters: TCMS.pm runs
  74. # build_routes() at file scope and FlatFile.pm reads the tag index at file
  75. # scope, both against whatever cwd happens to be current.
  76. BEGIN {
  77. $REPO = Cwd::abs_path("$FindBin::Bin/..");
  78. $OLDCWD = Cwd::getcwd();
  79. %REPO_BEFORE = map { _snapshot("$REPO/$_") } qw{config data www/templates www/assets logs totp};
  80. $ROOT = File::Temp::tempdir( 'tcms-lifecycle-XXXXXX', TMPDIR => 1, CLEANUP => 0 );
  81. # Installer.mk's tree, plus upload-src for the file.tx fixture.
  82. File::Path::make_path(
  83. map { "$ROOT/$_" }
  84. qw{
  85. config schema data/files logs totp upload-src
  86. www/assets/private www/statics www/themes www/scripts
  87. }
  88. );
  89. # A real fresh install: get() looks for config/main.cfg, doesn't find one,
  90. # and falls through to the shipped default. The data model is the shipped
  91. # one unless the environment names another, which is how this whole file
  92. # gets run against each of them -- the point being that a data model is only
  93. # finished when the app cannot tell which one it is talking to.
  94. my $stock = File::Slurper::read_text("$REPO/config/default.cfg");
  95. $stock =~ s/^(\s*data_model=).*$/$1$MODEL/m or die "could not set the data model in default.cfg";
  96. File::Slurper::write_text( "$ROOT/config/default.cfg", $stock );
  97. # Hardcoded paths in Auth.pm, TagIndex.pm, the data models and Log.pm -- not negotiable.
  98. File::Copy::copy( "$REPO/schema/$_", "$ROOT/schema/$_" ) or die $! for qw{auth.schema flatfile.schema sqlite.schema log.schema};
  99. # COPY, don't symlink: post_wizard_save() writes into Trog::Themes::forms_dir(),
  100. # and a symlink would land the generated post type in the real repo.
  101. _copy_tree( "$REPO/www/templates", "$ROOT/www/templates" );
  102. # posts.tx pulls in the EmojiPicker component for an editor, and EmojiPicker
  103. # dies outright if this file is missing. Only category and emoji are read.
  104. open( my $fh, '>', "$ROOT/www/scripts/list.min.json" ) or die $!;
  105. print {$fh} '{"emojis":[{"category":"Smileys","emoji":"X"}]}';
  106. close $fh;
  107. # Text::Xslate computes its default cache dir from $HOME once, at load time.
  108. # Without this the sandbox writes compiled templates into the real ~/.xslate_cache.
  109. $ENV{HOME} = $ROOT;
  110. chdir($ROOT) or die "could not chdir to sandbox $ROOT: $!";
  111. }
  112. END {
  113. # Never rmtree the directory you are standing in.
  114. chdir($OLDCWD) if $OLDCWD;
  115. if ( $ENV{TCMS_TEST_KEEP} ) {
  116. diag("TCMS_TEST_KEEP set, sandbox left at $ROOT");
  117. }
  118. elsif ( $ROOT && -d $ROOT ) {
  119. # SQLite handles are file-lexical in Trog::SQLite and unreachable from
  120. # here; DBI disconnects at global destruction, after these are gone.
  121. eval { File::Path::remove_tree($ROOT) };
  122. }
  123. }
  124. diag("sandbox: $ROOT");
  125. require Trog::Log;
  126. Trog::Log::log_init( 'logs/tcms.log', 'info' ); # sets $LOGDIR, hence logs/log.db
  127. require Trog::Config;
  128. require Trog::Themes;
  129. require Trog::Data;
  130. require Trog::Auth;
  131. require Trog::SQLite::TagIndex if $MODEL eq 'FlatFile';
  132. require Trog::Routes::HTML;
  133. require Trog::Routes::JSON;
  134. #--------------------------------------------------------------------------
  135. # A stand-in for the tPSGI object the router injects as $query->{tpsgi}.
  136. #--------------------------------------------------------------------------
  137. {
  138. package Test::TPSGI;
  139. sub new {
  140. my ( $class, %args ) = @_;
  141. return bless {
  142. callbacks => 0,
  143. renders => {},
  144. invalidated => [],
  145. restarts => 0,
  146. tpsgi_dir => Cwd::getcwd(),
  147. log_dir => 'logs',
  148. gid => $),
  149. verbose => 0,
  150. %args,
  151. }, $class;
  152. }
  153. sub INFO { 1 }
  154. sub DEBUG { 1 }
  155. sub WARN { 1 }
  156. sub ERROR { 1 }
  157. sub CRIT { 1 }
  158. sub ALERT { 1 }
  159. sub EMERG { 1 }
  160. sub FATAL { 1 }
  161. sub see_also { return [ 303, [ 'Location' => $_[1], 'Content-Length' => 0 ], [''] ] }
  162. sub redirect { return [ 302, [ 'Location' => $_[1], 'Content-Length' => 0 ], [''] ] }
  163. sub redirect_permanent { return [ 301, [ 'Location' => $_[1], 'Content-Length' => 0 ], [''] ] }
  164. sub _reply { return [ $_[1], [ 'Content-type' => 'text/html' ], [ defined $_[2] ? $_[2] : '' ] ] }
  165. sub ok { return $_[0]->_reply( 200, $_[2] ) }
  166. sub notfound { return $_[0]->_reply( 404, $_[2] // 'Not Found' ) }
  167. sub forbidden { return $_[0]->_reply( 403, $_[2] // 'Forbidden' ) }
  168. sub badrequest { return $_[0]->_reply( 400, $_[2] // 'Bad Request' ) }
  169. sub error { return $_[0]->_reply( 500, $_[2] // 'Error' ) }
  170. sub serve { return [ 200, [], [''] ] }
  171. # These two must be inert.
  172. #
  173. # add_post_close_callback is the ONLY path by which Trog::Renderer and
  174. # post_save reach save_render()/invalidate_renders(). Dropping the callback
  175. # on the floor is what guarantees this test never writes into www/statics,
  176. # whatever the renderer's own skip-save logic decides.
  177. sub add_post_close_callback { $_[0]{callbacks}++; return 1 }
  178. # The real one is `kill 'HUP', getppid`. Under prove, that is prove.
  179. sub signal_restart_parent { $_[0]{restarts}++; return 1 }
  180. sub invalidate_renders { push @{ $_[0]{invalidated} }, $_[1]; return 1 }
  181. sub invalidate_render { push @{ $_[0]{invalidated} }, [ @_[ 1 .. $#_ ] ]; return 1 }
  182. sub save_render { $_[0]{renders}{"$_[1]:$_[2]"} = $_[3]; return 1 }
  183. }
  184. our $TPSGI = Test::TPSGI->new();
  185. our $ADMIN_USER = 'specadmin';
  186. our $ADMIN_DISPLAY = 'Spec Admin';
  187. our $ADMIN_EMAIL = 'specadmin@example.com';
  188. our $ADMIN_PASS = 'spec-password';
  189. #--------------------------------------------------------------------------
  190. # Harness
  191. #--------------------------------------------------------------------------
  192. # Always build a fresh query: posts() pushes onto user_acls, and series()
  193. # rewrites route/aclname/tag/in_series/primary_post in place.
  194. sub _query {
  195. my (%over) = @_;
  196. my %q = (
  197. route => '/',
  198. method => 'GET',
  199. scheme => 'http', # Renderer::Base compares this with no undef guard
  200. domain => 'tcms.test',
  201. start => [ Time::HiRes::gettimeofday() ], # tv_interval() dies on anything else
  202. deflate => 0,
  203. streaming => 0,
  204. ranges => [],
  205. last_fetched => undef,
  206. has_query => 0,
  207. social_meta => 0,
  208. acls => [],
  209. user_acls => [],
  210. body => undef,
  211. tpsgi => $TPSGI,
  212. %over,
  213. );
  214. $q{fullpath} //= $q{route};
  215. return \%q;
  216. }
  217. sub _anon { return _query( user => undef, user_acls => [], @_ ) }
  218. sub _admin { return _query( user => $ADMIN_USER, user_acls => ['admin'], @_ ) }
  219. # Returns ($code, $body, $error). Never dies, so one bad post type cannot take
  220. # the rest of the file with it -- which matters because a failed render inside
  221. # index() dies rather than returning a 500 (there is no www/templates/html/500.tx).
  222. sub _render {
  223. my ( $query, $how ) = @_;
  224. $how ||= \&Trog::Routes::HTML::index;
  225. my $res = eval { $how->($query) };
  226. return ( 0, '', "died: $@" ) if !$res;
  227. return ( 0, '', 'returned a ' . ( ref($res) || 'plain scalar' ) ) if ref $res ne 'ARRAY';
  228. my ( $code, $headers, $body ) = @$res;
  229. $body = ref $body eq 'ARRAY' ? join( '', @$body ) : ( $body // '' );
  230. return ( $code, Encode::decode_utf8($body), '', $headers );
  231. }
  232. # FlatFile snapshots the tag list at load time and then filters each query's
  233. # tags against it IN PLACE -- so a tag created later isn't merely unindexed, it
  234. # is deleted from the query, and the filter silently degrades to "every public
  235. # post". Production gets away with it because a save HUPs the parent and the
  236. # worker re-execs. We have to do it by hand.
  237. #
  238. # Nothing to do for a model that asks the database each time, which is the
  239. # point: this helper exists to paper over a cache, and a model without one
  240. # needs no paper.
  241. sub _reindex {
  242. return unless $MODEL eq 'FlatFile';
  243. no warnings 'once';
  244. @Trog::Data::FlatFile::tags = Trog::SQLite::TagIndex::tags();
  245. %Trog::Data::FlatFile::posts_by_tag = ();
  246. return;
  247. }
  248. sub _data { return Trog::Data->new( Trog::Config::get() ) }
  249. # categories.tx renders into <span id="categories">. Scope to it -- index.tx
  250. # emits other class="topbar" anchors outside that span.
  251. sub _topbar_titles {
  252. my ($body) = @_;
  253. my ($span) = $body =~ m{<span id="categories">(.*?)</span>}s;
  254. return () unless defined $span;
  255. return $span =~ m{class="topbar">([^<]*)</a>}g;
  256. }
  257. # post_title.tx emits exactly one of these per displayed post.
  258. sub _post_count {
  259. my $n = () = $_[0] =~ m{<h3 class='blogtitles'>}g;
  260. return $n;
  261. }
  262. # The rendered page is ~40KB and mostly JavaScript. Show the content well.
  263. sub _kontent {
  264. my ($body) = @_;
  265. my ($k) = $body =~ m{<div id="kontent" class="kontained">(.*?)<div id="rightbar"}s;
  266. $k //= $body;
  267. $k =~ s/<script\b.*?<\/script>//gs;
  268. return length($k) > 2500 ? substr( $k, 0, 2500 ) . "\n...[truncated]" : $k;
  269. }
  270. # Save through post_save() rather than $data->add(): add() dies with an
  271. # arrayref of validator errors, whereas post_save catches them and hands back a
  272. # 400 with the field-level detail in the body -- which is the single most
  273. # useful thing to see when a fixture is wrong.
  274. sub _save_post {
  275. my ( $label, %post ) = @_;
  276. my $to = delete $post{to};
  277. my $res = eval { Trog::Routes::HTML::post_save( _admin( route => '/post/save', method => 'POST', to => $to, %post ) ) };
  278. if ( !$res || ref $res ne 'ARRAY' ) {
  279. fail("$label: saved");
  280. diag( $@ || 'post_save returned nothing' );
  281. return undef;
  282. }
  283. my ( $code, $headers, $body ) = @$res;
  284. my %h = @{ $headers || [] };
  285. # Both outcomes redirect now, so the status alone proves nothing -- the
  286. # outcome is in the query string post_save hands to the destination.
  287. if ( $code != 303 || ( $h{Location} // '' ) =~ m/savefailed=/ ) {
  288. fail("$label: saved");
  289. diag( "post_save returned $code, Location: " . ( $h{Location} // '(none)' ) );
  290. diag( join( '', @{ $body || [''] } ) ) if $body && @$body;
  291. return undef;
  292. }
  293. pass("$label: saved");
  294. _reindex(); # mandatory: see the comment on _reindex
  295. my $saved = _find_post( $post{title} );
  296. ok( $saved, "$label: readable back out of the datastore" ) or return undef;
  297. return $saved;
  298. }
  299. sub _find_post {
  300. my ($title) = @_;
  301. # filter() short-circuits on title; the admin acl skips the visibility filter.
  302. my @posts = _data()->get( title => $title, acls => ['admin'], limit => 0 );
  303. return $posts[0];
  304. }
  305. #--------------------------------------------------------------------------
  306. subtest 'the sandbox is what we are actually running against' => sub {
  307. is( Cwd::getcwd(), Cwd::abs_path($ROOT), 'cwd is the sandbox' );
  308. ok( -d 'data/files', 'datastore dir exists' );
  309. ok( -f 'config/default.cfg', 'config was seeded' );
  310. ok( !-f 'config/main.cfg', 'and there is no main.cfg, so we fall through to the default' );
  311. my $conf = Trog::Config::get();
  312. is( $conf->param('general.data_model'), $MODEL, 'config resolves inside the sandbox' );
  313. like( Trog::Themes::forms_dir(), qr/^www\/templates/, 'forms dir is relative, hence sandboxed' );
  314. ok( -d Cwd::abs_path( Trog::Themes::forms_dir() ), 'and it exists' );
  315. like( Cwd::abs_path( Trog::Themes::forms_dir() ), qr/^\Q$ROOT\E/, 'and it is under the sandbox, not the repo' );
  316. };
  317. subtest 'registering the first admin bootstraps the install' => sub {
  318. ok( !-f 'config/has_users', 'no users yet, so login() is in register mode' );
  319. my ( $code, $body, $err, $headers ) = _render(
  320. _anon(
  321. route => '/login',
  322. method => 'POST',
  323. username => $ADMIN_USER,
  324. display_name => $ADMIN_DISPLAY,
  325. contact_email => $ADMIN_EMAIL,
  326. password => $ADMIN_PASS,
  327. to => '/',
  328. ),
  329. \&Trog::Routes::HTML::login,
  330. );
  331. is( $code, 200, 'login() rendered' ) or diag($err);
  332. my %h = @{ $headers || [] };
  333. like( $h{'Set-Cookie'} // '', qr/^tcmslogin=[0-9a-f-]{36};/, 'a session cookie came back' );
  334. ok( -f 'config/has_users', 'registration is now closed' );
  335. is_deeply( Trog::Auth::acls4user($ADMIN_USER), ['admin'], 'the new user is an admin' );
  336. _reindex();
  337. my @seeded = _data()->get( acls => ['admin'], limit => 0 );
  338. is( scalar @seeded, 4, 'the four seed posts were written' )
  339. or diag( 'got: ' . join( ', ', map { "$_->{title} ($_->{form})" } @seeded ) );
  340. };
  341. subtest 'the post wizard invents a new post type' => sub {
  342. my %wizard = (
  343. name => 'spec_widget',
  344. title_placeholder => 'Widget Name',
  345. body_form => 'form_common.tx',
  346. wrapper => 1,
  347. inc_post_title => 1,
  348. inc_post_tags => 1,
  349. inc_title_input => 1,
  350. inc_visibility => 1,
  351. inc_tags => 1,
  352. inc_aliases => 1,
  353. param_name => ['flavor'],
  354. param_type => ['text'],
  355. param_label => ['Flavor'],
  356. param_placeholder => ['Strawberry'],
  357. param_required => [0],
  358. display => q{<div class="postData responsive-text" id="postData-<: $post.id :>">} . q{<span class="spec-flavor"><: $post.flavor :></span>} . q{<: render_it($post.data) | mark_raw :></div>},
  359. );
  360. my ( $code, $body, $err ) = _render(
  361. _admin( route => '/admin/wyzzerdd/save', method => 'POST', %wizard ),
  362. \&Trog::Routes::HTML::post_wizard_save,
  363. );
  364. is( $code, 200, 'wizard save rendered' ) or diag($err);
  365. ok( -f 'www/templates/html/components/forms/spec_widget.tx', 'the template was written' );
  366. ok( -f 'www/templates/html/components/forms/spec_widget.json', 'the schema sidecar was written' );
  367. like( $body, qr{<li>spec_widget\.tx</li>}, 'and the new type is listed back to us' );
  368. # This is the assertion that the sandbox is real: a symlinked template tree
  369. # would have put these in the developer's actual checkout.
  370. ok( !-e "$REPO/www/templates/html/components/forms/spec_widget.tx", 'nothing was written into the repo' );
  371. # The relation controls have to be present in every row and always submit,
  372. # or the parallel param_* arrays de-align server side.
  373. like( $body, qr/name="param_relation_form"/, 'the relation target select is in the row template' );
  374. like( $body, qr/name="param_relation_mode"/, 'so is the relation mode select' );
  375. like( $body, qr/<option value="relation">/, 'and relation is offered as a field type' );
  376. # A series can ask for its children to be tiled. A generated type has to
  377. # carry that on its wrapper like the hand-written forms do, or it is the
  378. # one kind of post that silently ignores the setting.
  379. my $generated = Path::Tiny->new('www/templates/html/components/forms/spec_widget.tx')->slurp_utf8;
  380. # Single quoted: the wrapper is Kolon source, so every sigil in it is
  381. # literal and must not be interpolated by the test that checks for it.
  382. my $wrapper = q{<div class="post <: $style :> <: $tiled ? 'tile' : '' :>">};
  383. ok( index( $generated, $wrapper ) >= 0, 'the generated wrapper carries the tile class when the series asks for it' )
  384. or diag( "wanted: $wrapper\ngot: " . ( split( /\n/, $generated ) )[1] );
  385. # Every post has a title, a visibility and acls. The wizard used to let a
  386. # type opt out of collecting them, which is how a hypervisor post ended up
  387. # stored with no visibility and an undef in its tags.
  388. foreach my $required ( 'visibility.tx', 'acls.tx' ) {
  389. like( $generated, qr/\Q: include "$required";\E/, "$required is included whether or not it was asked for" );
  390. }
  391. like( $generated, qr/name="title"/, 'and so is the title input' );
  392. foreach my $gone (qw{inc_title_input inc_visibility inc_acls}) {
  393. unlike( $body, qr/name="\Q$gone\E"/, "the wizard no longer offers '$gone' as a choice" );
  394. }
  395. like( $body, qr/name="param_private"/, 'and it offers per-field privacy' );
  396. like( $body, qr/name="datasource"/, 'and a datasource to draw the posts from' );
  397. like( $body, qr/Trog::DataSource::Virt/, 'listing the ones that exist' );
  398. };
  399. subtest 'a datasource-backed type gets no editor' => sub {
  400. # A datasource whose posts are built rather than written has nothing behind
  401. # a form to save, so generating one would produce an editor that writes
  402. # real posts to sit alongside the synthesized ones.
  403. my ( $code, $body, $err ) = _render(
  404. _admin(
  405. route => '/admin/wyzzerdd/save',
  406. method => 'POST',
  407. name => 'spec_sourced',
  408. datasource => 'Trog::DataSource::Virt',
  409. body_form => 'form_common.tx',
  410. wrapper => 1,
  411. inc_post_title => 1,
  412. display => q{<div class="s"><: $post.title :></div>},
  413. ),
  414. \&Trog::Routes::HTML::post_wizard_save,
  415. );
  416. is( $code, 200, 'the type was created' ) or diag($err);
  417. my $generated = Path::Tiny->new('www/templates/html/components/forms/spec_sourced.tx')->slurp_utf8;
  418. unlike( $generated, qr{action="/post/save"}, 'no editor was generated' );
  419. unlike( $generated, qr/\$can_edit/, 'and nothing guards one' );
  420. like( $generated, qr/class="s"/, 'but the display half is there' );
  421. my $sidecar = JSON::MaybeXS::decode_json( Path::Tiny->new('www/templates/html/components/forms/spec_sourced.json')->slurp_utf8 );
  422. is( $sidecar->{'x-tcms-datasource'}, 'Trog::DataSource::Virt', 'and the sidecar records the datasource' );
  423. # The same type without one keeps its editor.
  424. _render(
  425. _admin(
  426. route => '/admin/wyzzerdd/save',
  427. method => 'POST',
  428. name => 'spec_stored',
  429. body_form => 'form_common.tx',
  430. wrapper => 1,
  431. inc_post_title => 1,
  432. display => q{<div class="s"><: $post.title :></div>},
  433. ),
  434. \&Trog::Routes::HTML::post_wizard_save,
  435. );
  436. my $stored = Path::Tiny->new('www/templates/html/components/forms/spec_stored.tx')->slurp_utf8;
  437. like( $stored, qr{action="/post/save"}, 'a type on the datastore still gets one' );
  438. # The name is require()d later, so it has to be one we found.
  439. ( $code, $body ) = _render(
  440. _admin( route => '/admin/wyzzerdd/save', method => 'POST', name => 'spec_bogus', datasource => 'Evil::Module' ),
  441. \&Trog::Routes::HTML::post_wizard_save,
  442. );
  443. like( $body, qr/not a datasource I can find/, 'a datasource we did not find is refused' );
  444. ok( !-e 'www/templates/html/components/forms/spec_bogus.tx', 'and nothing was written' );
  445. };
  446. subtest 'a field can be declared indexed' => sub {
  447. my ( $code, $body, $err ) = _render(
  448. _admin(
  449. route => '/admin/wyzzerdd/save',
  450. method => 'POST',
  451. name => 'spec_indexed',
  452. body_form => 'form_common.tx',
  453. wrapper => 1,
  454. inc_post_title => 1,
  455. # The middle row is the one that matters: its box is clear, and the
  456. # wizard zips these arrays together positionally, so if a clear box
  457. # ever submitted nothing the flag would land on the wrong field.
  458. param_name => [ 'cook_time', 'garnish', 'serves' ],
  459. param_type => [ 'text', 'text', 'number' ],
  460. param_label => [ 'Cook Time', 'Garnish', 'Serves' ],
  461. param_placeholder => [ '', '', '' ],
  462. param_required => [ 0, 0, 0 ],
  463. param_private => [ 0, 0, 0 ],
  464. param_indexed => [ 1, 0, 1 ],
  465. param_relation_form => [ 'blog.tx', 'blog.tx', 'blog.tx' ],
  466. param_relation_mode => [ 'one', 'one', 'one' ],
  467. display => q{<div class="ct"><: $post.cook_time :></div>},
  468. ),
  469. \&Trog::Routes::HTML::post_wizard_save,
  470. );
  471. is( $code, 200, 'the type was created' ) or diag($err);
  472. my $sidecar = JSON::MaybeXS::decode_json( Path::Tiny->new('www/templates/html/components/forms/spec_indexed.json')->slurp_utf8 );
  473. ok( $sidecar->{properties}{cook_time}{'x-tcms-indexed'}, 'the ticked field is marked indexed' );
  474. ok( $sidecar->{properties}{serves}{'x-tcms-indexed'}, 'and so is the one after the clear box' );
  475. ok( !exists $sidecar->{properties}{garnish}{'x-tcms-indexed'}, 'the field between them is not' );
  476. ok( !exists $sidecar->{properties}{cook_time}{'x-tcms-private'}, 'and indexing is not privacy' );
  477. is_deeply(
  478. Trog::DataModule::indexed_fields_for('spec_indexed.tx'),
  479. [ sort qw{cook_time serves} ],
  480. 'and the model reads them back out of the sidecar'
  481. );
  482. SKIP: {
  483. skip( "the $MODEL model has nothing to index with", 3 ) unless $MODEL eq 'SQLite';
  484. my $dbh = Trog::SQLite::dbh( undef, 'data/posts.sqlite' );
  485. my %columns = map { $_->{name} => 1 } @{ $dbh->selectall_arrayref( 'PRAGMA table_xinfo(posts)', { Slice => {} } ) };
  486. my %indexes = map { $_->{name} => 1 } @{ $dbh->selectall_arrayref( "SELECT name FROM sqlite_master WHERE type='index' AND tbl_name='posts'", { Slice => {} } ) };
  487. ok( $columns{cook_time}, 'saving the type gave the ticked field a column' );
  488. ok( $indexes{'posts_custom_cook_time'}, 'and an index' );
  489. ok( !$indexes{'posts_custom_garnish'}, 'and left the unticked one alone' );
  490. }
  491. # A post of the type still saves and reads back the same as any other.
  492. _reindex();
  493. _make_series( 'spec_indexed', 'specindexed', 'spec_indexed.tx', 'Spec Indexed Series', no_topbar => 1 ) or return;
  494. my $child = _save_post(
  495. 'spec_indexed child',
  496. form => 'spec_indexed.tx',
  497. title => 'Spec Indexed Child',
  498. cook_time => '45 minutes',
  499. garnish => 'parsley',
  500. visibility => 'public',
  501. tags => ['specindexed'],
  502. to => '/specindexed',
  503. ) or return;
  504. is( $child->{cook_time}, '45 minutes', 'an indexed field stores like any other' );
  505. is( $child->{garnish}, 'parsley', 'and so does the one beside it' );
  506. };
  507. subtest 'a field can be declared editors-only' => sub {
  508. my ( $code, $body, $err ) = _render(
  509. _admin(
  510. route => '/admin/wyzzerdd/save',
  511. method => 'POST',
  512. name => 'spec_secretive',
  513. body_form => 'form_common.tx',
  514. wrapper => 1,
  515. inc_post_title => 1,
  516. inc_tags => 1,
  517. param_name => [ 'shown', 'hidden' ],
  518. param_type => [ 'text', 'text' ],
  519. param_label => [ 'Shown', 'Hidden' ],
  520. param_placeholder => [ '', '' ],
  521. param_required => [ 0, 0 ],
  522. param_private => [ 0, 1 ],
  523. param_relation_form => [ 'blog.tx', 'blog.tx' ],
  524. param_relation_mode => [ 'one', 'one' ],
  525. # Deliberately unguarded: declaring the field private is supposed
  526. # to be enough, so an author does not have to remember.
  527. display => q{<div class="s"><: $post.shown :></div><div class="h"><: $post.hidden :></div>},
  528. ),
  529. \&Trog::Routes::HTML::post_wizard_save,
  530. );
  531. is( $code, 200, 'the type was created' ) or diag($err);
  532. my $sidecar = JSON::MaybeXS::decode_json( Path::Tiny->new('www/templates/html/components/forms/spec_secretive.json')->slurp_utf8 );
  533. ok( $sidecar->{properties}{hidden}{'x-tcms-private'}, 'the private field is marked so' );
  534. ok( !exists $sidecar->{properties}{shown}{'x-tcms-private'}, 'and a public one carries no flag at all' );
  535. _reindex();
  536. _make_series( 'spec_secretive', 'specsecretive', 'spec_secretive.tx', 'Spec Secretive Series', no_topbar => 1 ) or return;
  537. my $child = _save_post(
  538. 'spec_secretive child',
  539. form => 'spec_secretive.tx',
  540. title => 'Spec Secretive Child',
  541. shown => 'public value',
  542. hidden => 'private value',
  543. visibility => 'public',
  544. tags => ['specsecretive'],
  545. to => '/specsecretive',
  546. ) or return;
  547. is( $child->{hidden}, 'private value', 'the value is stored like any other' );
  548. # An editor sees both.
  549. my ( $acode, $abody ) = _render( _admin( route => '/specsecretive' ), \&Trog::Routes::HTML::series );
  550. is( $acode, 200, 'the series renders for an admin' );
  551. like( $abody, qr{<div class="h">private value</div>}, 'who sees the private field' );
  552. # A logged out reader sees only the public one, without the template
  553. # having guarded anything.
  554. my ( $ncode, $nbody ) = _render( _anon( route => '/specsecretive' ), \&Trog::Routes::HTML::series );
  555. is( $ncode, 200, 'and for everyone else' );
  556. like( $nbody, qr{<div class="s">public value</div>}, 'who still sees the public field' );
  557. unlike( $nbody, qr/private value/, 'but not the private one' );
  558. };
  559. #--------------------------------------------------------------------------
  560. # The matrix.
  561. #
  562. # Per type: build a topbar series whose child_form is that type, check it shows
  563. # up in the nav, add a child post, check the child renders on the series page.
  564. #
  565. # Everything is verified ANONYMOUSLY. can_edit is then false, so the editor
  566. # half of each form never renders and a title appears exactly once -- which is
  567. # what makes like($body, qr/$title/) mean anything. It also sidesteps the
  568. # /secure prefixing that both _post_helper and categories.tx apply when a user
  569. # is set.
  570. #--------------------------------------------------------------------------
  571. sub _make_series {
  572. my ( $label, $aclname, $child_form, $title, %opt ) = @_;
  573. # _get_series caps the bar at 10 and the seeds already use two, so only the
  574. # series whose topbar behaviour we actually care about get tagged.
  575. my @tags = $opt{no_topbar} ? ('series') : ( 'series', 'topbar' );
  576. my $series = _save_post(
  577. "$label series",
  578. form => 'series.tx',
  579. title => $title,
  580. aclname => $aclname, # required by series.json
  581. child_form => $child_form, # required by series.json
  582. local_href => "/$aclname",
  583. href => "/$aclname",
  584. data => "$title subhead",
  585. callback => 'Trog::Routes::HTML::series',
  586. visibility => 'public',
  587. tags => \@tags,
  588. tiled => 0,
  589. to => '/',
  590. ) or return undef;
  591. return $series if $opt{no_topbar};
  592. # The topbar comes from _get_series(), which index() renders through
  593. # categories.tx. Check it on / -- the series has no children yet, and
  594. # posts() 404s on an empty series.
  595. my ( $code, $body, $err ) = _render( _anon( route => '/' ) );
  596. is( $code, 200, "$label: / renders" ) or diag($err);
  597. my @titles = _topbar_titles($body);
  598. ok( ( grep { $_ eq $title } @titles ), "$label: series is in the topbar" )
  599. or diag( 'topbar was: ' . join( ', ', @titles ) );
  600. return $series;
  601. }
  602. sub _series_page {
  603. my ( $label, $aclname, $series_title, $expected_posts ) = @_;
  604. my ( $code, $body, $err ) = _render( _anon( route => "/$aclname" ), \&Trog::Routes::HTML::series );
  605. is( $code, 200, "$label: series page renders" ) or do { diag($err); return '' };
  606. like( $body, qr{<title>[^<]*\Q$series_title\E}, "$label: series page is the right series" );
  607. is( _post_count($body), $expected_posts, "$label: exactly $expected_posts post(s) listed" )
  608. or diag( _kontent($body) );
  609. return $body;
  610. }
  611. # Entities first: the invoice type resolves payee/payor against existing public
  612. # entities.tx posts, so those have to be in the datastore before we get there.
  613. our ( $PAYEE, $PAYOR );
  614. subtest 'entities' => sub {
  615. my $title = 'Spec Entities Series';
  616. _make_series( 'entities', 'specentities', 'entities.tx', $title ) or return;
  617. $PAYEE = _save_post(
  618. 'entities payee child',
  619. form => 'entities.tx',
  620. title => 'Spec Payee Entity',
  621. data => 'Acme Payments LLC, 1 Road, Metropolis',
  622. payment_method => 'ACH',
  623. payment_details => 'Routing 0000 Account 1111',
  624. visibility => 'public',
  625. tags => ['specentities'],
  626. to => '/specentities',
  627. ) or return;
  628. $PAYOR = _save_post(
  629. 'entities payor child',
  630. form => 'entities.tx',
  631. title => 'Spec Payor Entity',
  632. data => 'Wile E Coyote, PO Box 9',
  633. payment_method => 'Carrier Pigeon',
  634. payment_details => 'none',
  635. visibility => 'public',
  636. tags => ['specentities'],
  637. to => '/specentities',
  638. ) or return;
  639. my $body = _series_page( 'entities', 'specentities', $title, 2 ) or return;
  640. like( $body, qr{id="postData-\Q$PAYEE->{id}\E"}, 'payee body rendered' );
  641. like( $body, qr/Acme Payments LLC/, 'payee data rendered' );
  642. like( $body, qr/Wile E Coyote/, 'payor data rendered' );
  643. # entity_details.tx is included only in the editor half, so these are stored
  644. # but never displayed. Pinning that so a template change is noticed.
  645. unlike( $body, qr/Carrier Pigeon/, 'payment details are not shown to anonymous readers' );
  646. is( _find_post('Spec Payee Entity')->{payment_method}, 'ACH', 'but payment_method did survive the schema' );
  647. };
  648. subtest 'blog' => sub {
  649. my $title = 'Spec Blog Series';
  650. _make_series( 'blog', 'specblog', 'blog.tx', $title ) or return;
  651. my $child = _save_post(
  652. 'blog child',
  653. form => 'blog.tx',
  654. title => 'Spec Blog Child',
  655. data => 'Spec blog body text.',
  656. visibility => 'public',
  657. tags => ['specblog'],
  658. to => '/specblog',
  659. ) or return;
  660. my $body = _series_page( 'blog', 'specblog', $title, 1 ) or return;
  661. like( $body, qr/Spec Blog Child/, 'child title rendered' );
  662. like( $body, qr{href='/posts/\Q$child->{id}\E'}, 'child permalink rendered' );
  663. like( $body, qr{id="postData-\Q$child->{id}\E"}, 'child body block rendered' );
  664. like( $body, qr/Spec blog body text\./, 'child body text rendered' );
  665. unlike( $body, qr/Spec Payee Entity/, 'no bleed from the entities series' );
  666. };
  667. subtest 'microblog' => sub {
  668. my $title = 'Spec Microblog Series';
  669. _make_series( 'microblog', 'specmicroblog', 'microblog.tx', $title ) or return;
  670. my $child = _save_post(
  671. 'microblog child',
  672. form => 'microblog.tx',
  673. title => 'Spec Microblog Child',
  674. href => 'https://example.com/spec',
  675. data => 'Spec microblog body.',
  676. visibility => 'public',
  677. tags => ['specmicroblog'],
  678. to => '/specmicroblog',
  679. ) or return;
  680. my $body = _series_page( 'microblog', 'specmicroblog', $title, 1 ) or return;
  681. like( $body, qr{href='https://example\.com/spec' >Spec Microblog Child</a>}, 'title links out to href' );
  682. like( $body, qr{id="postData-\Q$child->{id}\E"}, 'body block rendered' );
  683. like( $body, qr/Spec microblog body\./, 'body text rendered' );
  684. };
  685. subtest 'file' => sub {
  686. my $title = 'Spec File Series';
  687. _make_series( 'file', 'specfile', 'file.tx', $title ) or return;
  688. # _handle_upload MOVES the file, so it has to be created fresh here.
  689. my $src = "$ROOT/upload-src/spec-upload.txt";
  690. open( my $fh, '>', $src ) or die $!;
  691. print {$fh} "spec upload contents\n";
  692. close $fh;
  693. my $child = _save_post(
  694. 'file child',
  695. form => 'file.tx',
  696. title => 'Spec File Child',
  697. data => 'Spec file body.',
  698. file => { tempname => $src, filename => 'spec-upload.txt' },
  699. visibility => 'public',
  700. tags => ['specfile'],
  701. to => '/specfile',
  702. ) or return;
  703. ok( !-e $src, 'the upload was moved out of its temp location, not copied' );
  704. ok( -f "www/assets/$child->{id}.spec-upload.txt", 'and it landed in www/assets' );
  705. my $body = _series_page( 'file', 'specfile', $title, 1 ) or return;
  706. like( $body, qr{href='/assets/\Q$child->{id}\E\.spec-upload\.txt'}, 'title links to the asset' );
  707. like( $body, qr{id="postData-\Q$child->{id}\E"}, 'body block carries a unique id, like every other form' );
  708. like( $body, qr/Spec file body\./, 'body text rendered' );
  709. # This form used to emit <div class="postData" id="postData" class="responsive-text">
  710. # -- a duplicated class attribute, and an id shared by every file post on
  711. # the page. Neither should come back.
  712. unlike( $body, qr{<div class="postData" id="postData"}, 'no duplicated class attribute' );
  713. # text/plain, so none of the media branches fire.
  714. unlike( $body, qr/<video/, 'no video block for a text file' );
  715. unlike( $body, qr/<audio/, 'no audio block either' );
  716. };
  717. subtest 'presentation' => sub {
  718. my $title = 'Spec Presentation Series';
  719. _make_series( 'presentation', 'specpresentation', 'presentation.tx', $title ) or return;
  720. my $child = _save_post(
  721. 'presentation child',
  722. form => 'presentation.tx',
  723. title => 'Spec Presentation Child',
  724. data => [ 'Slide one body.', 'Slide two body.' ],
  725. data_is_array => 1,
  726. visibility => 'public',
  727. tags => ['specpresentation'],
  728. to => '/specpresentation',
  729. ) or return;
  730. is_deeply( $child->{data}, [ 'Slide one body.', 'Slide two body.' ], 'the multi-page data round-tripped as an array' );
  731. my $body = _series_page( 'presentation', 'specpresentation', $title, 1 ) or return;
  732. # Slides only render under nochrome; the series page just links to the deck.
  733. like( $body, qr{<a href="/posts/\Q$child->{id}\E\?embed=1&nochrome=1">Click Here to view</a>}, 'deck link rendered' );
  734. unlike( $body, qr/Slide one body\./, 'slides themselves are not rendered inline' );
  735. };
  736. subtest 'invoice' => sub {
  737. my $title = 'Spec Invoice Series';
  738. _make_series( 'invoice', 'specinvoice', 'invoice.tx', $title ) or return;
  739. my $child = _save_post(
  740. 'invoice child',
  741. form => 'invoice.tx',
  742. title => 'Spec Invoice Child',
  743. data => [ "Widget assembly\nPrice: \$420", "Shipping\nPrice: \$80" ],
  744. data_is_array => 1,
  745. payee => $PAYEE->{id},
  746. payor => $PAYOR->{id},
  747. due_days => 30,
  748. visibility => 'public',
  749. tags => ['specinvoice'],
  750. to => '/specinvoice',
  751. ) or return;
  752. my $body = _series_page( 'invoice', 'specinvoice', $title, 1 ) or return;
  753. like( $body, qr/Invoice ID# \Q$child->{id}\E/, 'invoice header rendered' );
  754. # These two only resolve because the entities subtest ran first and left
  755. # public entities.tx posts behind for the enrich hook to find.
  756. like( $body, qr/Acme Payments LLC/, 'payee entity resolved' );
  757. like( $body, qr/Wile E Coyote/, 'payor entity resolved' );
  758. like( $body, qr/ACH/, 'payee payment method pulled through' );
  759. like( $body, qr/Widget assembly/, 'line items rendered' );
  760. like( $body, qr/Total: \$500/, 'total summed from the line item prices' );
  761. };
  762. subtest 'spec_widget (the wizard-built type)' => sub {
  763. my $title = 'Spec Widget Series';
  764. _make_series( 'spec_widget', 'specwidget', 'spec_widget.tx', $title ) or return;
  765. my $child = _save_post(
  766. 'spec_widget child',
  767. form => 'spec_widget.tx',
  768. title => 'Spec Widget Child',
  769. data => 'Spec widget body.',
  770. flavor => 'Strawberry',
  771. bogus_field => 'nope',
  772. visibility => 'public',
  773. tags => ['specwidget'],
  774. to => '/specwidget',
  775. ) or return;
  776. is( $child->{flavor}, 'Strawberry', 'the custom field survived validation' );
  777. ok( !exists $child->{bogus_field}, 'an undeclared field was still stripped' );
  778. my $body = _series_page( 'spec_widget', 'specwidget', $title, 1 ) or return;
  779. # The payoff: this can only render if the wizard wrote spec_widget.json,
  780. # schema_for merged it over the base post schema, and validate() therefore
  781. # kept 'flavor' instead of deleting it as an unknown key.
  782. like( $body, qr{<span class="spec-flavor">Strawberry</span>}, 'the custom field rendered on the page' );
  783. like( $body, qr/Spec widget body\./, 'and the body came through the generated template' );
  784. };
  785. subtest 'a wizard-built type can depend on another type' => sub {
  786. # The type we will point at. The relation is what is under test, so keep
  787. # the target itself boring.
  788. my ( $code, $body, $err ) = _render(
  789. _admin(
  790. route => '/admin/wyzzerdd/save',
  791. method => 'POST',
  792. name => 'spec_target',
  793. body_form => 'form_common.tx',
  794. wrapper => 1,
  795. inc_post_title => 1,
  796. inc_title_input => 1,
  797. inc_visibility => 1,
  798. inc_tags => 1,
  799. display => q{<div><: render_it($post.data) | mark_raw :></div>},
  800. ),
  801. \&Trog::Routes::HTML::post_wizard_save,
  802. );
  803. is( $code, 200, 'target type created' ) or diag($err);
  804. # ...and the type that depends on it: one picked by id, one pulling in the
  805. # whole set.
  806. ( $code, $body, $err ) = _render(
  807. _admin(
  808. route => '/admin/wyzzerdd/save',
  809. method => 'POST',
  810. name => 'spec_relator',
  811. body_form => 'form_common.tx',
  812. wrapper => 1,
  813. inc_post_title => 1,
  814. inc_title_input => 1,
  815. inc_visibility => 1,
  816. inc_tags => 1,
  817. param_name => [ 'chosen', 'everything' ],
  818. param_type => [ 'relation', 'relation' ],
  819. param_label => [ 'Chosen One', 'All Of Them' ],
  820. param_placeholder => [ '', '' ],
  821. param_required => [ 0, 0 ],
  822. param_relation_form => [ 'spec_target.tx', 'spec_target.tx' ],
  823. param_relation_mode => [ 'one', 'all' ],
  824. display => q{<div class="rel"><span class="chosen"><: $post.chosen_post.title :></span>} . q{<: for $post.everything -> $t { :><span class="each"><: $t.title :></span><: } :></div>},
  825. ),
  826. \&Trog::Routes::HTML::post_wizard_save,
  827. );
  828. is( $code, 200, 'relating type created' ) or diag($err);
  829. my $sidecar = JSON::MaybeXS::decode_json( Path::Tiny->new('www/templates/html/components/forms/spec_relator.json')->slurp_utf8 );
  830. # 'one' is a field the post stores; 'all' is not a field at all.
  831. is( $sidecar->{properties}{chosen}{type}, 'relation', 'the picked relation is a stored property' );
  832. is( $sidecar->{properties}{chosen}{'x-tcms-relation-form'}, 'spec_target.tx', 'naming its target type' );
  833. ok( !exists $sidecar->{properties}{everything}, "the 'all' relation stores nothing" );
  834. is_deeply(
  835. $sidecar->{'x-tcms-relations'},
  836. {
  837. chosen_post => { form => 'spec_target.tx', from => 'chosen' },
  838. everything => { form => 'spec_target.tx' },
  839. },
  840. 'and both are declared for resolution at render'
  841. );
  842. # The relation pseudo-type has to become a real one before validation, or
  843. # every relation field would be stripped as an unknown type.
  844. is(
  845. Trog::DataModule::schema_for('spec_relator.tx')->{properties}{chosen}{type},
  846. 'string', "'relation' expands to a real schema type"
  847. );
  848. _reindex();
  849. # Now exercise it end to end.
  850. _make_series( 'spec_target', 'spectarget', 'spec_target.tx', 'Spec Target Series', no_topbar => 1 ) or return;
  851. my $target = _save_post(
  852. 'spec_target child',
  853. form => 'spec_target.tx',
  854. title => 'Spec Target Post',
  855. data => 'Spec target body.',
  856. visibility => 'public',
  857. tags => ['spectarget'],
  858. to => '/spectarget',
  859. ) or return;
  860. _make_series( 'spec_relator', 'specrelator', 'spec_relator.tx', 'Spec Relator Series', no_topbar => 1 ) or return;
  861. my $relator = _save_post(
  862. 'spec_relator child',
  863. form => 'spec_relator.tx',
  864. title => 'Spec Relator Post',
  865. data => 'Spec relator body.',
  866. chosen => $target->{id},
  867. visibility => 'public',
  868. tags => ['specrelator'],
  869. to => '/specrelator',
  870. ) or return;
  871. is( $relator->{chosen}, $target->{id}, 'the referenced id survived validation' );
  872. my $page = _series_page( 'spec_relator', 'specrelator', 'Spec Relator Series', 1 ) or return;
  873. # Both halves of the relation resolved: the one we picked, and the set.
  874. like( $page, qr{<span class="chosen">Spec Target Post</span>}, 'the picked post resolved into the page' );
  875. like( $page, qr{<span class="each">Spec Target Post</span>}, 'and so did the whole set' );
  876. };
  877. subtest '/api/posts_of_form feeds the relation picker' => sub {
  878. my $target = _find_post('Spec Target Post');
  879. ok( $target, 'the target post is there to be listed' ) or return;
  880. my $res = Trog::Routes::JSON::posts_of_form( _admin( route => '/api/posts_of_form', form => 'spec_target.tx' ) );
  881. is( ref $res, 'ARRAY', 'a PSGI response came back' ) or return;
  882. my ( $code, undef, $body ) = @$res;
  883. is( $code, 200, 'and it is a 200' );
  884. my $payload = JSON::MaybeXS::decode_json( join( '', @$body ) );
  885. is_deeply(
  886. $payload->{posts},
  887. [ { id => $target->{id}, title => 'Spec Target Post' } ],
  888. 'listing exactly the posts of that type, id and title only'
  889. );
  890. # An unknown type is an empty list, not an error -- a type with no posts
  891. # yet is the normal state of affairs right after you create it.
  892. $res = Trog::Routes::JSON::posts_of_form( _admin( route => '/api/posts_of_form', form => 'nosuchtype.tx' ) );
  893. $payload = JSON::MaybeXS::decode_json( join( '', @{ $res->[2] } ) );
  894. is_deeply( $payload->{posts}, [], 'an unknown type lists nothing rather than failing' );
  895. # The route's own declaration is what keeps a malformed form out; check it
  896. # matches what series.json demands of child_form.
  897. my $validator = $Trog::Routes::JSON::routes{'/api/posts_of_form'}{parameters}{form};
  898. ok( $validator->('blog.tx'), 'the parameter validator accepts a form name' );
  899. ok( !$validator->('../../etc/passwd'), 'and rejects a path' );
  900. ok( $Trog::Routes::JSON::routes{'/api/posts_of_form'}{auth}, 'the route requires a login' );
  901. };
  902. subtest 'a series resolves its relations for logged out visitors too' => sub {
  903. # The relations series() resolves land on the primary post, which is what a
  904. # datasource reads to find its hypervisors -- so assert on that rather than
  905. # on the rendered children, whose relations posts() resolves later, after
  906. # it has widened user_acls and thus by a path that was never broken.
  907. foreach my $case ( [ 'anonymously', _anon( route => '/specrelator' ) ], [ 'as an admin', _admin( route => '/specrelator' ) ] ) {
  908. my ( $label, $query ) = @$case;
  909. my ( $code, undef, $err ) = _render( $query, \&Trog::Routes::HTML::series );
  910. is( $code, 200, "the series renders $label" ) or do { diag($err); next };
  911. my $resolved = $query->{primary_post}{everything};
  912. is( ref $resolved, 'ARRAY', "$label, the series' own relation resolved" );
  913. cmp_ok( scalar @{ $resolved || [] }, '>', 0, "$label, to something rather than nothing" );
  914. }
  915. };
  916. subtest 'saves report back through the jsalert banner' => sub {
  917. # A good save redirects to where you came from, carrying the outcome.
  918. my $res = Trog::Routes::HTML::post_save(
  919. _admin(
  920. route => '/post/save',
  921. method => 'POST',
  922. to => '/specblog',
  923. form => 'blog.tx',
  924. title => 'Spec Feedback Child',
  925. data => 'Spec feedback body.',
  926. visibility => 'public',
  927. tags => ['specblog'],
  928. )
  929. );
  930. my ( $code, $headers ) = @$res;
  931. my %h = @{ $headers || [] };
  932. is( $code, 303, 'a good save redirects' );
  933. like( $h{Location}, qr{^/secure/specblog\?saved=}, 'to where we came from, flagged as saved' );
  934. unlike( $h{Location}, qr/\n/, 'and the message is one line, since it lands in a JS string' );
  935. _reindex();
  936. # Follow the redirect the way a browser would.
  937. my ($qs) = $h{Location} =~ m/\?(.*)$/;
  938. my %params = map { my ( $k, $v ) = split( /=/, $_, 2 ); ( $k => URI::Escape::uri_unescape($v) ) } split( /&/, $qs );
  939. my ( $rcode, $body, $err ) = _render(
  940. _admin( route => '/specblog', has_query => 1, %params ),
  941. \&Trog::Routes::HTML::series,
  942. );
  943. is( $rcode, 200, 'the destination renders' ) or diag($err);
  944. like( $body, qr/var loginFailure = 0;/, 'the banner is in success mode' );
  945. like( $body, qr/Saved post &#39;Spec Feedback Child&#39;\./, 'and says what was saved' );
  946. # Nothing to navigate on to, so the banner must not bounce us anywhere.
  947. unlike( $body, qr/window\.location=/, 'and does not redirect onwards' );
  948. # A rejected save comes back the same way, in red.
  949. $res = Trog::Routes::HTML::post_save(
  950. _admin(
  951. route => '/post/save',
  952. method => 'POST',
  953. to => '/specblog',
  954. form => 'blog.tx',
  955. title => 'Spec Rejected Child',
  956. visibility => 'not-a-visibility',
  957. tags => ['specblog'],
  958. )
  959. );
  960. ( $code, $headers ) = @$res;
  961. %h = @{ $headers || [] };
  962. is( $code, 303, 'a rejected save redirects too, rather than dead-ending on a 400' );
  963. like( $h{Location}, qr{^/secure/specblog\?savefailed=}, 'flagged as failed' );
  964. like( URI::Escape::uri_unescape( $h{Location} ), qr/Not in enum list/, 'carrying the validator error' );
  965. ok( !_find_post('Spec Rejected Child'), 'and the bad post was not written' );
  966. ($qs) = $h{Location} =~ m/\?(.*)$/;
  967. %params = map { my ( $k, $v ) = split( /=/, $_, 2 ); ( $k => URI::Escape::uri_unescape($v) ) } split( /&/, $qs );
  968. ( $rcode, $body, $err ) = _render(
  969. _admin( route => '/specblog', has_query => 1, %params ),
  970. \&Trog::Routes::HTML::series,
  971. );
  972. is( $rcode, 200, 'the destination still renders' ) or diag($err);
  973. like( $body, qr/var loginFailure = 1;/, 'the banner is in failure mode' );
  974. like( $body, qr/Not in enum list/, 'and shows why' );
  975. };
  976. subtest 'the topbar did not silently overflow' => sub {
  977. my ( $code, $body, $err ) = _render( _anon( route => '/' ) );
  978. is( $code, 200, '/ renders' ) or diag($err);
  979. my @titles = _topbar_titles($body);
  980. # 2 seeded series (Series, About) + the 7 we built. _get_series() caps at
  981. # 10 (HTML.pm), so an eighth post type would start silently dropping one.
  982. is( scalar @titles, 9, 'every series we made is in the topbar' )
  983. or diag( 'topbar was: ' . join( ', ', @titles ) );
  984. cmp_ok( scalar @titles, '<=', 10, 'and we are not at the _get_series limit' );
  985. };
  986. subtest 'the tpsgi side effects stayed inert' => sub {
  987. cmp_ok( $TPSGI->{restarts}, '>', 0, 'post_save did try to signal a restart' );
  988. cmp_ok( $TPSGI->{callbacks}, '>', 0, 'and did queue post-close callbacks' );
  989. # We never run the queued callbacks, which is what keeps save_render and
  990. # invalidate_renders from ever firing.
  991. is_deeply( $TPSGI->{renders}, {}, 'no static renders were written' );
  992. is_deeply( $TPSGI->{invalidated}, [], 'and nothing was invalidated' );
  993. my @statics = glob('www/statics/*');
  994. is_deeply( \@statics, [], 'www/statics is empty' );
  995. };
  996. subtest 'the real repo was not touched' => sub {
  997. my %after = map { _snapshot("$REPO/$_") } qw{config data www/templates www/assets logs totp};
  998. my @changed = grep { ( $REPO_BEFORE{$_} // '' ) ne ( $after{$_} // '' ) } keys %after;
  999. my @removed = grep { !exists $after{$_} } keys %REPO_BEFORE;
  1000. is_deeply( [ sort @changed ], [], 'no repo file was added or modified' );
  1001. is_deeply( [ sort @removed ], [], 'and none were removed' );
  1002. ok( !-e "$REPO/www/templates/html/components/forms/spec_widget.tx", 'the wizard type is not in the repo' );
  1003. };
  1004. done_testing();