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

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333
  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 datasource-backed series searches and paginates' => sub {
  447. # The whole point of a datasource is that its posts are built rather than
  448. # stored, so nothing the datastore does to a query ever touches them. Stand
  449. # one up with enough guests to page through, and drive it through the real
  450. # route rather than calling the helpers.
  451. require Test::MockModule;
  452. require Trog::DataSource::Virt;
  453. my ( $code, $body, $err ) = _render(
  454. _admin(
  455. route => '/admin/wyzzerdd/save',
  456. method => 'POST',
  457. name => 'spec_guests',
  458. datasource => 'Trog::DataSource::Virt',
  459. body_form => 'form_common.tx',
  460. wrapper => 1,
  461. inc_post_title => 1,
  462. display => q{<div class="guest"><: $post.title :> is <: $post.state :></div>},
  463. ),
  464. \&Trog::Routes::HTML::post_wizard_save,
  465. );
  466. is( $code, 200, 'the datasource-backed type was created' ) or diag($err);
  467. _reindex();
  468. my $series = _make_series( 'spec_guests', 'specguests', 'spec_guests.tx', 'Spec Guests Series', no_topbar => 1 ) or return;
  469. # Twelve guests, every one stamped with the same created -- which is what
  470. # libvirt guests really are, and precisely what the cursor paginator cannot
  471. # page through.
  472. my $built = time();
  473. my $virt = Test::MockModule->new('Trog::DataSource::Virt');
  474. $virt->redefine(
  475. posts => sub {
  476. my ( $s, $q ) = @_;
  477. return map {
  478. {
  479. id => "guest-$_",
  480. title => sprintf( 'guest%02d', $_ ),
  481. form => $s->{child_form},
  482. data => '',
  483. state => $_ % 2 ? 'running' : 'shut off',
  484. local_href => "/guest/hv/guest$_",
  485. href => '',
  486. tags => $s->{tags} // [],
  487. visibility => $s->{visibility} // 'private',
  488. created => $built,
  489. version => 0,
  490. user => $s->{user},
  491. method => 'GET',
  492. }
  493. } 1 .. 12;
  494. }
  495. );
  496. my $page_of = sub {
  497. my (%q) = @_;
  498. my ( $c, $b, $e ) = _render( _anon( route => '/specguests', %q ), \&Trog::Routes::HTML::series );
  499. is( $c, 200, 'guests page renders' ) or diag($e);
  500. return $b // '';
  501. };
  502. my $titles = sub {
  503. my ($html) = @_;
  504. return [ $html =~ m{<div class="guest">(guest\d+) is}g ];
  505. };
  506. my $first = $page_of->( limit => 5 );
  507. is_deeply( $titles->($first), [qw{guest01 guest02 guest03 guest04 guest05}], 'the first page holds the first five, in a settled order' );
  508. like( $first, qr/Page 1 of 3/, 'and says which page it is' );
  509. like( $first, qr{href="\?page=2&limit=5}, 'offering the next one' );
  510. unlike( $first, qr/rel="prev"/, 'and no previous one' );
  511. my $second = $page_of->( limit => 5, page => 2 );
  512. is_deeply( $titles->($second), [qw{guest06 guest07 guest08 guest09 guest10}], 'the second page carries on where the first stopped' );
  513. like( $second, qr/Page 2 of 3/, 'and says so' );
  514. my $third = $page_of->( limit => 5, page => 3 );
  515. is_deeply( $titles->($third), [qw{guest11 guest12}], 'the last page holds the remainder' );
  516. unlike( $third, qr/rel="next"/, 'and offers nothing after it' );
  517. # The cursor paginator would be worse than useless here: every guest shares
  518. # a created, so Prev would ask for everything older than that one instant.
  519. unlike( $first, qr/older=$built/, 'no cursor is offered on a page that cannot use one' );
  520. # Search, which before this reached the datastore and was thrown away along
  521. # with the posts it filtered.
  522. my $searched = $page_of->( limit => 25, like => 'guest1' );
  523. is_deeply( $titles->($searched), [qw{guest10 guest11 guest12}], 'searching a datasource page searches the page' );
  524. # Virt searches what its posts carry, not just a title and an empty body.
  525. my $by_state = $page_of->( limit => 25, like => 'shut' );
  526. is_deeply( $titles->($by_state), [qw{guest02 guest04 guest06 guest08 guest10 guest12}], 'including a field only it knows about' );
  527. # And the two compose, which is what a reader paging through a search does.
  528. my $searched_page = $page_of->( limit => 4, like => 'shut', page => 2 );
  529. is_deeply( $titles->($searched_page), [qw{guest10 guest12}], 'paging through a search stays inside it' );
  530. like( $searched_page, qr/Page 2 of 2/, 'and pages against the matches, not everything' );
  531. like( $searched_page, qr/like=shut/, 'carrying the search into the links' );
  532. };
  533. subtest 'an ordinary series survives a page number in its URL' => sub {
  534. # series() looks its own post up with the reader's query, so a ?page= meant
  535. # for the children used to page the lookup of the series itself -- page two
  536. # of one post being nothing, the series could not find itself and 404'd on
  537. # its own page. Latent until the datasource paginator started emitting page
  538. # numbers, and it was never about datasources.
  539. _reindex();
  540. _make_series( 'spec_paged', 'specpaged', 'blog.tx', 'Spec Paged Series', no_topbar => 1 ) or return;
  541. foreach my $n ( 1, 2 ) {
  542. _save_post(
  543. "spec_paged child $n",
  544. form => 'blog.tx',
  545. title => "Spec Paged Child $n",
  546. data => "child $n body",
  547. visibility => 'public',
  548. tags => ['specpaged'],
  549. to => '/specpaged',
  550. ) or return;
  551. }
  552. # One child a page, so page two exists and holds the other one.
  553. my ( $code, $body, $err ) = _render( _anon( route => '/specpaged', limit => 1, page => 2 ), \&Trog::Routes::HTML::series );
  554. is( $code, 200, 'a series page with ?page=2 still finds its series' ) or diag($err);
  555. like( $body, qr/Spec Paged Series/, 'and is the right one' );
  556. ( $code, $body, $err ) = _render( _anon( route => '/specpaged', limit => 1, page => 1 ), \&Trog::Routes::HTML::series );
  557. is( $code, 200, 'as does page one' ) or diag($err);
  558. # A stored series still pages by cursor, not by number: nothing about this
  559. # fix moves it onto the datasource paginator.
  560. unlike( $body, qr/Page 1 of/, 'and it still pages by cursor rather than by number' );
  561. };
  562. subtest 'a field can be declared indexed' => sub {
  563. my ( $code, $body, $err ) = _render(
  564. _admin(
  565. route => '/admin/wyzzerdd/save',
  566. method => 'POST',
  567. name => 'spec_indexed',
  568. body_form => 'form_common.tx',
  569. wrapper => 1,
  570. inc_post_title => 1,
  571. # The middle row is the one that matters: its box is clear, and the
  572. # wizard zips these arrays together positionally, so if a clear box
  573. # ever submitted nothing the flag would land on the wrong field.
  574. param_name => [ 'cook_time', 'garnish', 'serves' ],
  575. param_type => [ 'text', 'text', 'number' ],
  576. param_label => [ 'Cook Time', 'Garnish', 'Serves' ],
  577. param_placeholder => [ '', '', '' ],
  578. param_required => [ 0, 0, 0 ],
  579. param_private => [ 0, 0, 0 ],
  580. param_indexed => [ 1, 0, 1 ],
  581. param_relation_form => [ 'blog.tx', 'blog.tx', 'blog.tx' ],
  582. param_relation_mode => [ 'one', 'one', 'one' ],
  583. display => q{<div class="ct"><: $post.cook_time :></div>},
  584. ),
  585. \&Trog::Routes::HTML::post_wizard_save,
  586. );
  587. is( $code, 200, 'the type was created' ) or diag($err);
  588. my $sidecar = JSON::MaybeXS::decode_json( Path::Tiny->new('www/templates/html/components/forms/spec_indexed.json')->slurp_utf8 );
  589. ok( $sidecar->{properties}{cook_time}{'x-tcms-indexed'}, 'the ticked field is marked indexed' );
  590. ok( $sidecar->{properties}{serves}{'x-tcms-indexed'}, 'and so is the one after the clear box' );
  591. ok( !exists $sidecar->{properties}{garnish}{'x-tcms-indexed'}, 'the field between them is not' );
  592. ok( !exists $sidecar->{properties}{cook_time}{'x-tcms-private'}, 'and indexing is not privacy' );
  593. is_deeply(
  594. Trog::DataModule::indexed_fields_for('spec_indexed.tx'),
  595. [ sort qw{cook_time serves} ],
  596. 'and the model reads them back out of the sidecar'
  597. );
  598. SKIP: {
  599. skip( "the $MODEL model has nothing to index with", 3 ) unless $MODEL eq 'SQLite';
  600. my $dbh = Trog::SQLite::dbh( undef, 'data/posts.sqlite' );
  601. my %columns = map { $_->{name} => 1 } @{ $dbh->selectall_arrayref( 'PRAGMA table_xinfo(posts)', { Slice => {} } ) };
  602. my %indexes = map { $_->{name} => 1 } @{ $dbh->selectall_arrayref( "SELECT name FROM sqlite_master WHERE type='index' AND tbl_name='posts'", { Slice => {} } ) };
  603. ok( $columns{cook_time}, 'saving the type gave the ticked field a column' );
  604. ok( $indexes{'posts_custom_cook_time'}, 'and an index' );
  605. ok( !$indexes{'posts_custom_garnish'}, 'and left the unticked one alone' );
  606. }
  607. # A post of the type still saves and reads back the same as any other.
  608. _reindex();
  609. _make_series( 'spec_indexed', 'specindexed', 'spec_indexed.tx', 'Spec Indexed Series', no_topbar => 1 ) or return;
  610. my $child = _save_post(
  611. 'spec_indexed child',
  612. form => 'spec_indexed.tx',
  613. title => 'Spec Indexed Child',
  614. cook_time => '45 minutes',
  615. garnish => 'parsley',
  616. visibility => 'public',
  617. tags => ['specindexed'],
  618. to => '/specindexed',
  619. ) or return;
  620. is( $child->{cook_time}, '45 minutes', 'an indexed field stores like any other' );
  621. is( $child->{garnish}, 'parsley', 'and so does the one beside it' );
  622. };
  623. subtest 'a field can be declared editors-only' => sub {
  624. my ( $code, $body, $err ) = _render(
  625. _admin(
  626. route => '/admin/wyzzerdd/save',
  627. method => 'POST',
  628. name => 'spec_secretive',
  629. body_form => 'form_common.tx',
  630. wrapper => 1,
  631. inc_post_title => 1,
  632. inc_tags => 1,
  633. param_name => [ 'shown', 'hidden' ],
  634. param_type => [ 'text', 'text' ],
  635. param_label => [ 'Shown', 'Hidden' ],
  636. param_placeholder => [ '', '' ],
  637. param_required => [ 0, 0 ],
  638. param_private => [ 0, 1 ],
  639. param_relation_form => [ 'blog.tx', 'blog.tx' ],
  640. param_relation_mode => [ 'one', 'one' ],
  641. # Deliberately unguarded: declaring the field private is supposed
  642. # to be enough, so an author does not have to remember.
  643. display => q{<div class="s"><: $post.shown :></div><div class="h"><: $post.hidden :></div>},
  644. ),
  645. \&Trog::Routes::HTML::post_wizard_save,
  646. );
  647. is( $code, 200, 'the type was created' ) or diag($err);
  648. my $sidecar = JSON::MaybeXS::decode_json( Path::Tiny->new('www/templates/html/components/forms/spec_secretive.json')->slurp_utf8 );
  649. ok( $sidecar->{properties}{hidden}{'x-tcms-private'}, 'the private field is marked so' );
  650. ok( !exists $sidecar->{properties}{shown}{'x-tcms-private'}, 'and a public one carries no flag at all' );
  651. _reindex();
  652. _make_series( 'spec_secretive', 'specsecretive', 'spec_secretive.tx', 'Spec Secretive Series', no_topbar => 1 ) or return;
  653. my $child = _save_post(
  654. 'spec_secretive child',
  655. form => 'spec_secretive.tx',
  656. title => 'Spec Secretive Child',
  657. shown => 'public value',
  658. hidden => 'private value',
  659. visibility => 'public',
  660. tags => ['specsecretive'],
  661. to => '/specsecretive',
  662. ) or return;
  663. is( $child->{hidden}, 'private value', 'the value is stored like any other' );
  664. # An editor sees both.
  665. my ( $acode, $abody ) = _render( _admin( route => '/specsecretive' ), \&Trog::Routes::HTML::series );
  666. is( $acode, 200, 'the series renders for an admin' );
  667. like( $abody, qr{<div class="h">private value</div>}, 'who sees the private field' );
  668. # A logged out reader sees only the public one, without the template
  669. # having guarded anything.
  670. my ( $ncode, $nbody ) = _render( _anon( route => '/specsecretive' ), \&Trog::Routes::HTML::series );
  671. is( $ncode, 200, 'and for everyone else' );
  672. like( $nbody, qr{<div class="s">public value</div>}, 'who still sees the public field' );
  673. unlike( $nbody, qr/private value/, 'but not the private one' );
  674. };
  675. #--------------------------------------------------------------------------
  676. # The matrix.
  677. #
  678. # Per type: build a topbar series whose child_form is that type, check it shows
  679. # up in the nav, add a child post, check the child renders on the series page.
  680. #
  681. # Everything is verified ANONYMOUSLY. can_edit is then false, so the editor
  682. # half of each form never renders and a title appears exactly once -- which is
  683. # what makes like($body, qr/$title/) mean anything. It also sidesteps the
  684. # /secure prefixing that both _post_helper and categories.tx apply when a user
  685. # is set.
  686. #--------------------------------------------------------------------------
  687. sub _make_series {
  688. my ( $label, $aclname, $child_form, $title, %opt ) = @_;
  689. # _get_series caps the bar at 10 and the seeds already use two, so only the
  690. # series whose topbar behaviour we actually care about get tagged.
  691. my @tags = $opt{no_topbar} ? ('series') : ( 'series', 'topbar' );
  692. my $series = _save_post(
  693. "$label series",
  694. form => 'series.tx',
  695. title => $title,
  696. aclname => $aclname, # required by series.json
  697. child_form => $child_form, # required by series.json
  698. local_href => "/$aclname",
  699. href => "/$aclname",
  700. data => "$title subhead",
  701. callback => 'Trog::Routes::HTML::series',
  702. visibility => 'public',
  703. tags => \@tags,
  704. tiled => 0,
  705. to => '/',
  706. ) or return undef;
  707. return $series if $opt{no_topbar};
  708. # The topbar comes from _get_series(), which index() renders through
  709. # categories.tx. Check it on / -- the series has no children yet, and
  710. # posts() 404s on an empty series.
  711. my ( $code, $body, $err ) = _render( _anon( route => '/' ) );
  712. is( $code, 200, "$label: / renders" ) or diag($err);
  713. my @titles = _topbar_titles($body);
  714. ok( ( grep { $_ eq $title } @titles ), "$label: series is in the topbar" )
  715. or diag( 'topbar was: ' . join( ', ', @titles ) );
  716. return $series;
  717. }
  718. sub _series_page {
  719. my ( $label, $aclname, $series_title, $expected_posts ) = @_;
  720. my ( $code, $body, $err ) = _render( _anon( route => "/$aclname" ), \&Trog::Routes::HTML::series );
  721. is( $code, 200, "$label: series page renders" ) or do { diag($err); return '' };
  722. like( $body, qr{<title>[^<]*\Q$series_title\E}, "$label: series page is the right series" );
  723. is( _post_count($body), $expected_posts, "$label: exactly $expected_posts post(s) listed" )
  724. or diag( _kontent($body) );
  725. return $body;
  726. }
  727. # Entities first: the invoice type resolves payee/payor against existing public
  728. # entities.tx posts, so those have to be in the datastore before we get there.
  729. our ( $PAYEE, $PAYOR );
  730. subtest 'entities' => sub {
  731. my $title = 'Spec Entities Series';
  732. _make_series( 'entities', 'specentities', 'entities.tx', $title ) or return;
  733. $PAYEE = _save_post(
  734. 'entities payee child',
  735. form => 'entities.tx',
  736. title => 'Spec Payee Entity',
  737. data => 'Acme Payments LLC, 1 Road, Metropolis',
  738. payment_method => 'ACH',
  739. payment_details => 'Routing 0000 Account 1111',
  740. visibility => 'public',
  741. tags => ['specentities'],
  742. to => '/specentities',
  743. ) or return;
  744. $PAYOR = _save_post(
  745. 'entities payor child',
  746. form => 'entities.tx',
  747. title => 'Spec Payor Entity',
  748. data => 'Wile E Coyote, PO Box 9',
  749. payment_method => 'Carrier Pigeon',
  750. payment_details => 'none',
  751. visibility => 'public',
  752. tags => ['specentities'],
  753. to => '/specentities',
  754. ) or return;
  755. my $body = _series_page( 'entities', 'specentities', $title, 2 ) or return;
  756. like( $body, qr{id="postData-\Q$PAYEE->{id}\E"}, 'payee body rendered' );
  757. like( $body, qr/Acme Payments LLC/, 'payee data rendered' );
  758. like( $body, qr/Wile E Coyote/, 'payor data rendered' );
  759. # entity_details.tx is included only in the editor half, so these are stored
  760. # but never displayed. Pinning that so a template change is noticed.
  761. unlike( $body, qr/Carrier Pigeon/, 'payment details are not shown to anonymous readers' );
  762. is( _find_post('Spec Payee Entity')->{payment_method}, 'ACH', 'but payment_method did survive the schema' );
  763. };
  764. subtest 'blog' => sub {
  765. my $title = 'Spec Blog Series';
  766. _make_series( 'blog', 'specblog', 'blog.tx', $title ) or return;
  767. my $child = _save_post(
  768. 'blog child',
  769. form => 'blog.tx',
  770. title => 'Spec Blog Child',
  771. data => 'Spec blog body text.',
  772. visibility => 'public',
  773. tags => ['specblog'],
  774. to => '/specblog',
  775. ) or return;
  776. my $body = _series_page( 'blog', 'specblog', $title, 1 ) or return;
  777. like( $body, qr/Spec Blog Child/, 'child title rendered' );
  778. like( $body, qr{href='/posts/\Q$child->{id}\E'}, 'child permalink rendered' );
  779. like( $body, qr{id="postData-\Q$child->{id}\E"}, 'child body block rendered' );
  780. like( $body, qr/Spec blog body text\./, 'child body text rendered' );
  781. unlike( $body, qr/Spec Payee Entity/, 'no bleed from the entities series' );
  782. };
  783. subtest 'microblog' => sub {
  784. my $title = 'Spec Microblog Series';
  785. _make_series( 'microblog', 'specmicroblog', 'microblog.tx', $title ) or return;
  786. my $child = _save_post(
  787. 'microblog child',
  788. form => 'microblog.tx',
  789. title => 'Spec Microblog Child',
  790. href => 'https://example.com/spec',
  791. data => 'Spec microblog body.',
  792. visibility => 'public',
  793. tags => ['specmicroblog'],
  794. to => '/specmicroblog',
  795. ) or return;
  796. my $body = _series_page( 'microblog', 'specmicroblog', $title, 1 ) or return;
  797. like( $body, qr{href='https://example\.com/spec' >Spec Microblog Child</a>}, 'title links out to href' );
  798. like( $body, qr{id="postData-\Q$child->{id}\E"}, 'body block rendered' );
  799. like( $body, qr/Spec microblog body\./, 'body text rendered' );
  800. };
  801. subtest 'file' => sub {
  802. my $title = 'Spec File Series';
  803. _make_series( 'file', 'specfile', 'file.tx', $title ) or return;
  804. # _handle_upload MOVES the file, so it has to be created fresh here.
  805. my $src = "$ROOT/upload-src/spec-upload.txt";
  806. open( my $fh, '>', $src ) or die $!;
  807. print {$fh} "spec upload contents\n";
  808. close $fh;
  809. my $child = _save_post(
  810. 'file child',
  811. form => 'file.tx',
  812. title => 'Spec File Child',
  813. data => 'Spec file body.',
  814. file => { tempname => $src, filename => 'spec-upload.txt' },
  815. visibility => 'public',
  816. tags => ['specfile'],
  817. to => '/specfile',
  818. ) or return;
  819. ok( !-e $src, 'the upload was moved out of its temp location, not copied' );
  820. ok( -f "www/assets/$child->{id}.spec-upload.txt", 'and it landed in www/assets' );
  821. my $body = _series_page( 'file', 'specfile', $title, 1 ) or return;
  822. like( $body, qr{href='/assets/\Q$child->{id}\E\.spec-upload\.txt'}, 'title links to the asset' );
  823. like( $body, qr{id="postData-\Q$child->{id}\E"}, 'body block carries a unique id, like every other form' );
  824. like( $body, qr/Spec file body\./, 'body text rendered' );
  825. # This form used to emit <div class="postData" id="postData" class="responsive-text">
  826. # -- a duplicated class attribute, and an id shared by every file post on
  827. # the page. Neither should come back.
  828. unlike( $body, qr{<div class="postData" id="postData"}, 'no duplicated class attribute' );
  829. # text/plain, so none of the media branches fire.
  830. unlike( $body, qr/<video/, 'no video block for a text file' );
  831. unlike( $body, qr/<audio/, 'no audio block either' );
  832. };
  833. subtest 'presentation' => sub {
  834. my $title = 'Spec Presentation Series';
  835. _make_series( 'presentation', 'specpresentation', 'presentation.tx', $title ) or return;
  836. my $child = _save_post(
  837. 'presentation child',
  838. form => 'presentation.tx',
  839. title => 'Spec Presentation Child',
  840. data => [ 'Slide one body.', 'Slide two body.' ],
  841. data_is_array => 1,
  842. visibility => 'public',
  843. tags => ['specpresentation'],
  844. to => '/specpresentation',
  845. ) or return;
  846. is_deeply( $child->{data}, [ 'Slide one body.', 'Slide two body.' ], 'the multi-page data round-tripped as an array' );
  847. my $body = _series_page( 'presentation', 'specpresentation', $title, 1 ) or return;
  848. # Slides only render under nochrome; the series page just links to the deck.
  849. like( $body, qr{<a href="/posts/\Q$child->{id}\E\?embed=1&nochrome=1">Click Here to view</a>}, 'deck link rendered' );
  850. unlike( $body, qr/Slide one body\./, 'slides themselves are not rendered inline' );
  851. };
  852. subtest 'invoice' => sub {
  853. my $title = 'Spec Invoice Series';
  854. _make_series( 'invoice', 'specinvoice', 'invoice.tx', $title ) or return;
  855. my $child = _save_post(
  856. 'invoice child',
  857. form => 'invoice.tx',
  858. title => 'Spec Invoice Child',
  859. data => [ "Widget assembly\nPrice: \$420", "Shipping\nPrice: \$80" ],
  860. data_is_array => 1,
  861. payee => $PAYEE->{id},
  862. payor => $PAYOR->{id},
  863. due_days => 30,
  864. visibility => 'public',
  865. tags => ['specinvoice'],
  866. to => '/specinvoice',
  867. ) or return;
  868. my $body = _series_page( 'invoice', 'specinvoice', $title, 1 ) or return;
  869. like( $body, qr/Invoice ID# \Q$child->{id}\E/, 'invoice header rendered' );
  870. # These two only resolve because the entities subtest ran first and left
  871. # public entities.tx posts behind for the enrich hook to find.
  872. like( $body, qr/Acme Payments LLC/, 'payee entity resolved' );
  873. like( $body, qr/Wile E Coyote/, 'payor entity resolved' );
  874. like( $body, qr/ACH/, 'payee payment method pulled through' );
  875. like( $body, qr/Widget assembly/, 'line items rendered' );
  876. like( $body, qr/Total: \$500/, 'total summed from the line item prices' );
  877. };
  878. subtest 'spec_widget (the wizard-built type)' => sub {
  879. my $title = 'Spec Widget Series';
  880. _make_series( 'spec_widget', 'specwidget', 'spec_widget.tx', $title ) or return;
  881. my $child = _save_post(
  882. 'spec_widget child',
  883. form => 'spec_widget.tx',
  884. title => 'Spec Widget Child',
  885. data => 'Spec widget body.',
  886. flavor => 'Strawberry',
  887. bogus_field => 'nope',
  888. visibility => 'public',
  889. tags => ['specwidget'],
  890. to => '/specwidget',
  891. ) or return;
  892. is( $child->{flavor}, 'Strawberry', 'the custom field survived validation' );
  893. ok( !exists $child->{bogus_field}, 'an undeclared field was still stripped' );
  894. my $body = _series_page( 'spec_widget', 'specwidget', $title, 1 ) or return;
  895. # The payoff: this can only render if the wizard wrote spec_widget.json,
  896. # schema_for merged it over the base post schema, and validate() therefore
  897. # kept 'flavor' instead of deleting it as an unknown key.
  898. like( $body, qr{<span class="spec-flavor">Strawberry</span>}, 'the custom field rendered on the page' );
  899. like( $body, qr/Spec widget body\./, 'and the body came through the generated template' );
  900. };
  901. subtest 'a wizard-built type can depend on another type' => sub {
  902. # The type we will point at. The relation is what is under test, so keep
  903. # the target itself boring.
  904. my ( $code, $body, $err ) = _render(
  905. _admin(
  906. route => '/admin/wyzzerdd/save',
  907. method => 'POST',
  908. name => 'spec_target',
  909. body_form => 'form_common.tx',
  910. wrapper => 1,
  911. inc_post_title => 1,
  912. inc_title_input => 1,
  913. inc_visibility => 1,
  914. inc_tags => 1,
  915. display => q{<div><: render_it($post.data) | mark_raw :></div>},
  916. ),
  917. \&Trog::Routes::HTML::post_wizard_save,
  918. );
  919. is( $code, 200, 'target type created' ) or diag($err);
  920. # ...and the type that depends on it: one picked by id, one pulling in the
  921. # whole set.
  922. ( $code, $body, $err ) = _render(
  923. _admin(
  924. route => '/admin/wyzzerdd/save',
  925. method => 'POST',
  926. name => 'spec_relator',
  927. body_form => 'form_common.tx',
  928. wrapper => 1,
  929. inc_post_title => 1,
  930. inc_title_input => 1,
  931. inc_visibility => 1,
  932. inc_tags => 1,
  933. param_name => [ 'chosen', 'everything' ],
  934. param_type => [ 'relation', 'relation' ],
  935. param_label => [ 'Chosen One', 'All Of Them' ],
  936. param_placeholder => [ '', '' ],
  937. param_required => [ 0, 0 ],
  938. param_relation_form => [ 'spec_target.tx', 'spec_target.tx' ],
  939. param_relation_mode => [ 'one', 'all' ],
  940. 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>},
  941. ),
  942. \&Trog::Routes::HTML::post_wizard_save,
  943. );
  944. is( $code, 200, 'relating type created' ) or diag($err);
  945. my $sidecar = JSON::MaybeXS::decode_json( Path::Tiny->new('www/templates/html/components/forms/spec_relator.json')->slurp_utf8 );
  946. # 'one' is a field the post stores; 'all' is not a field at all.
  947. is( $sidecar->{properties}{chosen}{type}, 'relation', 'the picked relation is a stored property' );
  948. is( $sidecar->{properties}{chosen}{'x-tcms-relation-form'}, 'spec_target.tx', 'naming its target type' );
  949. ok( !exists $sidecar->{properties}{everything}, "the 'all' relation stores nothing" );
  950. is_deeply(
  951. $sidecar->{'x-tcms-relations'},
  952. {
  953. chosen_post => { form => 'spec_target.tx', from => 'chosen' },
  954. everything => { form => 'spec_target.tx' },
  955. },
  956. 'and both are declared for resolution at render'
  957. );
  958. # The relation pseudo-type has to become a real one before validation, or
  959. # every relation field would be stripped as an unknown type.
  960. is(
  961. Trog::DataModule::schema_for('spec_relator.tx')->{properties}{chosen}{type},
  962. 'string', "'relation' expands to a real schema type"
  963. );
  964. _reindex();
  965. # Now exercise it end to end.
  966. _make_series( 'spec_target', 'spectarget', 'spec_target.tx', 'Spec Target Series', no_topbar => 1 ) or return;
  967. my $target = _save_post(
  968. 'spec_target child',
  969. form => 'spec_target.tx',
  970. title => 'Spec Target Post',
  971. data => 'Spec target body.',
  972. visibility => 'public',
  973. tags => ['spectarget'],
  974. to => '/spectarget',
  975. ) or return;
  976. _make_series( 'spec_relator', 'specrelator', 'spec_relator.tx', 'Spec Relator Series', no_topbar => 1 ) or return;
  977. my $relator = _save_post(
  978. 'spec_relator child',
  979. form => 'spec_relator.tx',
  980. title => 'Spec Relator Post',
  981. data => 'Spec relator body.',
  982. chosen => $target->{id},
  983. visibility => 'public',
  984. tags => ['specrelator'],
  985. to => '/specrelator',
  986. ) or return;
  987. is( $relator->{chosen}, $target->{id}, 'the referenced id survived validation' );
  988. my $page = _series_page( 'spec_relator', 'specrelator', 'Spec Relator Series', 1 ) or return;
  989. # Both halves of the relation resolved: the one we picked, and the set.
  990. like( $page, qr{<span class="chosen">Spec Target Post</span>}, 'the picked post resolved into the page' );
  991. like( $page, qr{<span class="each">Spec Target Post</span>}, 'and so did the whole set' );
  992. };
  993. subtest '/api/posts_of_form feeds the relation picker' => sub {
  994. my $target = _find_post('Spec Target Post');
  995. ok( $target, 'the target post is there to be listed' ) or return;
  996. my $res = Trog::Routes::JSON::posts_of_form( _admin( route => '/api/posts_of_form', form => 'spec_target.tx' ) );
  997. is( ref $res, 'ARRAY', 'a PSGI response came back' ) or return;
  998. my ( $code, undef, $body ) = @$res;
  999. is( $code, 200, 'and it is a 200' );
  1000. my $payload = JSON::MaybeXS::decode_json( join( '', @$body ) );
  1001. is_deeply(
  1002. $payload->{posts},
  1003. [ { id => $target->{id}, title => 'Spec Target Post' } ],
  1004. 'listing exactly the posts of that type, id and title only'
  1005. );
  1006. # An unknown type is an empty list, not an error -- a type with no posts
  1007. # yet is the normal state of affairs right after you create it.
  1008. $res = Trog::Routes::JSON::posts_of_form( _admin( route => '/api/posts_of_form', form => 'nosuchtype.tx' ) );
  1009. $payload = JSON::MaybeXS::decode_json( join( '', @{ $res->[2] } ) );
  1010. is_deeply( $payload->{posts}, [], 'an unknown type lists nothing rather than failing' );
  1011. # The route's own declaration is what keeps a malformed form out; check it
  1012. # matches what series.json demands of child_form.
  1013. my $validator = $Trog::Routes::JSON::routes{'/api/posts_of_form'}{parameters}{form};
  1014. ok( $validator->('blog.tx'), 'the parameter validator accepts a form name' );
  1015. ok( !$validator->('../../etc/passwd'), 'and rejects a path' );
  1016. ok( $Trog::Routes::JSON::routes{'/api/posts_of_form'}{auth}, 'the route requires a login' );
  1017. };
  1018. subtest 'a series resolves its relations for logged out visitors too' => sub {
  1019. # The relations series() resolves land on the primary post, which is what a
  1020. # datasource reads to find its hypervisors -- so assert on that rather than
  1021. # on the rendered children, whose relations posts() resolves later, after
  1022. # it has widened user_acls and thus by a path that was never broken.
  1023. foreach my $case ( [ 'anonymously', _anon( route => '/specrelator' ) ], [ 'as an admin', _admin( route => '/specrelator' ) ] ) {
  1024. my ( $label, $query ) = @$case;
  1025. my ( $code, undef, $err ) = _render( $query, \&Trog::Routes::HTML::series );
  1026. is( $code, 200, "the series renders $label" ) or do { diag($err); next };
  1027. my $resolved = $query->{primary_post}{everything};
  1028. is( ref $resolved, 'ARRAY', "$label, the series' own relation resolved" );
  1029. cmp_ok( scalar @{ $resolved || [] }, '>', 0, "$label, to something rather than nothing" );
  1030. }
  1031. };
  1032. subtest 'saves report back through the jsalert banner' => sub {
  1033. # A good save redirects to where you came from, carrying the outcome.
  1034. my $res = Trog::Routes::HTML::post_save(
  1035. _admin(
  1036. route => '/post/save',
  1037. method => 'POST',
  1038. to => '/specblog',
  1039. form => 'blog.tx',
  1040. title => 'Spec Feedback Child',
  1041. data => 'Spec feedback body.',
  1042. visibility => 'public',
  1043. tags => ['specblog'],
  1044. )
  1045. );
  1046. my ( $code, $headers ) = @$res;
  1047. my %h = @{ $headers || [] };
  1048. is( $code, 303, 'a good save redirects' );
  1049. like( $h{Location}, qr{^/secure/specblog\?saved=}, 'to where we came from, flagged as saved' );
  1050. unlike( $h{Location}, qr/\n/, 'and the message is one line, since it lands in a JS string' );
  1051. _reindex();
  1052. # Follow the redirect the way a browser would.
  1053. my ($qs) = $h{Location} =~ m/\?(.*)$/;
  1054. my %params = map { my ( $k, $v ) = split( /=/, $_, 2 ); ( $k => URI::Escape::uri_unescape($v) ) } split( /&/, $qs );
  1055. my ( $rcode, $body, $err ) = _render(
  1056. _admin( route => '/specblog', has_query => 1, %params ),
  1057. \&Trog::Routes::HTML::series,
  1058. );
  1059. is( $rcode, 200, 'the destination renders' ) or diag($err);
  1060. like( $body, qr/var loginFailure = 0;/, 'the banner is in success mode' );
  1061. like( $body, qr/Saved post &#39;Spec Feedback Child&#39;\./, 'and says what was saved' );
  1062. # Nothing to navigate on to, so the banner must not bounce us anywhere.
  1063. unlike( $body, qr/window\.location=/, 'and does not redirect onwards' );
  1064. # A rejected save comes back the same way, in red.
  1065. $res = Trog::Routes::HTML::post_save(
  1066. _admin(
  1067. route => '/post/save',
  1068. method => 'POST',
  1069. to => '/specblog',
  1070. form => 'blog.tx',
  1071. title => 'Spec Rejected Child',
  1072. visibility => 'not-a-visibility',
  1073. tags => ['specblog'],
  1074. )
  1075. );
  1076. ( $code, $headers ) = @$res;
  1077. %h = @{ $headers || [] };
  1078. is( $code, 303, 'a rejected save redirects too, rather than dead-ending on a 400' );
  1079. like( $h{Location}, qr{^/secure/specblog\?savefailed=}, 'flagged as failed' );
  1080. like( URI::Escape::uri_unescape( $h{Location} ), qr/Not in enum list/, 'carrying the validator error' );
  1081. ok( !_find_post('Spec Rejected Child'), 'and the bad post was not written' );
  1082. ($qs) = $h{Location} =~ m/\?(.*)$/;
  1083. %params = map { my ( $k, $v ) = split( /=/, $_, 2 ); ( $k => URI::Escape::uri_unescape($v) ) } split( /&/, $qs );
  1084. ( $rcode, $body, $err ) = _render(
  1085. _admin( route => '/specblog', has_query => 1, %params ),
  1086. \&Trog::Routes::HTML::series,
  1087. );
  1088. is( $rcode, 200, 'the destination still renders' ) or diag($err);
  1089. like( $body, qr/var loginFailure = 1;/, 'the banner is in failure mode' );
  1090. like( $body, qr/Not in enum list/, 'and shows why' );
  1091. };
  1092. subtest 'the topbar did not silently overflow' => sub {
  1093. my ( $code, $body, $err ) = _render( _anon( route => '/' ) );
  1094. is( $code, 200, '/ renders' ) or diag($err);
  1095. my @titles = _topbar_titles($body);
  1096. # 2 seeded series (Series, About) + the 7 we built. _get_series() caps at
  1097. # 10 (HTML.pm), so an eighth post type would start silently dropping one.
  1098. is( scalar @titles, 9, 'every series we made is in the topbar' )
  1099. or diag( 'topbar was: ' . join( ', ', @titles ) );
  1100. cmp_ok( scalar @titles, '<=', 10, 'and we are not at the _get_series limit' );
  1101. };
  1102. subtest 'the tpsgi side effects stayed inert' => sub {
  1103. cmp_ok( $TPSGI->{restarts}, '>', 0, 'post_save did try to signal a restart' );
  1104. cmp_ok( $TPSGI->{callbacks}, '>', 0, 'and did queue post-close callbacks' );
  1105. # We never run the queued callbacks, which is what keeps save_render and
  1106. # invalidate_renders from ever firing.
  1107. is_deeply( $TPSGI->{renders}, {}, 'no static renders were written' );
  1108. is_deeply( $TPSGI->{invalidated}, [], 'and nothing was invalidated' );
  1109. my @statics = glob('www/statics/*');
  1110. is_deeply( \@statics, [], 'www/statics is empty' );
  1111. };
  1112. subtest 'the real repo was not touched' => sub {
  1113. my %after = map { _snapshot("$REPO/$_") } qw{config data www/templates www/assets logs totp};
  1114. my @changed = grep { ( $REPO_BEFORE{$_} // '' ) ne ( $after{$_} // '' ) } keys %after;
  1115. my @removed = grep { !exists $after{$_} } keys %REPO_BEFORE;
  1116. is_deeply( [ sort @changed ], [], 'no repo file was added or modified' );
  1117. is_deeply( [ sort @removed ], [], 'and none were removed' );
  1118. ok( !-e "$REPO/www/templates/html/components/forms/spec_widget.tx", 'the wizard type is not in the repo' );
  1119. };
  1120. done_testing();