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

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727
  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 5.040;
  10. use re '/aasx';
  11. use warnings FATAL => 'all';
  12. # FindBin MUST come first. $FindBin::Bin is derived from $0, which prove hands
  13. # us relatively, and it is computed once. chdir before this loads and every
  14. # module's `use FindBin::libs` resolves against the sandbox instead of the repo.
  15. use FindBin;
  16. use FindBin::libs;
  17. use Test::More;
  18. use Cwd ();
  19. use Encode ();
  20. use File::Copy ();
  21. use File::Find ();
  22. use File::Path ();
  23. use File::Temp ();
  24. use Time::HiRes ();
  25. use URI::Escape ();
  26. use JSON::MaybeXS ();
  27. use JSON::Validator ();
  28. use File::Slurper ();
  29. use File::Slurper::Temp ();
  30. our ( $REPO, $ROOT, $OLDCWD );
  31. our %REPO_BEFORE;
  32. # Which data model this run exercises. Every assertion in this file is about
  33. # what the app does, not how it stores anything, so all of them have to hold for
  34. # any of them.
  35. our $MODEL;
  36. # In BEGIN because the sandbox is built in one, before file scope runs.
  37. BEGIN { $MODEL = $ENV{TCMS_TEST_DATA_MODEL} || 'FlatFile' }
  38. # What time() answers in every module required below, so two saves can land on
  39. # different days; undef is the real clock.
  40. our $NOW;
  41. BEGIN {
  42. *CORE::GLOBAL::time = sub () { $NOW // CORE::time() }
  43. }
  44. # name => (size, mtime) for every file under the repo dirs this test could
  45. # plausibly disturb. Cheap enough, and it is the only real proof of isolation.
  46. state sub snapshot {
  47. my ($dir) = @_;
  48. my %seen;
  49. File::Find::find(
  50. {
  51. no_chdir => 1,
  52. wanted => sub {
  53. return unless -e $File::Find::name;
  54. return if -d _;
  55. my @st = stat(_);
  56. $seen{$File::Find::name} = "$st[7]:$st[9]";
  57. },
  58. },
  59. $dir
  60. );
  61. return %seen;
  62. }
  63. state sub copy_tree { ## no critic (ProhibitSingleUseLexicalSubs) -- 18 lines, which would overcomplicate the BEGIN block
  64. my ( $from, $to ) = @_;
  65. File::Path::make_path($to);
  66. File::Find::find(
  67. {
  68. no_chdir => 1,
  69. wanted => sub {
  70. my $rel = substr( $File::Find::name, length($from) );
  71. return unless $rel;
  72. my $dst = "$to$rel";
  73. if ( -d $File::Find::name ) { File::Path::make_path($dst) }
  74. elsif ( -e $File::Find::name ) { File::Copy::copy( $File::Find::name, $dst ) or die "copy $File::Find::name: $!" }
  75. },
  76. },
  77. $from
  78. );
  79. return;
  80. }
  81. # Everything the sandbox needs, in one BEGIN. The Trog:: modules are require()d
  82. # at runtime below, which is unconditionally after every BEGIN -- so no later
  83. # edit can accidentally load them before the chdir. That matters: TCMS.pm runs
  84. # build_routes() at file scope and FlatFile.pm reads the tag index at file
  85. # scope, both against whatever cwd happens to be current.
  86. BEGIN {
  87. $REPO = Cwd::abs_path("$FindBin::Bin/..");
  88. $OLDCWD = Cwd::getcwd();
  89. %REPO_BEFORE = map { snapshot("$REPO/$_") } qw{config data www/templates www/assets logs totp};
  90. $ROOT = File::Temp::tempdir( 'tcms-lifecycle-XXXXXX', TMPDIR => 1, CLEANUP => 0 );
  91. # Installer.mk's tree, plus upload-src for the file.tx fixture.
  92. File::Path::make_path(
  93. map { "$ROOT/$_" }
  94. qw{
  95. config schema data/files logs totp upload-src
  96. www/assets/private www/statics www/themes www/scripts
  97. }
  98. );
  99. # A real fresh install: get() looks for config/main.cfg, doesn't find one,
  100. # and falls through to the shipped default. The data model is the shipped
  101. # one unless the environment names another, which is how this whole file
  102. # gets run against each of them -- the point being that a data model is only
  103. # finished when the app cannot tell which one it is talking to.
  104. my $stock = File::Slurper::read_text("$REPO/config/default.cfg");
  105. $stock =~ s/^(\s*data_model=)\N*$/$1$MODEL/m or die "could not set the data model in default.cfg";
  106. File::Slurper::Temp::write_text( "$ROOT/config/default.cfg", $stock );
  107. # Hardcoded paths in Auth.pm, TagIndex.pm, the data models and Log.pm -- not negotiable.
  108. File::Copy::copy( "$REPO/schema/$_", "$ROOT/schema/$_" ) or die $! for qw{auth.schema flatfile.schema sqlite.schema log.schema};
  109. # COPY, don't symlink: post_wizard_save() writes into Trog::Themes::forms_dir(),
  110. # and a symlink would land the generated post type in the real repo.
  111. copy_tree( "$REPO/www/templates", "$ROOT/www/templates" );
  112. # posts.tx pulls in the EmojiPicker component for an editor, and EmojiPicker
  113. # dies outright if this file is missing. Only category and emoji are read.
  114. open( my $fh, '>', "$ROOT/www/scripts/list.min.json" ) or die $!;
  115. print {$fh} '{"emojis":[{"category":"Smileys","emoji":"X"}]}';
  116. close($fh) or die $!;
  117. # The vendored scripts are downloaded at install, so they are not in the
  118. # checkout; these stand in for them.
  119. File::Slurper::Temp::write_text( "$ROOT/www/scripts/reveal.min.js", "var Reveal = 'spec reveal';" );
  120. File::Slurper::Temp::write_text( "$ROOT/www/scripts/highlight.min.js", "var hljs = 'spec highlight';" );
  121. File::Copy::copy( "$REPO/www/scripts/$_", "$ROOT/www/scripts/$_" ) or die $! for qw{post.js post_relations.js post_wizard.js};
  122. # Text::Xslate computes its default cache dir from $HOME once, at load time.
  123. # Without this the sandbox writes compiled templates into the real ~/.xslate_cache.
  124. $ENV{HOME} = $ROOT;
  125. chdir($ROOT) or die "could not chdir to sandbox $ROOT: $!";
  126. }
  127. END {
  128. # Never rmtree the directory you are standing in.
  129. chdir($OLDCWD) if $OLDCWD;
  130. if ( $ENV{TCMS_TEST_KEEP} ) {
  131. diag("TCMS_TEST_KEEP set, sandbox left at $ROOT");
  132. }
  133. elsif ( $ROOT && -d $ROOT ) {
  134. # SQLite handles are file-lexical in Trog::SQLite and unreachable from
  135. # here; DBI disconnects at global destruction, after these are gone.
  136. eval { File::Path::remove_tree($ROOT); 1 } or diag("could not remove $ROOT: $@");
  137. }
  138. }
  139. diag("sandbox: $ROOT");
  140. require Trog::Log;
  141. Trog::Log::log_init( 'logs/tcms.log', 'info' ); # sets $LOGDIR, hence logs/log.db
  142. require Trog::Config;
  143. require Trog::Themes;
  144. require Trog::Data;
  145. require Trog::Auth;
  146. require Trog::SQLite::TagIndex if $MODEL eq 'FlatFile';
  147. require Trog::Routes::HTML;
  148. require Trog::Routes::JSON;
  149. #--------------------------------------------------------------------------
  150. # A stand-in for the tPSGI object the router injects as $query->{tpsgi}.
  151. #--------------------------------------------------------------------------
  152. {
  153. package Test::TPSGI;
  154. sub new {
  155. my ( $class, %args ) = @_;
  156. return bless {
  157. callbacks => 0,
  158. run_callbacks => 0,
  159. renders => {},
  160. invalidated => [],
  161. watches => [],
  162. restarts => 0,
  163. tpsgi_dir => Cwd::getcwd(),
  164. log_dir => 'logs',
  165. gid => "$)",
  166. verbose => 0,
  167. %args,
  168. }, $class;
  169. }
  170. sub INFO { return 1 }
  171. sub DEBUG { return 1 }
  172. sub WARN { return 1 }
  173. sub ERROR { return 1 }
  174. sub CRIT { return 1 }
  175. sub ALERT { return 1 }
  176. sub EMERG { return 1 }
  177. sub FATAL { return 1 }
  178. sub see_also ( $, $to, @ ) { return [ 303, [ 'Location' => $to, 'Content-Length' => 0 ], [''] ] }
  179. sub redirect ( $, $to, @ ) { return [ 302, [ 'Location' => $to, 'Content-Length' => 0 ], [''] ] }
  180. sub redirect_permanent ( $, $to, @ ) { return [ 301, [ 'Location' => $to, 'Content-Length' => 0 ], [''] ] }
  181. sub reply ( $, $code, $body = undef, @ ) { return [ $code, [ 'Content-type' => 'text/html' ], [ $body // '' ] ] }
  182. sub ok ( $self, $, $body = undef, @ ) { return $self->reply( 200, $body ) }
  183. sub notfound ( $self, $, $body = undef, @ ) { return $self->reply( 404, $body // 'Not Found' ) }
  184. sub forbidden ( $self, $, $body = undef, @ ) { return $self->reply( 403, $body // 'Forbidden' ) }
  185. sub badrequest ( $self, $, $body = undef, @ ) { return $self->reply( 400, $body // 'Bad Request' ) }
  186. sub error ( $self, $, $body = undef, @ ) { return $self->reply( 500, $body // 'Error' ) }
  187. sub serve { return [ 200, [], [''] ] }
  188. # These two must be inert.
  189. #
  190. # add_post_close_callback is the ONLY path by which Trog::Renderer and
  191. # post_save reach save_render()/invalidate_renders(). Dropping the callback
  192. # on the floor is what guarantees this test never writes into www/statics,
  193. # whatever the renderer's own skip-save logic decides.
  194. # ...unless a test explicitly asks, which is how the one test that is about
  195. # what gets cached gets to see it. Still nowhere near www/statics:
  196. # save_render below only records what it was handed.
  197. sub add_post_close_callback {
  198. my ( $self, $callback ) = @_;
  199. $self->{callbacks}++;
  200. $callback->() if $self->{run_callbacks} && ref $callback eq 'CODE';
  201. return 1;
  202. }
  203. # The real one is `kill 'HUP', getppid`. Under prove, that is prove.
  204. sub signal_restart_parent ( $self, @ ) { $self->{restarts}++; return 1 }
  205. # Recorded rather than inert: a datasource that watches something is
  206. # supposed to register here, and the lifecycle test is where we find out
  207. # whether it did through the real route.
  208. sub add_watch {
  209. my ( $self, $path, $callback, %options ) = @_;
  210. push( @{ $self->{watches} }, { path => $path, callback => $callback, %options } );
  211. return 1;
  212. }
  213. sub invalidate_renders ( $self, $what, @ ) { push @{ $self->{invalidated} }, $what; return 1 }
  214. sub invalidate_render ( $self, @what ) { push @{ $self->{invalidated} }, [@what]; return 1 }
  215. sub save_render ( $self, $route, $type, $content, @ ) { $self->{renders}{"$route:$type"} = $content; return 1 }
  216. }
  217. our $TPSGI = Test::TPSGI->new();
  218. our $ADMIN_USER = 'specadmin';
  219. our $ADMIN_DISPLAY = 'Spec Admin';
  220. our $ADMIN_EMAIL = 'specadmin@test.test';
  221. our $ADMIN_PASS = 'spec-password';
  222. #--------------------------------------------------------------------------
  223. # Harness
  224. #--------------------------------------------------------------------------
  225. # Always build a fresh query: posts() pushes onto user_acls, and series()
  226. # rewrites route/aclname/tag/in_series/primary_post in place.
  227. my sub query {
  228. my (%over) = @_;
  229. my %q = (
  230. route => '/',
  231. method => 'GET',
  232. scheme => 'http', # Renderer::Base compares this with no undef guard
  233. domain => 'tcms.test',
  234. start => [ Time::HiRes::gettimeofday() ], # tv_interval() dies on anything else
  235. deflate => 0,
  236. streaming => 0,
  237. ranges => [],
  238. last_fetched => undef,
  239. has_query => 0,
  240. social_meta => 0,
  241. acls => [],
  242. user_acls => [],
  243. body => undef,
  244. tpsgi => $TPSGI,
  245. %over,
  246. );
  247. $q{fullpath} //= $q{route};
  248. return \%q;
  249. }
  250. my sub anon (@args) { return query( user => undef, user_acls => [], @args ) }
  251. my sub admin (@args) { return query( user => $ADMIN_USER, user_acls => ['admin'], @args ) }
  252. # Returns ($code, $body, $error). Never dies, so one bad post type cannot take
  253. # the rest of the file with it -- which matters because a failed render inside
  254. # index() dies rather than returning a 500 (there is no www/templates/html/500.tx).
  255. my sub render {
  256. my ( $query, $how ) = @_;
  257. $how ||= \&Trog::Routes::HTML::index;
  258. my $res = eval { $how->($query) };
  259. return ( 0, '', "died: $@" ) if !$res;
  260. return ( 0, '', 'returned a ' . ( ref($res) || 'plain scalar' ) ) if ref $res ne 'ARRAY';
  261. my ( $code, $headers, $body ) = @$res;
  262. $body = ref $body eq 'ARRAY' ? join( '', @$body ) : ( $body // '' );
  263. return ( $code, Encode::decode_utf8($body), '', $headers );
  264. }
  265. # The pages that a stand-in tPSGI was asked to save, without the bundles of
  266. # scripts, which every page links.
  267. my sub pages_saved ($tpsgi) {
  268. return [ grep { !m/:js\z/ } keys %{ $tpsgi->{renders} } ];
  269. }
  270. # FlatFile snapshots the tag list at load time and then filters each query's
  271. # tags against it IN PLACE -- so a tag created later isn't merely unindexed, it
  272. # is deleted from the query, and the filter silently degrades to "every public
  273. # post". Production gets away with it because a save HUPs the parent and the
  274. # worker re-execs. We have to do it by hand.
  275. #
  276. # Nothing to do for a model that asks the database each time, which is the
  277. # point: this helper exists to paper over a cache, and a model without one
  278. # needs no paper.
  279. my sub reindex {
  280. return unless $MODEL eq 'FlatFile';
  281. no warnings 'once';
  282. @Trog::Data::FlatFile::tags = Trog::SQLite::TagIndex::tags();
  283. %Trog::Data::FlatFile::posts_by_tag = ();
  284. return;
  285. }
  286. my sub _data { return Trog::Data->new( Trog::Config::get() ) }
  287. # categories.tx renders into <span id="categories">. Scope to it -- index.tx
  288. # emits other class="topbar" anchors outside that span.
  289. my sub topbar_titles {
  290. my ($body) = @_;
  291. my ($span) = $body =~ m{<span[ ]id="categories">(.*?)</span>}s;
  292. return () unless defined $span;
  293. return $span =~ m{class="topbar">([^<]*)</a>}g;
  294. }
  295. # Save through post_save() rather than $data->add(): add() dies with an
  296. # arrayref of validator errors, whereas post_save catches them and hands back a
  297. # 400 with the field-level detail in the body -- which is the single most
  298. # useful thing to see when a fixture is wrong.
  299. my sub save_post {
  300. my ( $label, %post ) = @_;
  301. my $to = delete $post{to};
  302. my $res = eval { Trog::Routes::HTML::post_save( admin( route => '/post/save', method => 'POST', to => $to, %post ) ) };
  303. if ( !$res || ref $res ne 'ARRAY' ) {
  304. fail("$label: saved");
  305. diag( $@ || 'post_save returned nothing' );
  306. return undef;
  307. }
  308. my ( $code, $headers, $body ) = @$res;
  309. my %h = @{ $headers || [] };
  310. # Both outcomes redirect now, so the status alone proves nothing -- the
  311. # outcome is in the query string post_save hands to the destination.
  312. if ( $code != 303 || ( $h{Location} // '' ) =~ m/savefailed=/ ) {
  313. fail("$label: saved");
  314. diag( "post_save returned $code, Location: " . ( $h{Location} // '(none)' ) );
  315. diag( join( '', @{ $body || [''] } ) ) if $body && @$body;
  316. return undef;
  317. }
  318. pass("$label: saved");
  319. reindex(); # mandatory: see the comment on reindex
  320. my $saved = find_post( $post{title} );
  321. ok( $saved, "$label: readable back out of the datastore" ) or return undef;
  322. return $saved;
  323. }
  324. sub find_post {
  325. my ($title) = @_;
  326. # filter() short-circuits on title; the admin acl skips the visibility filter.
  327. my @posts = _data()->get( title => $title, acls => ['admin'], limit => 0 );
  328. return $posts[0];
  329. }
  330. #--------------------------------------------------------------------------
  331. subtest 'the sandbox is what we are actually running against' => sub {
  332. is( Cwd::getcwd(), Cwd::abs_path($ROOT), 'cwd is the sandbox' );
  333. ok( -d 'data/files', 'datastore dir exists' );
  334. ok( -e 'config/default.cfg', 'config was seeded' );
  335. ok( !-e 'config/main.cfg', 'and there is no main.cfg, so we fall through to the default' );
  336. my $conf = Trog::Config::get();
  337. is( $conf->param('general.data_model'), $MODEL, 'config resolves inside the sandbox' );
  338. like( Trog::Themes::forms_dir(), qr/^www\/templates/, 'forms dir is relative, hence sandboxed' );
  339. ok( -d Cwd::abs_path( Trog::Themes::forms_dir() ), 'and it exists' );
  340. like( Cwd::abs_path( Trog::Themes::forms_dir() ), qr/^\Q$ROOT\E/, 'and it is under the sandbox, not the repo' );
  341. };
  342. subtest 'registering the first admin bootstraps the install' => sub {
  343. ok( !-e 'config/has_users', 'no users yet, so login() is in register mode' );
  344. my ( $code, undef, $err, $headers ) = render(
  345. anon(
  346. route => '/login',
  347. method => 'POST',
  348. username => $ADMIN_USER,
  349. display_name => $ADMIN_DISPLAY,
  350. contact_email => $ADMIN_EMAIL,
  351. password => $ADMIN_PASS,
  352. to => '/',
  353. ),
  354. \&Trog::Routes::HTML::login,
  355. );
  356. is( $code, 200, 'login() rendered' ) or diag($err);
  357. my %h = @{ $headers || [] };
  358. like( $h{'Set-Cookie'} // '', qr/^tcmslogin=[\da-f-]{36};/, 'a session cookie came back' );
  359. ok( -e 'config/has_users', 'registration is now closed' );
  360. is_deeply( Trog::Auth::acls4user($ADMIN_USER), ['admin'], 'the new user is an admin' );
  361. reindex();
  362. my @seeded = _data()->get( acls => ['admin'], limit => 0 );
  363. is( scalar @seeded, 4, 'the four seed posts were written' )
  364. or diag( 'got: ' . join( ', ', map { "$_->{title} ($_->{form})" } @seeded ) );
  365. };
  366. subtest 'the post wizard invents a new post type' => sub {
  367. my %wizard = (
  368. name => 'spec_widget',
  369. title_placeholder => 'Widget Name',
  370. body_form => 'form_common.tx',
  371. wrapper => 1,
  372. inc_post_title => 1,
  373. inc_post_tags => 1,
  374. inc_title_input => 1,
  375. inc_visibility => 1,
  376. inc_tags => 1,
  377. inc_aliases => 1,
  378. param_name => ['flavor'],
  379. param_type => ['text'],
  380. param_label => ['Flavor'],
  381. param_placeholder => ['Strawberry'],
  382. param_required => [0],
  383. 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>},
  384. );
  385. my ( $code, $body, $err ) = render(
  386. admin( route => '/admin/wyzzerdd/save', method => 'POST', %wizard ),
  387. \&Trog::Routes::HTML::post_wizard_save,
  388. );
  389. is( $code, 200, 'wizard save rendered' ) or diag($err);
  390. ok( -e 'www/templates/html/components/forms/spec_widget.tx', 'the template was written' );
  391. ok( -e 'www/templates/html/components/forms/spec_widget.json', 'the schema sidecar was written' );
  392. # The existing types are a dropdown now, not a list.
  393. like( $body, qr{<option[ ]value="spec_widget\.tx">}, 'and the new type is listed back to us' );
  394. # This is the assertion that the sandbox is real: a symlinked template tree
  395. # would have put these in the developer's actual checkout.
  396. ok( !-e "$REPO/www/templates/html/components/forms/spec_widget.tx", 'nothing was written into the repo' );
  397. # The relation controls have to be present in every row and always submit,
  398. # or the parallel param_* arrays de-align server side.
  399. like( $body, qr/name="param_relation_form"/, 'the relation target select is in the row template' );
  400. like( $body, qr/name="param_relation_mode"/, 'so is the relation mode select' );
  401. like( $body, qr/<option[ ]value="relation">/, 'and relation is offered as a field type' );
  402. # A series can ask for its children to be tiled. A generated type has to
  403. # carry that on its wrapper like the hand-written forms do, or it is the
  404. # one kind of post that silently ignores the setting.
  405. my $generated = Path::Tiny->new('www/templates/html/components/forms/spec_widget.tx')->slurp_utf8;
  406. # Single quoted: the wrapper is Kolon source, so every sigil in it is
  407. # literal and must not be interpolated by the test that checks for it.
  408. my $wrapper = q{<div class="post <: $style :> <: $tiled ? 'tile' : '' :>">};
  409. ok( index( $generated, $wrapper ) >= 0, 'the generated wrapper carries the tile class when the series asks for it' )
  410. or diag( "wanted: $wrapper\ngot: " . ( split( /\n/, $generated ) )[1] );
  411. # Every post has a title, a visibility and acls. The wizard used to let a
  412. # type opt out of collecting them, which is how a hypervisor post ended up
  413. # stored with no visibility and an undef in its tags.
  414. foreach my $required ( 'visibility.tx', 'acls.tx' ) {
  415. like( $generated, qr/:[ ]include[ ]"\Q$required\E";/, "$required is included whether or not it was asked for" );
  416. }
  417. like( $generated, qr/name="title"/, 'and so is the title input' );
  418. foreach my $gone (qw{inc_title_input inc_visibility inc_acls}) {
  419. unlike( $body, qr/name="\Q$gone\E"/, "the wizard no longer offers '$gone' as a choice" );
  420. }
  421. like( $body, qr/name="param_private"/, 'and it offers per-field privacy' );
  422. like( $body, qr/name="datasource"/, 'and a datasource to draw the posts from' );
  423. like( $body, qr/Trog::DataSource::Virt/, 'listing the ones that exist' );
  424. };
  425. subtest 'a datasource-backed type gets no editor' => sub {
  426. # A datasource whose posts are built rather than written has nothing behind
  427. # a form to save, so generating one would produce an editor that writes
  428. # real posts to sit alongside the synthesized ones.
  429. my ( $code, $body, $err ) = render(
  430. admin(
  431. route => '/admin/wyzzerdd/save',
  432. method => 'POST',
  433. name => 'spec_sourced',
  434. datasource => 'Trog::DataSource::Virt',
  435. body_form => 'form_common.tx',
  436. wrapper => 1,
  437. inc_post_title => 1,
  438. display => q{<div class="s"><: $post.title :></div>},
  439. ),
  440. \&Trog::Routes::HTML::post_wizard_save,
  441. );
  442. is( $code, 200, 'the type was created' ) or diag($err);
  443. my $generated = Path::Tiny->new('www/templates/html/components/forms/spec_sourced.tx')->slurp_utf8;
  444. unlike( $generated, qr{action="/post/save"}, 'no editor was generated' );
  445. unlike( $generated, qr/\$can_edit/, 'and nothing guards one' );
  446. like( $generated, qr/class="s"/, 'but the display half is there' );
  447. my $sidecar = JSON::MaybeXS::decode_json( Path::Tiny->new('www/templates/html/components/forms/spec_sourced.json')->slurp_utf8 );
  448. is( $sidecar->{'x-tcms-datasource'}, 'Trog::DataSource::Virt', 'and the sidecar records the datasource' );
  449. # The same type without one keeps its editor.
  450. render(
  451. admin(
  452. route => '/admin/wyzzerdd/save',
  453. method => 'POST',
  454. name => 'spec_stored',
  455. body_form => 'form_common.tx',
  456. wrapper => 1,
  457. inc_post_title => 1,
  458. display => q{<div class="s"><: $post.title :></div>},
  459. ),
  460. \&Trog::Routes::HTML::post_wizard_save,
  461. );
  462. my $stored = Path::Tiny->new('www/templates/html/components/forms/spec_stored.tx')->slurp_utf8;
  463. like( $stored, qr{action="/post/save"}, 'a type on the datastore still gets one' );
  464. # The name is require()d later, so it has to be one we found.
  465. ( $code, $body ) = render(
  466. admin( route => '/admin/wyzzerdd/save', method => 'POST', name => 'spec_bogus', datasource => 'Evil::Module' ),
  467. \&Trog::Routes::HTML::post_wizard_save,
  468. );
  469. like( $body, qr/not[ ]a[ ]datasource[ ]I[ ]can[ ]find/, 'a datasource we did not find is refused' );
  470. ok( !-e 'www/templates/html/components/forms/spec_bogus.tx', 'and nothing was written' );
  471. };
  472. #--------------------------------------------------------------------------
  473. # The matrix.
  474. #
  475. # Per type: build a topbar series whose child_form is that type, check it shows
  476. # up in the nav, add a child post, check the child renders on the series page.
  477. #
  478. # Everything is verified ANONYMOUSLY. can_edit is then false, so the editor
  479. # half of each form never renders and a title appears exactly once -- which is
  480. # what makes like($body, qr/$title/) mean anything. It also sidesteps the
  481. # /secure prefixing that both post_helper and categories.tx apply when a user
  482. # is set.
  483. #--------------------------------------------------------------------------
  484. my sub make_series {
  485. my ( $label, $aclname, $child_form, $title, %opt ) = @_;
  486. # _get_series caps the bar at 10 and the seeds already use two, so only the
  487. # series whose topbar behaviour we actually care about get tagged.
  488. my @tags = $opt{no_topbar} ? ('series') : ( 'series', 'topbar' );
  489. my %extra = map { $_ => $opt{$_} } grep { $_ ne 'no_topbar' } keys(%opt);
  490. my $series = save_post(
  491. "$label series",
  492. %extra,
  493. form => 'series.tx',
  494. title => $title,
  495. aclname => $aclname, # required by series.json
  496. child_form => $child_form, # required by series.json
  497. local_href => "/$aclname",
  498. href => "/$aclname",
  499. data => "$title subhead",
  500. callback => 'Trog::Routes::HTML::series',
  501. visibility => 'public',
  502. tags => \@tags,
  503. tiled => 0,
  504. to => '/',
  505. ) or return undef;
  506. return $series if $opt{no_topbar};
  507. # The topbar comes from _get_series(), which index() renders through
  508. # categories.tx. Check it on / -- the series has no children yet, and
  509. # posts() 404s on an empty series.
  510. my ( $code, $body, $err ) = render( anon( route => '/' ) );
  511. is( $code, 200, "$label: / renders" ) or diag($err);
  512. my @titles = topbar_titles($body);
  513. ok( ( grep { $_ eq $title } @titles ), "$label: series is in the topbar" )
  514. or diag( 'topbar was: ' . join( ', ', @titles ) );
  515. return $series;
  516. }
  517. subtest 'a datasource-backed series searches and paginates' => sub {
  518. # The whole point of a datasource is that its posts are built rather than
  519. # stored, so nothing the datastore does to a query ever touches them. Stand
  520. # one up with enough guests to page through, and drive it through the real
  521. # route rather than calling the helpers.
  522. require Test::MockModule;
  523. require Trog::DataSource::Virt;
  524. my ( $code, undef, $err ) = render(
  525. admin(
  526. route => '/admin/wyzzerdd/save',
  527. method => 'POST',
  528. name => 'spec_guests',
  529. datasource => 'Trog::DataSource::Virt',
  530. body_form => 'form_common.tx',
  531. wrapper => 1,
  532. inc_post_title => 1,
  533. display => q{<div class="guest"><: $post.title :> is <: $post.state :></div>},
  534. ),
  535. \&Trog::Routes::HTML::post_wizard_save,
  536. );
  537. is( $code, 200, 'the datasource-backed type was created' ) or diag($err);
  538. reindex();
  539. make_series( qw{spec_guests specguests spec_guests.tx}, 'Spec Guests Series', no_topbar => 1 ) or return;
  540. # Twelve guests, every one stamped with the same created -- which is what
  541. # libvirt guests really are, and precisely what the cursor paginator cannot
  542. # page through.
  543. my $built = time();
  544. my $virt = Test::MockModule->new('Trog::DataSource::Virt');
  545. $virt->redefine(
  546. posts => sub {
  547. my ( $s, $q ) = @_;
  548. return map {
  549. {
  550. id => "guest-$_",
  551. title => sprintf( 'guest%02d', $_ ),
  552. form => $s->{child_form},
  553. data => '',
  554. state => $_ % 2 ? 'running' : 'shut off',
  555. local_href => "/guest/hv/guest$_",
  556. href => '',
  557. tags => $s->{tags} // [],
  558. visibility => $s->{visibility} // 'private',
  559. created => $built,
  560. version => 0,
  561. user => $s->{user},
  562. method => 'GET',
  563. }
  564. } 1 .. 12;
  565. }
  566. );
  567. my $page_of = sub {
  568. my (%q) = @_;
  569. my ( $c, $b, $e ) = render( anon( route => '/specguests', %q ), \&Trog::Routes::HTML::series );
  570. is( $c, 200, 'guests page renders' ) or diag($e);
  571. return $b // '';
  572. };
  573. my $titles = sub {
  574. my ($html) = @_;
  575. return [ $html =~ m{<div[ ]class="guest">(guest\d+)[ ]is}g ];
  576. };
  577. my $first = $page_of->( limit => 5 );
  578. is_deeply( $titles->($first), [qw{guest01 guest02 guest03 guest04 guest05}], 'the first page holds the first five, in a settled order' );
  579. like( $first, qr/Page[ ]1[ ]of[ ]3/, 'and says which page it is' );
  580. like( $first, qr{href="\?page=2&limit=5}, 'offering the next one' );
  581. unlike( $first, qr/rel="prev"/, 'and no previous one' );
  582. my $second = $page_of->( limit => 5, page => 2 );
  583. is_deeply( $titles->($second), [qw{guest06 guest07 guest08 guest09 guest10}], 'the second page carries on where the first stopped' );
  584. like( $second, qr/Page[ ]2[ ]of[ ]3/, 'and says so' );
  585. my $third = $page_of->( limit => 5, page => 3 );
  586. is_deeply( $titles->($third), [qw{guest11 guest12}], 'the last page holds the remainder' );
  587. unlike( $third, qr/rel="next"/, 'and offers nothing after it' );
  588. # A guest's state is the point of the page, and nothing could invalidate a
  589. # cached copy: a guest starting is not a post being saved, and libvirt is
  590. # not going to tell us about it.
  591. my $vtpsgi = Test::TPSGI->new( run_callbacks => 1 );
  592. render( anon( route => '/specguests', tpsgi => $vtpsgi ), \&Trog::Routes::HTML::series );
  593. is_deeply( pages_saved($vtpsgi), [], 'a guests page is never saved as a static' );
  594. # The cursor paginator would be worse than useless here: every guest shares
  595. # a created, so Prev would ask for everything older than that one instant.
  596. unlike( $first, qr/older=$built/, 'no cursor is offered on a page that cannot use one' );
  597. # Search, which before this reached the datastore and was thrown away along
  598. # with the posts it filtered.
  599. my $searched = $page_of->( limit => 25, like => 'guest1' );
  600. is_deeply( $titles->($searched), [qw{guest10 guest11 guest12}], 'searching a datasource page searches the page' );
  601. # Virt searches what its posts carry, not just a title and an empty body.
  602. my $by_state = $page_of->( limit => 25, like => 'shut' );
  603. is_deeply( $titles->($by_state), [qw{guest02 guest04 guest06 guest08 guest10 guest12}], 'including a field only it knows about' );
  604. # And the two compose, which is what a reader paging through a search does.
  605. my $searched_page = $page_of->( limit => 4, like => 'shut', page => 2 );
  606. is_deeply( $titles->($searched_page), [qw{guest10 guest12}], 'paging through a search stays inside it' );
  607. like( $searched_page, qr/Page[ ]2[ ]of[ ]2/, 'and pages against the matches, not everything' );
  608. like( $searched_page, qr/like=shut/, 'carrying the search into the links' );
  609. };
  610. subtest 'an ordinary series survives a page number in its URL' => sub {
  611. # series() looks its own post up with the reader's query, so a ?page= meant
  612. # for the children used to page the lookup of the series itself -- page two
  613. # of one post being nothing, the series could not find itself and 404'd on
  614. # its own page. Latent until the datasource paginator started emitting page
  615. # numbers, and it was never about datasources.
  616. reindex();
  617. make_series( qw{spec_paged specpaged blog.tx}, 'Spec Paged Series', no_topbar => 1 ) or return;
  618. foreach my $n ( 1, 2 ) {
  619. save_post(
  620. "spec_paged child $n",
  621. form => 'blog.tx',
  622. title => "Spec Paged Child $n",
  623. data => "child $n body",
  624. visibility => 'public',
  625. tags => ['specpaged'],
  626. to => '/specpaged',
  627. ) or return;
  628. }
  629. # One child a page, so page two exists and holds the other one.
  630. my ( $code, $body, $err ) = render( anon( route => '/specpaged', limit => 1, page => 2 ), \&Trog::Routes::HTML::series );
  631. is( $code, 200, 'a series page with ?page=2 still finds its series' ) or diag($err);
  632. like( $body, qr/Spec[ ]Paged[ ]Series/, 'and is the right one' );
  633. ( $code, $body, $err ) = render( anon( route => '/specpaged', limit => 1, page => 1 ), \&Trog::Routes::HTML::series );
  634. is( $code, 200, 'as does page one' ) or diag($err);
  635. # A stored series still pages by cursor, not by number: nothing about this
  636. # fix moves it onto the datasource paginator.
  637. unlike( $body, qr/Page[ ]1[ ]of/, 'and it still pages by cursor rather than by number' );
  638. };
  639. subtest 'a directory index series' => sub {
  640. # A wizard-built type drawing its posts from a directory, through the real
  641. # route, on whichever data model this run is using.
  642. require Trog::DataSource::DirIndex;
  643. my ( $code, $body, $err ) = render(
  644. admin(
  645. route => '/admin/wyzzerdd/save',
  646. method => 'POST',
  647. name => 'spec_files',
  648. datasource => 'Trog::DataSource::DirIndex',
  649. body_form => 'form_common.tx',
  650. wrapper => 1,
  651. inc_post_title => 1,
  652. display => q{<div class="entry"><: $post.name :> (<: $post.size_human :>)</div>},
  653. ),
  654. \&Trog::Routes::HTML::post_wizard_save,
  655. );
  656. is( $code, 200, 'the directory-backed type was created' ) or diag($err);
  657. File::Path::make_path('www/assets/spec_downloads');
  658. foreach my $n ( 1 .. 7 ) {
  659. open( my $fh, '>', "www/assets/spec_downloads/file$n.txt" ) or die $!;
  660. print {$fh} ( 'x' x ( $n * 10 ) );
  661. close($fh) or die $!;
  662. }
  663. reindex();
  664. my $series = make_series(
  665. qw{spec_files specfiles spec_files.tx}, 'Spec Files Series',
  666. no_topbar => 1,
  667. directory => 'assets/spec_downloads',
  668. ) or return;
  669. is( $series->{directory}, 'assets/spec_downloads', 'the series remembers which directory it indexes' );
  670. my $names = sub {
  671. my ($html) = @_;
  672. return [ $html =~ m{<div[ ]class="entry">(file\d+\.txt)[ ]\(}g ];
  673. };
  674. ( $code, $body, $err ) = render( anon( route => '/specfiles' ), \&Trog::Routes::HTML::series );
  675. is( $code, 200, 'the listing renders' ) or diag($err);
  676. is_deeply( $names->($body), [ map { "file$_.txt" } 1 .. 7 ], 'listing the directory, in name order' );
  677. like( $body, qr/\(10[ ]B\)/, 'with each entry\'s size' );
  678. # post_title.tx quotes with single quotes; the point is the target, not the quoting.
  679. like( $body, qr{href=['"]/assets/spec_downloads/file1\.txt['"]}, 'and a link to the file itself' );
  680. # It paginates like any other datasource page.
  681. ( $code, $body, $err ) = render( anon( route => '/specfiles', limit => 3, page => 2 ), \&Trog::Routes::HTML::series );
  682. is( $code, 200, 'page two renders' ) or diag($err);
  683. is_deeply( $names->($body), [qw{file4.txt file5.txt file6.txt}], 'holding the next three' );
  684. like( $body, qr/Page[ ]2[ ]of[ ]3/, 'and saying so' );
  685. # And searches like one.
  686. ( $code, $body, $err ) = render( anon( route => '/specfiles', limit => 25, like => 'file3' ), \&Trog::Routes::HTML::series );
  687. is_deeply( $names->($body), ['file3.txt'], 'searching the listing searches the filenames' );
  688. # The point of the exercise: this page is cached like any other, and
  689. # nothing else would ever throw that cache away, because no post is saved
  690. # when somebody drops a file in a directory.
  691. my $tpsgi = Test::TPSGI->new( run_callbacks => 1 );
  692. render( anon( route => '/specfiles', tpsgi => $tpsgi ), \&Trog::Routes::HTML::series );
  693. # And it really is cached, rather than merely being cacheable in principle:
  694. # the renderer hands anonymous, unparameterised, successful renders to tPSGI
  695. # to save, and a directory listing is one. Which it may be, unlike the
  696. # guests page above, precisely because it registers the watch below.
  697. ok( scalar( @{ pages_saved($tpsgi) } ), 'the listing was handed to tPSGI to save as a static' );
  698. ok( ( grep { m{^/specfiles:} } keys %{ $tpsgi->{renders} } ), 'under its own route' );
  699. my ($watch) = grep { $_->{path} =~ m/spec_downloads/ } @{ $tpsgi->{watches} };
  700. ok( $watch, 'rendering it registers a watch on the directory' );
  701. like( $watch->{key}, qr/DirIndex/, 'under a stable key, so a view does not stack another' );
  702. $watch->{callback}->( $tpsgi, { path => 'www/assets/spec_downloads/file8.txt', events => ['CREATE'] } );
  703. is_deeply( $tpsgi->{invalidated}, ['html'], 'and a change to the directory invalidates the renders' );
  704. };
  705. subtest 'the wizard offers the types that exist, and can reopen one' => sub {
  706. # Make a type with everything the form can carry, then check the wizard
  707. # hands it back as the form that would have produced it.
  708. my ( $code, $body, $err ) = render(
  709. admin(
  710. route => '/admin/wyzzerdd/save',
  711. method => 'POST',
  712. name => 'spec_reopen',
  713. body_form => 'form_common.tx',
  714. wrapper => 1,
  715. inc_post_title => 1,
  716. inc_tags => 1,
  717. title_placeholder => 'A Widget',
  718. description => 'A widget, with the size it comes in.',
  719. param_name => ['widget_size'],
  720. param_type => ['number'],
  721. param_label => ['Size'],
  722. param_placeholder => ['12'],
  723. param_required => [1],
  724. param_private => [0],
  725. param_indexed => [1],
  726. param_relation_form => ['blog.tx'],
  727. param_relation_mode => ['one'],
  728. display => q{<div class="w"><: $post.widget_size :></div>},
  729. ),
  730. \&Trog::Routes::HTML::post_wizard_save,
  731. );
  732. is( $code, 200, 'the type was created' ) or diag($err);
  733. # The description goes in the sidecar, under the key the validator strips.
  734. my $sidecar = JSON::MaybeXS::decode_json( Path::Tiny->new('www/templates/html/components/forms/spec_reopen.json')->slurp_utf8 );
  735. is( $sidecar->{'x-tcms-post-type'}{description}, 'A widget, with the size it comes in.', 'the description is stored' );
  736. like( $sidecar->{'x-tcms-post-type'}{display}, qr/widget_size/, 'and so is the display template' );
  737. # Now the wizard page itself.
  738. ( $code, $body, $err ) = render( admin( route => '/admin/wyzzerdd' ), \&Trog::Routes::HTML::post_wizard );
  739. is( $code, 200, 'the wizard renders' ) or diag($err);
  740. like( $body, qr/id="wizard-existing"/, 'the existing types are a dropdown' );
  741. like( $body, qr/<option[ ]value="">A[ ]new[ ]post[ ]type/, 'defaulting to a new one' );
  742. like( $body, qr/<option[ ]value="spec_reopen\.tx">/, 'and offering the one we just made' );
  743. like( $body, qr/id="wizard-description-editor"/, 'with a collapsed editor for the description' );
  744. my ($json) = $body =~ m{id="wizard-types"[^>]*>(.*?)</script>}s;
  745. ok( $json, 'the page carries what each type was made from' ) or return;
  746. unlike( $json, qr/</, 'as JSON with no bare < in it, so it cannot end its own script element' );
  747. my $types = JSON::MaybeXS::decode_json($json);
  748. my $mine = $types->{'spec_reopen.tx'};
  749. ok( $mine, 'including the new type' ) or return;
  750. is( $mine->{name}, 'spec_reopen', 'named without the extension' );
  751. is( $mine->{description}, 'A widget, with the size it comes in.', 'with its description' );
  752. like( $mine->{display}, qr/widget_size/, 'and its display template' );
  753. is( $mine->{title_placeholder}, 'A Widget', 'and its placeholder' );
  754. is( $mine->{wrapper}, 1, 'the boxes that were ticked' );
  755. is( $mine->{inc_tags}, 1, 'includes and all' );
  756. is( $mine->{inc_aliases}, 0, 'and only those' );
  757. is( scalar( @{ $mine->{fields} } ), 1, 'and its custom field' );
  758. my $field = $mine->{fields}[0];
  759. is( $field->{name}, 'widget_size', 'by name' );
  760. is( $field->{type}, 'number', 'with the input it was given' );
  761. is( $field->{required}, 1, 'whether it was required' );
  762. is( $field->{indexed}, 1, 'and whether it was indexed' );
  763. # Which is to say: reopening it and saving it back is a round trip, not a
  764. # form somebody has to fill in again from memory.
  765. };
  766. subtest 'a field can be declared indexed' => sub {
  767. my ( $code, undef, $err ) = render(
  768. admin(
  769. route => '/admin/wyzzerdd/save',
  770. method => 'POST',
  771. name => 'spec_indexed',
  772. body_form => 'form_common.tx',
  773. wrapper => 1,
  774. inc_post_title => 1,
  775. # The middle row is the one that matters: its box is clear, and the
  776. # wizard zips these arrays together positionally, so if a clear box
  777. # ever submitted nothing the flag would land on the wrong field.
  778. param_name => [qw{cook_time garnish serves}],
  779. param_type => [qw{text text number}],
  780. param_label => [ 'Cook Time', 'Garnish', 'Serves' ],
  781. param_placeholder => [ '', '', '' ],
  782. param_required => [ 0, 0, 0 ],
  783. param_private => [ 0, 0, 0 ],
  784. param_indexed => [ 1, 0, 1 ],
  785. param_relation_form => [qw{blog.tx blog.tx blog.tx}],
  786. param_relation_mode => [qw{one one one}],
  787. display => q{<div class="ct"><: $post.cook_time :></div>},
  788. ),
  789. \&Trog::Routes::HTML::post_wizard_save,
  790. );
  791. is( $code, 200, 'the type was created' ) or diag($err);
  792. my $sidecar = JSON::MaybeXS::decode_json( Path::Tiny->new('www/templates/html/components/forms/spec_indexed.json')->slurp_utf8 );
  793. ok( $sidecar->{properties}{cook_time}{'x-tcms-indexed'}, 'the ticked field is marked indexed' );
  794. ok( $sidecar->{properties}{serves}{'x-tcms-indexed'}, 'and so is the one after the clear box' );
  795. ok( !exists $sidecar->{properties}{garnish}{'x-tcms-indexed'}, 'the field between them is not' );
  796. ok( !exists $sidecar->{properties}{cook_time}{'x-tcms-private'}, 'and indexing is not privacy' );
  797. is_deeply(
  798. Trog::DataModule::indexed_fields_for('spec_indexed.tx'),
  799. [ sort qw{cook_time serves} ],
  800. 'and the model reads them back out of the sidecar'
  801. );
  802. SKIP: {
  803. skip( "the $MODEL model has nothing to index with", 3 ) unless $MODEL eq 'SQLite';
  804. my $dbh = Trog::SQLite::dbh( undef, 'data/posts.sqlite' );
  805. my %columns = map { $_->{name} => 1 } @{ $dbh->selectall_arrayref( 'PRAGMA table_xinfo(posts)', { Slice => {} } ) };
  806. my %indexes = map { $_->{name} => 1 } @{ $dbh->selectall_arrayref( "SELECT name FROM sqlite_master WHERE type='index' AND tbl_name='posts'", { Slice => {} } ) };
  807. ok( $columns{cook_time}, 'saving the type gave the ticked field a column' );
  808. ok( $indexes{'posts_custom_cook_time'}, 'and an index' );
  809. ok( !$indexes{'posts_custom_garnish'}, 'and left the unticked one alone' );
  810. }
  811. # A post of the type still saves and reads back the same as any other.
  812. reindex();
  813. make_series( qw{spec_indexed specindexed spec_indexed.tx}, 'Spec Indexed Series', no_topbar => 1 ) or return;
  814. my $child = save_post(
  815. 'spec_indexed child',
  816. form => 'spec_indexed.tx',
  817. title => 'Spec Indexed Child',
  818. cook_time => '45 minutes',
  819. garnish => 'parsley',
  820. visibility => 'public',
  821. tags => ['specindexed'],
  822. to => '/specindexed',
  823. ) or return;
  824. is( $child->{cook_time}, '45 minutes', 'an indexed field stores like any other' );
  825. is( $child->{garnish}, 'parsley', 'and so does the one beside it' );
  826. };
  827. subtest 'a field can be declared editors-only' => sub {
  828. my ( $code, undef, $err ) = render(
  829. admin(
  830. route => '/admin/wyzzerdd/save',
  831. method => 'POST',
  832. name => 'spec_secretive',
  833. body_form => 'form_common.tx',
  834. wrapper => 1,
  835. inc_post_title => 1,
  836. inc_tags => 1,
  837. param_name => [ 'shown', 'hidden' ],
  838. param_type => [ 'text', 'text' ],
  839. param_label => [ 'Shown', 'Hidden' ],
  840. param_placeholder => [ '', '' ],
  841. param_required => [ 0, 0 ],
  842. param_private => [ 0, 1 ],
  843. param_relation_form => [ 'blog.tx', 'blog.tx' ],
  844. param_relation_mode => [ 'one', 'one' ],
  845. # Deliberately unguarded: declaring the field private is supposed
  846. # to be enough, so an author does not have to remember.
  847. display => q{<div class="s"><: $post.shown :></div><div class="h"><: $post.hidden :></div>},
  848. ),
  849. \&Trog::Routes::HTML::post_wizard_save,
  850. );
  851. is( $code, 200, 'the type was created' ) or diag($err);
  852. my $sidecar = JSON::MaybeXS::decode_json( Path::Tiny->new('www/templates/html/components/forms/spec_secretive.json')->slurp_utf8 );
  853. ok( $sidecar->{properties}{hidden}{'x-tcms-private'}, 'the private field is marked so' );
  854. ok( !exists $sidecar->{properties}{shown}{'x-tcms-private'}, 'and a public one carries no flag at all' );
  855. reindex();
  856. make_series( qw{spec_secretive specsecretive spec_secretive.tx}, 'Spec Secretive Series', no_topbar => 1 ) or return;
  857. my $child = save_post(
  858. 'spec_secretive child',
  859. form => 'spec_secretive.tx',
  860. title => 'Spec Secretive Child',
  861. shown => 'public value',
  862. hidden => 'private value',
  863. visibility => 'public',
  864. tags => ['specsecretive'],
  865. to => '/specsecretive',
  866. ) or return;
  867. is( $child->{hidden}, 'private value', 'the value is stored like any other' );
  868. # An editor sees both.
  869. my ( $acode, $abody ) = render( admin( route => '/specsecretive' ), \&Trog::Routes::HTML::series );
  870. is( $acode, 200, 'the series renders for an admin' );
  871. like( $abody, qr{<div[ ]class="h">private[ ]value</div>}, 'who sees the private field' );
  872. # A logged out reader sees only the public one, without the template
  873. # having guarded anything.
  874. my ( $ncode, $nbody ) = render( anon( route => '/specsecretive' ), \&Trog::Routes::HTML::series );
  875. is( $ncode, 200, 'and for everyone else' );
  876. like( $nbody, qr{<div[ ]class="s">public[ ]value</div>}, 'who still sees the public field' );
  877. unlike( $nbody, qr/private[ ]value/, 'but not the private one' );
  878. };
  879. my sub series_page {
  880. my ( $label, $aclname, $series_title, $expected_posts ) = @_;
  881. my ( $code, $body, $err ) = render( anon( route => "/$aclname" ), \&Trog::Routes::HTML::series );
  882. is( $code, 200, "$label: series page renders" ) or do { diag($err); return '' };
  883. like( $body, qr{<title>[^<]*\Q$series_title\E}, "$label: series page is the right series" );
  884. # post_title.tx emits exactly one of these per displayed post.
  885. my $listed = () = $body =~ m{<h3[ ]class='blogtitles'>}g;
  886. if ( !is( $listed, $expected_posts, "$label: exactly $expected_posts post(s) listed" ) ) {
  887. # The rendered page is ~40KB and mostly JavaScript. Show the content well.
  888. my $from = qr{<div[ ]id="kontent"[ ]class="kontained">};
  889. my $to = qr{<div[ ]id="rightbar"};
  890. my ($k) = $body =~ m{$from(.*?)$to}s;
  891. $k //= $body;
  892. $k =~ s/<script\b.*?<\/script>//gs;
  893. diag( length($k) > 2500 ? substr( $k, 0, 2500 ) . "\n...[truncated]" : $k );
  894. }
  895. return $body;
  896. }
  897. # Entities first: the invoice type resolves payee/payor against existing public
  898. # entities.tx posts, so those have to be in the datastore before we get there.
  899. our ( $PAYEE, $PAYOR );
  900. subtest 'entities' => sub {
  901. my $title = 'Spec Entities Series';
  902. make_series( qw{entities specentities entities.tx}, $title ) or return;
  903. $PAYEE = save_post(
  904. 'entities payee child',
  905. form => 'entities.tx',
  906. title => 'Spec Payee Entity',
  907. data => 'Acme Payments LLC, 1 Road, Metropolis',
  908. payment_method => 'ACH',
  909. payment_details => 'Routing 0000 Account 1111',
  910. visibility => 'public',
  911. tags => ['specentities'],
  912. to => '/specentities',
  913. ) or return;
  914. $PAYOR = save_post(
  915. 'entities payor child',
  916. form => 'entities.tx',
  917. title => 'Spec Payor Entity',
  918. data => 'Wile E Coyote, PO Box 9',
  919. payment_method => 'Carrier Pigeon',
  920. payment_details => 'none',
  921. visibility => 'public',
  922. tags => ['specentities'],
  923. to => '/specentities',
  924. ) or return;
  925. my $body = series_page( 'entities', 'specentities', $title, 2 ) or return;
  926. like( $body, qr{id="postData-\Q$PAYEE->{id}\E"}, 'payee body rendered' );
  927. like( $body, qr/Acme[ ]Payments[ ]LLC/, 'payee data rendered' );
  928. like( $body, qr/Wile[ ]E[ ]Coyote/, 'payor data rendered' );
  929. # entity_details.tx is included only in the editor half, so these are stored
  930. # but never displayed. Pinning that so a template change is noticed.
  931. unlike( $body, qr/Carrier[ ]Pigeon/, 'payment details are not shown to anonymous readers' );
  932. is( find_post('Spec Payee Entity')->{payment_method}, 'ACH', 'but payment_method did survive the schema' );
  933. };
  934. subtest 'blog' => sub {
  935. my $title = 'Spec Blog Series';
  936. make_series( qw{blog specblog blog.tx}, $title ) or return;
  937. my $child = save_post(
  938. 'blog child',
  939. form => 'blog.tx',
  940. title => 'Spec Blog Child',
  941. data => 'Spec blog body text.',
  942. visibility => 'public',
  943. tags => ['specblog'],
  944. to => '/specblog',
  945. ) or return;
  946. my $body = series_page( 'blog', 'specblog', $title, 1 ) or return;
  947. like( $body, qr/Spec[ ]Blog[ ]Child/, 'child title rendered' );
  948. like( $body, qr{href='/posts/\Q$child->{id}\E'}, 'child permalink rendered' );
  949. like( $body, qr{id="postData-\Q$child->{id}\E"}, 'child body block rendered' );
  950. like( $body, qr/Spec[ ]blog[ ]body[ ]text\./, 'child body text rendered' );
  951. unlike( $body, qr/Spec[ ]Payee[ ]Entity/, 'no bleed from the entities series' );
  952. };
  953. subtest 'a post that embeds another' => sub {
  954. my $embedded = find_post('Spec Blog Child') or return fail('the blog child is there to embed');
  955. my $host = save_post(
  956. 'embedding post',
  957. form => 'blog.tx',
  958. title => 'Spec Embedding Post',
  959. data => "Before the embed. <: embed('$embedded->{id}') :> After the embed.",
  960. visibility => 'public',
  961. tags => ['specblog'],
  962. to => '/specblog',
  963. ) or return;
  964. my @warned;
  965. local $SIG{__WARN__} = sub { push @warned, @_ };
  966. my ( $code, $page, $err ) = render( anon( route => "/posts/$host->{id}", id => $host->{id} ), \&Trog::Routes::HTML::posts );
  967. is( $code, 200, 'the post renders' ) or return diag($err);
  968. my ($data) = $page =~ m{id="postData-\Q$host->{id}\E">(.*?)After[ ]the[ ]embed}s;
  969. ok( defined $data, 'with its own body' ) or return;
  970. like( $data, qr/Spec[ ]blog[ ]body[ ]text[.]/, 'and the body of the post it embeds, in place' );
  971. my $embeds = () = $data =~ m/class="post[ ]embed"/g;
  972. is( $embeds, 1, 'in the embed style, and only that one post' );
  973. is( scalar(@warned), 0, 'without a warning' ) or diag( explain( \@warned ) );
  974. };
  975. subtest 'microblog' => sub {
  976. my $title = 'Spec Microblog Series';
  977. make_series( qw{microblog specmicroblog microblog.tx}, $title ) or return;
  978. my $child = save_post(
  979. 'microblog child',
  980. form => 'microblog.tx',
  981. title => 'Spec Microblog Child',
  982. href => 'https://test.test/spec',
  983. data => 'Spec microblog body.',
  984. visibility => 'public',
  985. tags => ['specmicroblog'],
  986. to => '/specmicroblog',
  987. ) or return;
  988. my $body = series_page( 'microblog', 'specmicroblog', $title, 1 ) or return;
  989. my $link = q{href='https://test.test/spec' >Spec Microblog Child</a>};
  990. like( $body, qr{\Q$link\E}, 'title links out to href' );
  991. like( $body, qr{id="postData-\Q$child->{id}\E"}, 'body block rendered' );
  992. like( $body, qr/Spec[ ]microblog[ ]body\./, 'body text rendered' );
  993. };
  994. subtest 'file' => sub {
  995. my $title = 'Spec File Series';
  996. make_series( qw{file specfile file.tx}, $title ) or return;
  997. # _handle_upload MOVES the file, so it has to be created fresh here.
  998. my $src = "$ROOT/upload-src/spec-upload.txt";
  999. open( my $fh, '>', $src ) or die $!;
  1000. print {$fh} "spec upload contents\n";
  1001. close($fh) or die $!;
  1002. my $child = save_post(
  1003. 'file child',
  1004. form => 'file.tx',
  1005. title => 'Spec File Child',
  1006. data => 'Spec file body.',
  1007. file => { tempname => $src, filename => 'spec-upload.txt' },
  1008. visibility => 'public',
  1009. tags => ['specfile'],
  1010. to => '/specfile',
  1011. ) or return;
  1012. ok( !-e $src, 'the upload was moved out of its temp location, not copied' );
  1013. ok( -e "www/assets/$child->{id}.spec-upload.txt", 'and it landed in www/assets' );
  1014. my $body = series_page( 'file', 'specfile', $title, 1 ) or return;
  1015. like( $body, qr{href='/assets/\Q$child->{id}\E\.spec-upload\.txt'}, 'title links to the asset' );
  1016. like( $body, qr{id="postData-\Q$child->{id}\E"}, 'body block carries a unique id, like every other form' );
  1017. like( $body, qr/Spec[ ]file[ ]body\./, 'body text rendered' );
  1018. # This form used to emit <div class="postData" id="postData" class="responsive-text">
  1019. # -- a duplicated class attribute, and an id shared by every file post on
  1020. # the page. Neither should come back.
  1021. unlike( $body, qr{<div[ ]class="postData"[ ]id="postData"}, 'no duplicated class attribute' );
  1022. # text/plain, so none of the media branches fire.
  1023. unlike( $body, qr/<video/, 'no video block for a text file' );
  1024. unlike( $body, qr/<audio/, 'no audio block either' );
  1025. };
  1026. subtest 'presentation' => sub {
  1027. my $title = 'Spec Presentation Series';
  1028. make_series( qw{presentation specpresentation presentation.tx}, $title ) or return;
  1029. my $child = save_post(
  1030. 'presentation child',
  1031. form => 'presentation.tx',
  1032. title => 'Spec Presentation Child',
  1033. data => [ 'Slide one body.', 'Slide two body.' ],
  1034. data_is_array => 1,
  1035. visibility => 'public',
  1036. tags => ['specpresentation'],
  1037. to => '/specpresentation',
  1038. ) or return;
  1039. is_deeply( $child->{data}, [ 'Slide one body.', 'Slide two body.' ], 'the multi-page data round-tripped as an array' );
  1040. my $body = series_page( 'presentation', 'specpresentation', $title, 1 ) or return;
  1041. # Slides only render under nochrome; the series page just links to the deck.
  1042. my $deck = qq{<a href="/posts/$child->{id}?embed=1&nochrome=1">Click Here to view</a>};
  1043. like( $body, qr{\Q$deck\E}, 'deck link rendered' );
  1044. unlike( $body, qr/Slide[ ]one[ ]body\./, 'slides themselves are not rendered inline' );
  1045. # The operation that tPSGI hands the callback, which carries the scripts
  1046. # that TCMS gives the route of a post. t/TCMS.t makes sure that it does.
  1047. no warnings qw{once};
  1048. my %operation = map { ( "x-tcms-$_" => $Trog::Routes::HTML::post_page_scripts{$_} ) } keys %Trog::Routes::HTML::post_page_scripts;
  1049. my $deck_query = sub (@who) { return ( route => "/posts/$child->{id}", id => $child->{id}, embed => 1, nochrome => 1, dispatcher => \%operation, @who ) };
  1050. my ( $code, $page, $err ) = render( anon( $deck_query->() ), \&Trog::Routes::HTML::posts );
  1051. is( $code, 200, 'the deck renders' ) or return diag($err);
  1052. like( $page, qr/Reveal[.]initialize/, 'and starts reveal' );
  1053. my @srcs = $page =~ m{<script\b[^>]*\bsrc="([^"]+)"}g;
  1054. is( scalar(@srcs), 1, 'from one script' ) or return diag( explain( \@srcs ) );
  1055. my ( $version, $names ) = $srcs[0] =~ m{\A/bundle/(\w+)/([^/]+)[.]js\z} or return fail("$srcs[0] is a bundle");
  1056. is( $names, 'highlight.min+reveal.min', 'which bundles what the deck needs, and no editing scripts for a visitor' );
  1057. my ( $bcode, $bundle, $berr, $headers ) = render( anon( route => $srcs[0], version => $version, names => $names ), \&Trog::Routes::HTML::bundle );
  1058. is( $bcode, 200, 'the bundle is served' ) or return diag($berr);
  1059. like( $bundle, qr/spec[ ]highlight.*spec[ ]reveal/s, 'with both scripts in it, in order' );
  1060. my %h = @$headers;
  1061. is( $h{'Content-type'}, 'text/javascript', 'as javascript' );
  1062. like( $h{'Cache-Control'}, qr/immutable/, 'that the browser keeps, since the href changes with the body' );
  1063. ($bcode) = render( anon( route => "/bundle/0000/$names.js", version => '0000', names => $names ), \&Trog::Routes::HTML::bundle );
  1064. is( $bcode, 302, 'an old version is sent to the current one' );
  1065. ($bcode) = render( anon( route => '/bundle/0000/nothere.js', version => '0000', names => 'nothere' ), \&Trog::Routes::HTML::bundle );
  1066. is( $bcode, 404, 'and a bundle of nothing is not found' );
  1067. # As a fresh worker, which has saved nothing yet.
  1068. local %Trog::Bundle::saved = ();
  1069. my $tpsgi = Test::TPSGI->new( run_callbacks => 1 );
  1070. render( anon( $deck_query->( tpsgi => $tpsgi ) ), \&Trog::Routes::HTML::posts );
  1071. is( $tpsgi->{renders}{"$srcs[0]:js"}, $bundle, 'the bundle that a page links is saved as a static' );
  1072. delete $tpsgi->{renders}{"$srcs[0]:js"};
  1073. render( anon( $deck_query->( tpsgi => $tpsgi ) ), \&Trog::Routes::HTML::posts );
  1074. ok( !exists $tpsgi->{renders}{"$srcs[0]:js"}, 'once' );
  1075. my $undeclared = 'reveal.min+highlight.min';
  1076. ($bcode) = render( anon( route => "/bundle/0000/$undeclared.js", version => '0000', names => $undeclared, tpsgi => $tpsgi ), \&Trog::Routes::HTML::bundle );
  1077. is( $bcode, 404, 'a list of real scripts that no route declares is not found' );
  1078. my ($watch) = grep { $_->{path} eq 'www/scripts' } @{ $tpsgi->{watches} };
  1079. ok( $watch, 'the scripts are watched' ) or return;
  1080. $watch->{callback}->( $tpsgi, {} );
  1081. is_deeply( [ @{ $tpsgi->{invalidated} }[ -2, -1 ] ], [qw{html js}], 'and a change throws away the saved pages and bundles' );
  1082. ( $code, $page, $err ) = render( query( user => 'spec_reader', user_acls => [], $deck_query->() ), \&Trog::Routes::HTML::posts );
  1083. is( $code, 200, 'the deck renders for a reader who is logged in' ) or return diag($err);
  1084. my $viewing = qr{highlight[.]min[+]reveal[.]min};
  1085. my $editing = qr{post[+]post_relations};
  1086. like( $page, qr{src="/bundle/\w+/$viewing[+]$editing[.]js"}, 'with the authenticated scripts after the others, though the reader is not an admin' );
  1087. ( $code, $page, $err ) = render( admin( $deck_query->() ), \&Trog::Routes::HTML::posts );
  1088. is( $code, 200, 'the deck renders for an editor' ) or return diag($err);
  1089. my @editor_srcs = $page =~ m{<script\b[^>]*\bsrc="([^"]+)"}g;
  1090. my ($editor_names) = ( $editor_srcs[0] // '' ) =~ m{/([^/]+)[.]js\z};
  1091. ($bcode) = render( anon( route => $editor_srcs[0], version => 'x', names => $editor_names ), \&Trog::Routes::HTML::bundle );
  1092. is( $bcode, 200, 'and its bundle is served too' );
  1093. ( $code, $page, $err ) = render( anon( $deck_query->( query => 'scripts', scripts => 'nothere.js' ) ), \&Trog::Routes::HTML::posts );
  1094. is( $code, 200, 'a request that names scripts of its own still renders' ) or return diag($err);
  1095. like( $page, qr{src="/bundle/\w+/$viewing[.]js"}, 'with the scripts of the route' );
  1096. };
  1097. subtest 'invoice' => sub {
  1098. my $title = 'Spec Invoice Series';
  1099. make_series( qw{invoice specinvoice invoice.tx}, $title ) or return;
  1100. my %invoice = (
  1101. form => 'invoice.tx',
  1102. title => 'Spec Invoice Child',
  1103. data => [ "Widget assembly\nPrice: \$420", "Shipping\nPrice: \$80" ],
  1104. data_is_array => 1,
  1105. payee => $PAYEE->{id},
  1106. payor => $PAYOR->{id},
  1107. due_days => 30,
  1108. visibility => 'public',
  1109. tags => ['specinvoice'],
  1110. to => '/specinvoice',
  1111. );
  1112. my $sent = time() - 864_000; # ten days
  1113. my $child = do { local $main::NOW = $sent; save_post( 'invoice child', %invoice ) }
  1114. or return;
  1115. is( $child->{created}, $sent, 'the first save is stamped with the clock the test set' );
  1116. $child = save_post( 'invoice child, edited', %invoice, id => $child->{id} ) or return;
  1117. is( $child->{created}, $sent, 'an edit keeps the date the invoice was first made' );
  1118. cmp_ok( $child->{modified}, '>', $sent, 'and the edit carries a later one' );
  1119. my $body = series_page( 'invoice', 'specinvoice', $title, 1 ) or return;
  1120. like( $body, qr/Invoice[ ]ID[#][ ]\Q$child->{id}\E/, 'invoice header rendered' );
  1121. # These two only resolve because the entities subtest ran first and left
  1122. # public entities.tx posts behind for the enrich hook to find.
  1123. like( $body, qr/Acme[ ]Payments[ ]LLC/, 'payee entity resolved' );
  1124. like( $body, qr/Wile[ ]E[ ]Coyote/, 'payor entity resolved' );
  1125. like( $body, qr/ACH/, 'payee payment method pulled through' );
  1126. like( $body, qr/Widget[ ]assembly/, 'line items rendered' );
  1127. like( $body, qr/Total:[ ]\$500/, 'total summed from the line item prices' );
  1128. my $due = $child->{modified} + 2_592_000; # thirty days
  1129. like( $body, qr{Due:[ ]<span[ ]class="unixtimestamp">\Q$due\E</span>}, 'due date counts from the latest edit, not the first save' );
  1130. };
  1131. subtest 'a private post is not served to a visitor who asks for it by id' => sub {
  1132. my $secret = save_post(
  1133. 'private post',
  1134. form => 'blog.tx',
  1135. title => 'Spec Private Post',
  1136. data => 'Spec private body.',
  1137. visibility => 'private',
  1138. to => '/posts',
  1139. ) or return;
  1140. my ( $code, $body ) = render( anon( route => "/posts/$secret->{id}" ), \&Trog::Routes::HTML::posts );
  1141. is( $code, 404, 'a visitor gets a 404' );
  1142. unlike( $body, qr/Spec[ ]private[ ]body/, 'and none of the post' );
  1143. ( $code, $body ) = render( admin( route => "/posts/$secret->{id}" ), \&Trog::Routes::HTML::posts );
  1144. is( $code, 200, 'an admin gets the post' );
  1145. like( $body, qr/Spec[ ]private[ ]body/, 'with its body' );
  1146. };
  1147. subtest 'spec_widget (the wizard-built type)' => sub {
  1148. my $title = 'Spec Widget Series';
  1149. make_series( qw{spec_widget specwidget spec_widget.tx}, $title ) or return;
  1150. my $child = save_post(
  1151. 'spec_widget child',
  1152. form => 'spec_widget.tx',
  1153. title => 'Spec Widget Child',
  1154. data => 'Spec widget body.',
  1155. flavor => 'Strawberry',
  1156. bogus_field => 'nope',
  1157. visibility => 'public',
  1158. tags => ['specwidget'],
  1159. to => '/specwidget',
  1160. ) or return;
  1161. is( $child->{flavor}, 'Strawberry', 'the custom field survived validation' );
  1162. ok( !exists $child->{bogus_field}, 'an undeclared field was still stripped' );
  1163. my $body = series_page( 'spec_widget', 'specwidget', $title, 1 ) or return;
  1164. # The payoff: this can only render if the wizard wrote spec_widget.json,
  1165. # schema_for merged it over the base post schema, and validate() therefore
  1166. # kept 'flavor' instead of deleting it as an unknown key.
  1167. like( $body, qr{<span[ ]class="spec-flavor">Strawberry</span>}, 'the custom field rendered on the page' );
  1168. like( $body, qr/Spec[ ]widget[ ]body\./, 'and the body came through the generated template' );
  1169. };
  1170. subtest 'a wizard-built type can depend on another type' => sub {
  1171. # The type we will point at. The relation is what is under test, so keep
  1172. # the target itself boring.
  1173. my ( $code, $body, $err ) = render(
  1174. admin(
  1175. route => '/admin/wyzzerdd/save',
  1176. method => 'POST',
  1177. name => 'spec_target',
  1178. body_form => 'form_common.tx',
  1179. wrapper => 1,
  1180. inc_post_title => 1,
  1181. inc_title_input => 1,
  1182. inc_visibility => 1,
  1183. inc_tags => 1,
  1184. display => q{<div><: render_it($post.data) | mark_raw :></div>},
  1185. ),
  1186. \&Trog::Routes::HTML::post_wizard_save,
  1187. );
  1188. is( $code, 200, 'target type created' ) or diag($err);
  1189. # ...and the type that depends on it: one picked by id, one pulling in the
  1190. # whole set.
  1191. ( $code, $body, $err ) = render(
  1192. admin(
  1193. route => '/admin/wyzzerdd/save',
  1194. method => 'POST',
  1195. name => 'spec_relator',
  1196. body_form => 'form_common.tx',
  1197. wrapper => 1,
  1198. inc_post_title => 1,
  1199. inc_title_input => 1,
  1200. inc_visibility => 1,
  1201. inc_tags => 1,
  1202. param_name => [ 'chosen', 'everything' ],
  1203. param_type => [ 'relation', 'relation' ],
  1204. param_label => [ 'Chosen One', 'All Of Them' ],
  1205. param_placeholder => [ '', '' ],
  1206. param_required => [ 0, 0 ],
  1207. param_relation_form => [ 'spec_target.tx', 'spec_target.tx' ],
  1208. param_relation_mode => [ 'one', 'all' ],
  1209. 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>},
  1210. ),
  1211. \&Trog::Routes::HTML::post_wizard_save,
  1212. );
  1213. is( $code, 200, 'relating type created' ) or diag($err);
  1214. my $sidecar = JSON::MaybeXS::decode_json( Path::Tiny->new('www/templates/html/components/forms/spec_relator.json')->slurp_utf8 );
  1215. # 'one' is a field the post stores; 'all' is not a field at all.
  1216. is( $sidecar->{properties}{chosen}{type}, 'relation', 'the picked relation is a stored property' );
  1217. is( $sidecar->{properties}{chosen}{'x-tcms-relation-form'}, 'spec_target.tx', 'naming its target type' );
  1218. ok( !exists $sidecar->{properties}{everything}, "the 'all' relation stores nothing" );
  1219. is_deeply(
  1220. $sidecar->{'x-tcms-relations'},
  1221. {
  1222. chosen_post => { form => 'spec_target.tx', from => 'chosen' },
  1223. everything => { form => 'spec_target.tx' },
  1224. },
  1225. 'and both are declared for resolution at render'
  1226. );
  1227. # The relation pseudo-type has to become a real one before validation, or
  1228. # every relation field would be stripped as an unknown type.
  1229. is(
  1230. Trog::DataModule::schema_for('spec_relator.tx')->{properties}{chosen}{type},
  1231. 'string', "'relation' expands to a real schema type"
  1232. );
  1233. reindex();
  1234. # Now exercise it end to end.
  1235. make_series( qw{spec_target spectarget spec_target.tx}, 'Spec Target Series', no_topbar => 1 ) or return;
  1236. my $target = save_post(
  1237. 'spec_target child',
  1238. form => 'spec_target.tx',
  1239. title => 'Spec Target Post',
  1240. data => 'Spec target body.',
  1241. visibility => 'public',
  1242. tags => ['spectarget'],
  1243. to => '/spectarget',
  1244. ) or return;
  1245. make_series( qw{spec_relator specrelator spec_relator.tx}, 'Spec Relator Series', no_topbar => 1 ) or return;
  1246. my $relator = save_post(
  1247. 'spec_relator child',
  1248. form => 'spec_relator.tx',
  1249. title => 'Spec Relator Post',
  1250. data => 'Spec relator body.',
  1251. chosen => $target->{id},
  1252. visibility => 'public',
  1253. tags => ['specrelator'],
  1254. to => '/specrelator',
  1255. ) or return;
  1256. is( $relator->{chosen}, $target->{id}, 'the referenced id survived validation' );
  1257. my $page = series_page( 'spec_relator', 'specrelator', 'Spec Relator Series', 1 ) or return;
  1258. # Both halves of the relation resolved: the one we picked, and the set.
  1259. like( $page, qr{<span[ ]class="chosen">Spec[ ]Target[ ]Post</span>}, 'the picked post resolved into the page' );
  1260. like( $page, qr{<span[ ]class="each">Spec[ ]Target[ ]Post</span>}, 'and so did the whole set' );
  1261. };
  1262. subtest '/api/posts_of_form feeds the relation picker' => sub {
  1263. my $target = find_post('Spec Target Post');
  1264. ok( $target, 'the target post is there to be listed' ) or return;
  1265. my $res = Trog::Routes::JSON::posts_of_form( admin( route => '/api/posts_of_form', form => 'spec_target.tx' ) );
  1266. is( ref $res, 'ARRAY', 'a PSGI response came back' ) or return;
  1267. my ( $code, undef, $body ) = @$res;
  1268. is( $code, 200, 'and it is a 200' );
  1269. my $payload = JSON::MaybeXS::decode_json( join( '', @$body ) );
  1270. is_deeply(
  1271. $payload->{posts},
  1272. [ { id => $target->{id}, title => 'Spec Target Post' } ],
  1273. 'listing exactly the posts of that type, id and title only'
  1274. );
  1275. # An editor who is not an admin holds only acls of their own, which no
  1276. # public post carries.
  1277. $res = Trog::Routes::JSON::posts_of_form( query( user => 'spec-editor', user_acls => ['spec-editors'], route => '/api/posts_of_form', form => 'spec_target.tx' ) );
  1278. $payload = JSON::MaybeXS::decode_json( join( '', @{ $res->[2] } ) );
  1279. is_deeply( [ map { $_->{id} } @{ $payload->{posts} } ], [ $target->{id} ], 'an editor who is not an admin can pick a public post too' );
  1280. # An unknown type is an empty list, not an error -- a type with no posts
  1281. # yet is the normal state of affairs right after you create it.
  1282. $res = Trog::Routes::JSON::posts_of_form( admin( route => '/api/posts_of_form', form => 'nosuchtype.tx' ) );
  1283. $payload = JSON::MaybeXS::decode_json( join( '', @{ $res->[2] } ) );
  1284. is_deeply( $payload->{posts}, [], 'an unknown type lists nothing rather than failing' );
  1285. # The route's own declaration is what keeps a malformed form out; check it
  1286. # matches what series.json demands of child_form.
  1287. my ($form) = grep { $_->{name} eq 'form' } @{ $Trog::Routes::JSON::routes{'/api/posts_of_form'}{parameters} };
  1288. my $validator = JSON::Validator->new();
  1289. is_deeply( [ $validator->validate( 'blog.tx', $form->{schema} ) ], [], 'the parameter schema accepts a form name' );
  1290. ok( scalar $validator->validate( '../../etc/passwd', $form->{schema} ), 'and rejects a path' );
  1291. ok( $Trog::Routes::JSON::routes{'/api/posts_of_form'}{auth}, 'the route requires a login' );
  1292. };
  1293. subtest 'a series resolves its relations for logged out visitors too' => sub {
  1294. # The relations series() resolves land on the primary post, which is what a
  1295. # datasource reads to find its hypervisors -- so assert on that rather than
  1296. # on the rendered children, whose relations posts() resolves later, after
  1297. # it has widened user_acls and thus by a path that was never broken.
  1298. foreach my $case ( [ 'anonymously', anon( route => '/specrelator' ) ], [ 'as an admin', admin( route => '/specrelator' ) ] ) {
  1299. my ( $label, $query ) = @$case;
  1300. my ( $code, undef, $err ) = render( $query, \&Trog::Routes::HTML::series );
  1301. is( $code, 200, "the series renders $label" ) or do { diag($err); next };
  1302. my $resolved = $query->{primary_post}{everything};
  1303. is( ref $resolved, 'ARRAY', "$label, the series' own relation resolved" );
  1304. cmp_ok( scalar @{ $resolved || [] }, '>', 0, "$label, to something rather than nothing" );
  1305. }
  1306. };
  1307. subtest 'saves report back through the jsalert banner' => sub {
  1308. # A good save redirects to where you came from, carrying the outcome.
  1309. my $res = Trog::Routes::HTML::post_save(
  1310. admin(
  1311. route => '/post/save',
  1312. method => 'POST',
  1313. to => '/specblog',
  1314. form => 'blog.tx',
  1315. title => 'Spec Feedback Child',
  1316. data => 'Spec feedback body.',
  1317. visibility => 'public',
  1318. tags => ['specblog'],
  1319. )
  1320. );
  1321. my ( $code, $headers ) = @$res;
  1322. my %h = @{ $headers || [] };
  1323. is( $code, 303, 'a good save redirects' );
  1324. is( $h{Location}, '/secure/specblog', 'to where we came from, and nowhere else' );
  1325. # The outcome rides in a cookie, not the URL. It used to be a query
  1326. # parameter, and a save which failed with a stack trace attached built a URL
  1327. # of several thousand characters that tPSGI answered with a 419 -- so the
  1328. # user saw neither the page nor the error.
  1329. unlike( $h{Location}, qr/[?&]/, 'the URL carries no message at all' );
  1330. ok( length( $h{Location} ) < 2048, 'so it cannot outgrow what a server will accept' );
  1331. like( $h{'Set-Cookie'}, qr/^tcmsfeedback=0:/, 'the outcome is in a cookie instead' );
  1332. unlike( $h{'Set-Cookie'}, qr/\n/, 'and the message is one line, since it lands in a JS string' );
  1333. reindex();
  1334. # Follow the redirect the way a browser would: same destination, carrying
  1335. # the cookie it was just handed.
  1336. my $feedback = ( split( /;/, $h{'Set-Cookie'} ) )[0];
  1337. my ( $rcode, $body, $err ) = render(
  1338. admin( route => '/specblog', cookies => $feedback ),
  1339. \&Trog::Routes::HTML::series,
  1340. );
  1341. is( $rcode, 200, 'the destination renders' ) or diag($err);
  1342. like( $body, qr/var[ ]loginFailure[ ]=[ ]0;/, 'the banner is in success mode' );
  1343. like( $body, qr/Saved[ ]post[ ]&[#]39;Spec[ ]Feedback[ ]Child&[#]39;\./, 'and says what was saved' );
  1344. # Nothing to navigate on to, so the banner must not bounce us anywhere.
  1345. unlike( $body, qr/window\.location=/, 'and does not redirect onwards' );
  1346. # A rejected save comes back the same way, in red.
  1347. $res = Trog::Routes::HTML::post_save(
  1348. admin(
  1349. route => '/post/save',
  1350. method => 'POST',
  1351. to => '/specblog',
  1352. form => 'blog.tx',
  1353. title => 'Spec Rejected Child',
  1354. visibility => 'not-a-visibility',
  1355. tags => ['specblog'],
  1356. )
  1357. );
  1358. ( $code, $headers ) = @$res;
  1359. %h = @{ $headers || [] };
  1360. is( $code, 303, 'a rejected save redirects too, rather than dead-ending on a 400' );
  1361. is( $h{Location}, '/secure/specblog', 'to the same place a good one goes' );
  1362. like( $h{'Set-Cookie'}, qr/^tcmsfeedback=1:/, 'flagged as failed' );
  1363. like( URI::Escape::uri_unescape( $h{'Set-Cookie'} ), qr/Not[ ]in[ ]enum[ ]list/, 'carrying the validator error' );
  1364. ok( !find_post('Spec Rejected Child'), 'and the bad post was not written' );
  1365. $feedback = ( split( /;/, $h{'Set-Cookie'} ) )[0];
  1366. ( $rcode, $body, $err ) = render(
  1367. admin( route => '/specblog', cookies => $feedback ),
  1368. \&Trog::Routes::HTML::series,
  1369. );
  1370. is( $rcode, 200, 'the destination still renders' ) or diag($err);
  1371. like( $body, qr/var[ ]loginFailure[ ]=[ ]1;/, 'the banner is in failure mode' );
  1372. like( $body, qr/Not[ ]in[ ]enum[ ]list/, 'and shows why' );
  1373. # Read once: the cookie is expired by the page that rendered it, or the
  1374. # banner follows the reader around until it times out on its own.
  1375. my ( undef, undef, undef, $rheaders ) = render(
  1376. admin( route => '/specblog', cookies => $feedback ),
  1377. \&Trog::Routes::HTML::series,
  1378. );
  1379. my %rh = @{ $rheaders || [] };
  1380. like( $rh{'Set-Cookie'}, qr/^tcmsfeedback=;\N*Max-Age=0/, 'and the page that shows it expires it' );
  1381. # A page showing a banner must not be cached, or the one person who saved
  1382. # something has their message served to everybody. The query parameter
  1383. # form was accidentally safe here; a cookie is not.
  1384. my $tpsgi = Test::TPSGI->new( run_callbacks => 1 );
  1385. render( anon( route => '/specblog', cookies => $feedback, tpsgi => $tpsgi ), \&Trog::Routes::HTML::series );
  1386. is_deeply( pages_saved($tpsgi), [], 'and it is never saved as a static' );
  1387. };
  1388. subtest 'a hidden id that was never filled in' => sub {
  1389. # Every editor posts <input type="hidden" name="id"> and it is empty for a
  1390. # new post. validate() keeps an empty string for a field the schema types
  1391. # as a string, which id is, so //= saw a defined value and left it -- and
  1392. # the flat file model wrote the post to 'data/files/', the datastore
  1393. # directory rather than a post in it. The error named File::Slurper, and
  1394. # its stack trace then went into the redirect URL and produced a 419.
  1395. my $res = Trog::Routes::HTML::post_save(
  1396. admin(
  1397. route => '/post/save',
  1398. method => 'POST',
  1399. to => '/specblog',
  1400. id => '',
  1401. form => 'blog.tx',
  1402. title => 'Spec Empty Id Child',
  1403. data => 'Saved despite an empty hidden id.',
  1404. visibility => 'public',
  1405. tags => ['specblog'],
  1406. )
  1407. );
  1408. my ( $code, $headers ) = @$res;
  1409. my %h = @{ $headers || [] };
  1410. is( $code, 303, 'the save succeeds' );
  1411. like( $h{'Set-Cookie'}, qr/^tcmsfeedback=0:/, 'and reports success' );
  1412. reindex();
  1413. my $saved = find_post('Spec Empty Id Child');
  1414. ok( $saved, 'the post was written' ) or return;
  1415. ok( length( $saved->{id} // '' ), 'with an id of its own' );
  1416. isnt( $saved->{id}, '', 'rather than the empty one it was handed' );
  1417. # And the datastore directory is still a directory.
  1418. ok( -d 'data/files', 'the datastore was not written over' );
  1419. };
  1420. subtest 'the topbar did not silently overflow' => sub {
  1421. my ( $code, $body, $err ) = render( anon( route => '/' ) );
  1422. is( $code, 200, '/ renders' ) or diag($err);
  1423. my @titles = topbar_titles($body);
  1424. # 2 seeded series (Series, About) + the 7 we built. _get_series() caps at
  1425. # 10 (HTML.pm), so an eighth post type would start silently dropping one.
  1426. is( scalar @titles, 9, 'every series we made is in the topbar' )
  1427. or diag( 'topbar was: ' . join( ', ', @titles ) );
  1428. cmp_ok( scalar @titles, '<=', 10, 'and we are not at the _get_series limit' );
  1429. };
  1430. subtest 'the sitemap page' => sub {
  1431. my ( $code, undef, $err ) = render( anon( route => '/sitemap' ), \&Trog::Routes::HTML::sitemap );
  1432. is( $code, 200, 'renders' ) or diag($err);
  1433. };
  1434. subtest 'the tpsgi side effects stayed inert' => sub {
  1435. cmp_ok( $TPSGI->{restarts}, '>', 0, 'post_save did try to signal a restart' );
  1436. cmp_ok( $TPSGI->{callbacks}, '>', 0, 'and did queue post-close callbacks' );
  1437. # We never run the queued callbacks, which is what keeps save_render and
  1438. # invalidate_renders from ever firing.
  1439. is_deeply( $TPSGI->{renders}, {}, 'no static renders were written' );
  1440. is_deeply( $TPSGI->{invalidated}, [], 'and nothing was invalidated' );
  1441. my @statics = glob('www/statics/*');
  1442. is_deeply( \@statics, [], 'www/statics is empty' );
  1443. };
  1444. subtest 'the real repo was not touched' => sub {
  1445. my %after = map { snapshot("$REPO/$_") } qw{config data www/templates www/assets logs totp};
  1446. my @changed = grep { ( $REPO_BEFORE{$_} // '' ) ne ( $after{$_} // '' ) } keys %after;
  1447. my @removed = grep { !exists $after{$_} } keys %REPO_BEFORE;
  1448. is_deeply( [ sort @changed ], [], 'no repo file was added or modified' );
  1449. is_deeply( [ sort @removed ], [], 'and none were removed' );
  1450. ok( !-e "$REPO/www/templates/html/components/forms/spec_widget.tx", 'the wizard type is not in the repo' );
  1451. };
  1452. done_testing();