Merge pull request #363 from Troglodyne-Internet-Widgets/private-subs

Make private subs lexical, or public where something outside reaches them

.perlcriticrc

@@ -83,7 +83,7 @@ formats = #!/usr/bin/env perl
 [RegularExpressions::ProhibitRegexToChomp]
 [BuiltinFunctions::ProhibitChainingSameListSub]
 [RegularExpressions::ProhibitRegexForStringEquality]
-#[Subroutines::ProhibitUnderscorePrivateSubs]
+[Subroutines::ProhibitUnderscorePrivateSubs]
 #[Subroutines::ProhibitSingleUseLexicalSubs]
 #[ValuesAndExpressions::ProhibitLiteralArithmetic]
 [BuiltinFunctions::ProhibitIndirectBooleanGrep]
@@ -234,7 +234,7 @@ allow = re Exporter
 [Subroutines::ProhibitNestedSubs]
 #[Subroutines::ProhibitReturnSort]
 [Subroutines::ProhibitSubroutinePrototypes]
-#[Subroutines::ProtectPrivateSubs]
+[Subroutines::ProtectPrivateSubs]
 #[Subroutines::RequireArgUnpacking]
 [Subroutines::RequireFinalReturn]
 # tCMS: a sub that forks ends its child with POSIX::_exit, which never returns.

bin/favicon_mongler.pl

@@ -36,7 +36,7 @@ Needs inkscape on the PATH to do the rendering, and dies if it isn't there.
 
 Works with either era of inkscape.  1.0 reworked the command line and renamed
 the export flag from -e to -o, and 1.x rejects -e outright, so the version is
-read off the binary rather than assumed -- see _export_flag().
+read off the binary rather than assumed -- see export_flag().
 
 Overwrites whatever is already at those paths without asking.
 
@@ -50,7 +50,7 @@ extension.  The real container is assembled with Imager afterwards.
 # and 1.x errors out on -e rather than quietly accepting it.  Ask the binary
 # which era it belongs to instead of guessing -- this script has already been
 # flipped between the two by hand twice (e23b678, then back in 5f0cdca).
-sub _export_flag ($bin) {
+my sub export_flag ($bin) {
 
     # Shelling out, on purpose and on the record.  system() cannot hand back
     # what the child printed, and reaching for a pipe open instead would only
@@ -71,7 +71,7 @@ my $bin  = File::Which::which('inkscape');
 die "Please install inkscape" if !$bin;
 my $dir = File::Basename::dirname($icon) || die "Can't figure out dir from $icon";
 
-my $export = _export_flag($bin);
+my $export = export_flag($bin);
 
 # The sizes the site links to directly.
 my @png_sizes = qw{32 48 167 180 192 512};

bin/tcms-useradd

@@ -81,7 +81,7 @@ Display this output.
 
 # The logger is set up per-request by the server; a CLI run has to do it itself,
 # or the first thing Trog::Auth logs blows up on an undefined $log.
-sub _init_logs {
+my sub init_logs {
     my ($who) = @_;
     Trog::Log::log_init( 'logs/tcms.log', 'info' );
     $Trog::Log::user = $who // 'nobody';
@@ -91,7 +91,7 @@ sub _init_logs {
 # Read a password off the terminal without echoing it, so it stays out of the
 # shell history and off the screen.  Falls back to a plain read when we aren't
 # on a TTY, which is what makes `echo hunter2 | tcms-useradd ...` work.
-sub _read_password {
+my sub read_password {
     my ($prompt) = @_;
     my $password;
     if ( -t STDIN ) {
@@ -111,7 +111,7 @@ sub _read_password {
 
 # What a brand new user's profile post looks like before we merge anything over
 # the top of it.  Mirrors what setup() builds for the very first user.
-sub _default_user_post {
+my sub default_user_post {
     return {
         data       => 'Default user',
         preview    => '/img/avatar/humm.gif',
@@ -148,7 +148,7 @@ sub main {
     # out entirely, which means "leave the password alone".
     if ( defined $options{password} && !$options{password} ) {
         my $interactive = -t STDIN;
-        $options{password} = _read_password("New password for '$options{user}': ");
+        $options{password} = read_password("New password for '$options{user}': ");
 
         unless ( $options{password} ) {
             print STDERR "No password provided.\n";
@@ -158,7 +158,7 @@ sub main {
         # Only worth confirming when a human is typing it.  Piped input has no
         # second line to read, and typos in a script aren't fixed by asking twice.
         if ($interactive) {
-            my $again = _read_password("Confirm: ");
+            my $again = read_password("Confirm: ");
             unless ( defined $again && $options{password} eq $again ) {
                 print STDERR "Passwords did not match.\n";
                 return 2;
@@ -170,7 +170,7 @@ sub main {
     $options{acl} = [ $options{acl} ] if $options{acl} && ref $options{acl} ne 'ARRAY';
     $options{acl} = ['admin'] unless @{ $options{acl} };
 
-    _init_logs( $options{user} );
+    init_logs( $options{user} );
 
     # Find the user's existing post, if they have one.
     my $conf = Trog::Config::get();
@@ -182,7 +182,7 @@ sub main {
     # A user we've never seen before has no post to edit, so start from the
     # defaults rather than dereferencing undef.
     my $is_new = !$user_obj;
-    $user_obj //= _default_user_post();
+    $user_obj //= default_user_post();
 
     if ($is_new) {
         unless ( $options{password} && $options{display_name} && $options{contact_email} ) {

bin/tcmslogin

@@ -70,14 +70,14 @@ Display this output.
 
 # The logger is set up per-request by the server; a CLI run has to do it itself,
 # or the first thing Trog::Auth logs blows up on an undefined $log.
-sub _init_logs {
+my sub init_logs {
     my ($who) = @_;
     Trog::Log::log_init( 'logs/tcms.log', 'info' );
     $Trog::Log::user = $who // 'nobody';
     return;
 }
 
-sub _read_password {
+my sub read_password {
     my ($prompt) = @_;
     my $password;
     if ( -t STDIN ) {
@@ -112,10 +112,10 @@ sub main {
         return 2;
     }
 
-    _init_logs( $options{user} );
+    init_logs( $options{user} );
 
     # Omitted entirely or passed with no value both mean "ask me".
-    $options{password} = _read_password("Password for '$options{user}': ")
+    $options{password} = read_password("Password for '$options{user}': ")
       unless $options{password};
     unless ( $options{password} ) {
         print STDERR "No password provided.\n";

design.md

@@ -62,7 +62,7 @@ A post is a JSON object. It has a handful of fields every post has -- `id`,
 Two consequences fall out of that, and most of the system is downstream of them.
 
 **The routing table is data, not code.** Every post carries a `local_href` and a
-`callback`. At startup, `TCMS::_routes` asks the data model for every post and
+`callback`. At startup, `_routes` in TCMS.pm asks the data model for every post and
 builds the routing table out of them, then merges the static routes from
 `Trog::Routes::HTML`, `Trog::Routes::JSON` and the active theme over the top.
 Publishing a post creates a URL because the URL *is* a field on the post. There
@@ -93,7 +93,7 @@ forbid, invalidate cached renders, run work after the response is closed.
     ├──▶ Trog::Data->new(config)       ← the data model: get() the posts
     │      └──▶ Trog::DataSource       ← unless this type's posts are built, not stored
     │
-    ├──▶ _enrich_post                  ← resolve declared relations, run enrich subs
+    ├──▶ enrich_post                   ← resolve declared relations, run enrich subs
     │
     ▼
   Trog::Renderer->render(...)          ← picks a renderer by content type
@@ -234,7 +234,7 @@ of "site structure" -- there is no menu editor, because the menu is a query.
 Visibility and ACLs
 -------------------
 
-`visibility` is one of `public`, `unlisted`, `private`. `Trog::DataModule::_process`
+`visibility` is one of `public`, `unlisted`, `private`. `Trog::DataModule::process`
 folds it into the post's `tags`, along with the post's ACLs when it is private,
 and then deletes the separate `acls` field. **Tags are the whole truth about who
 may see a post**, which is why `get()` answers the `acls` filter by looking at
@@ -251,7 +251,7 @@ is chosen by `general.data_model` in the config.
 
 `Trog::DataModule` is the base class and provides the query semantics -- `get()`,
 `filter()`, `paginate()`, version rollup, validation, and the derived-field
-plumbing in `_process`. A subclass must implement `read`, `write`, `count`,
+plumbing in `process`. A subclass must implement `read`, `write`, `count`,
 `tags`, `lang` and `help`, and may override `get` if it can answer a query more
 directly than by filtering in Perl.
 
@@ -312,7 +312,7 @@ both are places the obvious implementation is wrong:
   you depend on, in which case register a `$tpsgi->add_watch` for it with a
   stable `key`, invalidate through the tPSGI object your callback is *handed*
   rather than the one it closed over, and declare `CACHEABLE`
-  (`DirIndex::_watch` is four lines of this). Or you cannot, in which case say
+  (`DirIndex::watch` is four lines of this). Or you cannot, in which case say
   nothing and your pages are never cached -- which is the default, because a
   page that is merely slow beats one that is wrong with no way of becoming
   right.
@@ -375,7 +375,7 @@ Composition: relations and enrichment
 
 Types need to refer to each other -- an invoice has a payee and a payor, which
 are `entities` posts. A type declares that in its sidecar and
-`Trog::Routes::HTML::_enrich_post` resolves it at render time:
+`Trog::Routes::HTML::enrich_post` resolves it at render time:
 
 - an entry naming a `from` field resolves the UUID in that field into the post it
   refers to;
@@ -466,14 +466,14 @@ Things that will bite you
 
 Hard-won, and none of them obvious from reading the code that contains them.
 
-- **Tags carry visibility and ACLs.** `_process` folds them in and deletes the
+- **Tags carry visibility and ACLs.** `process` folds them in and deletes the
   separate field. Anything that filters on tags is a security boundary.
 - **`get(id => ...)` deliberately skips the ACL filter.** `filter()` returns early
   for an `id`, `title` or `aclname` query, because that is how `add()` asks
   whether a post already exists. Do not "fix" it without reading every caller.
-- **Validation runs on what was submitted; `_process` then builds what gets
+- **Validation runs on what was submitted; `process` then builds what gets
   stored.** Both are checked now (`validate` and `validate_built`), and they
-  check different objects. A field that only exists after `_process` will not be
+  check different objects. A field that only exists after `process` will not be
   in the first one.
 - **The FlatFile model caches its tag list at load time** and filters each query's
   tags against it *in place*. A tag created later is not merely unindexed, it is

lib/TCMS.pm

@@ -29,6 +29,71 @@ use Trog::Vault;    ## no critic (ProhibitUnusedImports) -- loaded for what it d
 use Trog::Data;
 use Trog::Themes;
 
+#XXX Return a clone of the routing table ref, because code modifies it later
+my sub _routes ( $data = {} ) {
+    state %routes;
+    return clone( \%routes ) if %routes;
+
+    my $conf = Trog::Config::get();
+    $data = Trog::Data->new($conf) unless $data;
+
+    # Routes in general are going to override earlier, more default ones.
+    # XXX this is probably bad in the case of the specific content-typed routes, they should be mutex
+    my %roots = $data->routes();
+
+    # Setup the /secure/... versions for logged in users, except for already secured routes.
+    foreach my $route ( keys(%roots) ) {
+        next if index( $route, '/secure/' ) == 0;
+        $roots{"/secure$route"} = $roots{$route};
+    }
+
+    # It is the responsibility of theme authors to setup /secure routes (other than index)
+    my %themed = Trog::Themes::routes();
+
+    %routes                                      = %Trog::Routes::HTML::routes;
+    @routes{ keys(%Trog::Routes::JSON::routes) } = values(%Trog::Routes::JSON::routes);
+    @routes{ keys(%roots) }                      = values(%roots);
+    @routes{ keys(%themed) }                     = values(%themed) if %themed;
+
+    # Add in global routes, here because they *must* know about all other routes
+    # Also, nobody should ever override these.
+    $routes{'/robots.txt'} = {
+        method   => 'GET',
+        callback => \&robots,
+    };
+
+    # Special 'am I authenticated' route for nginx
+    $routes{'/authenticated'} = {
+        method   => 'GET',
+        nocache  => 1,
+        noindex  => 1,
+        callback => sub {
+            my ($query) = @_;
+            return $query->{tpsgi}->ok($query) if $query->{user};
+            return $query->{tpsgi}->forbidden($query);
+        },
+    };
+
+    # Heartbeat route
+    $routes{'/status'} = {
+        method   => 'GET',
+        nocache  => 1,
+        noindex  => 1,
+        callback => sub {
+            my ($query) = @_;
+            return $query->{tpsgi}->ok($query);
+        },
+    };
+
+    # The Various aliases for directory indices
+    foreach my $index (qw{ / /index.html /index.htm}) {
+        $routes{$index}          = $routes{'/index'} unless exists $routes{$index};
+        $routes{"/secure$index"} = $routes{'/index'} unless exists $routes{"/secure$index"};
+    }
+
+    return clone( \%routes );
+}
+
 # Troglodyne philosophy - simple as possible
 
 # Build routes
@@ -171,71 +236,6 @@ sub generic_route ( $rname, $code, $title, $query ) {
 our @routes  = @{ build_routes() };
 our %aliases = aliases();
 
-#XXX Return a clone of the routing table ref, because code modifies it later
-sub _routes ( $data = {} ) {
-    state %routes;
-    return clone( \%routes ) if %routes;
-
-    my $conf = Trog::Config::get();
-    $data = Trog::Data->new($conf) unless $data;
-
-    # Routes in general are going to override earlier, more default ones.
-    # XXX this is probably bad in the case of the specific content-typed routes, they should be mutex
-    my %roots = $data->routes();
-
-    # Setup the /secure/... versions for logged in users, except for already secured routes.
-    foreach my $route ( keys(%roots) ) {
-        next if index( $route, '/secure/' ) == 0;
-        $roots{"/secure$route"} = $roots{$route};
-    }
-
-    # It is the responsibility of theme authors to setup /secure routes (other than index)
-    my %themed = Trog::Themes::routes();
-
-    %routes                                      = %Trog::Routes::HTML::routes;
-    @routes{ keys(%Trog::Routes::JSON::routes) } = values(%Trog::Routes::JSON::routes);
-    @routes{ keys(%roots) }                      = values(%roots);
-    @routes{ keys(%themed) }                     = values(%themed) if %themed;
-
-    # Add in global routes, here because they *must* know about all other routes
-    # Also, nobody should ever override these.
-    $routes{'/robots.txt'} = {
-        method   => 'GET',
-        callback => \&robots,
-    };
-
-    # Special 'am I authenticated' route for nginx
-    $routes{'/authenticated'} = {
-        method   => 'GET',
-        nocache  => 1,
-        noindex  => 1,
-        callback => sub {
-            my ($query) = @_;
-            return $query->{tpsgi}->ok($query) if $query->{user};
-            return $query->{tpsgi}->forbidden($query);
-        },
-    };
-
-    # Heartbeat route
-    $routes{'/status'} = {
-        method   => 'GET',
-        nocache  => 1,
-        noindex  => 1,
-        callback => sub {
-            my ($query) = @_;
-            return $query->{tpsgi}->ok($query);
-        },
-    };
-
-    # The Various aliases for directory indices
-    foreach my $index (qw{ / /index.html /index.htm}) {
-        $routes{$index}          = $routes{'/index'} unless exists $routes{$index};
-        $routes{"/secure$index"} = $routes{'/index'} unless exists $routes{"/secure$index"};
-    }
-
-    return clone( \%routes );
-}
-
 sub aliases {
     my $conf = Trog::Config::get();
     my $data = Trog::Data->new($conf);

lib/Trog/Auth.pm

@@ -18,6 +18,13 @@ use Trog::Config;
 use Trog::SQLite;
 use Trog::Data;
 
+# Ensure the db schema is OK, and give us a handle
+my sub dbh {
+    my $file   = 'schema/auth.schema';
+    my $dbname = "config/auth.db";
+    return Trog::SQLite::dbh( $file, $dbname );
+}
+
 =head1 Trog::Auth
 
 An SQLite3 authdb.
@@ -37,7 +44,7 @@ Returns empty string on no active session.
 =cut
 
 sub session2user ($sessid) {
-    my $dbh  = _dbh();
+    my $dbh  = dbh();
     my $rows = $dbh->selectall_arrayref( "SELECT name FROM sess_user WHERE session=?", { Slice => {} }, $sessid );
     return '' unless ref $rows eq 'ARRAY' && @$rows;
     return $rows->[0]->{name};
@@ -51,7 +58,7 @@ If the user has an active session, things like password reset requests should fa
 =cut
 
 sub user_has_session ($user) {
-    my $dbh  = _dbh();
+    my $dbh  = dbh();
     my $rows = $dbh->selectall_arrayref( "SELECT session FROM sess_user WHERE name=?", { Slice => {} }, $user );
     return 0 unless ref $rows eq 'ARRAY' && @$rows;
     return 1;
@@ -64,7 +71,7 @@ Return whether the user exists at all.
 =cut
 
 sub user_exists ($user) {
-    my $dbh  = _dbh();
+    my $dbh  = dbh();
     my $rows = $dbh->selectall_arrayref( "SELECT name FROM user WHERE name=?", { Slice => {} }, $user );
     return 0 unless ref $rows eq 'ARRAY' && @$rows;
     return 1;
@@ -77,7 +84,7 @@ Returns the oldest user with the admin ACL.
 =cut
 
 sub primary_user {
-    my $dbh  = _dbh();
+    my $dbh  = dbh();
     my $rows = $dbh->selectall_arrayref( "SELECT username FROM user_acl WHERE acl='admin' LIMIT 1", { Slice => {} } );
     return 0 unless ref $rows eq 'ARRAY' && @$rows;
     return $rows->[0]{username};
@@ -90,7 +97,7 @@ Fetch existing settings for a user.
 =cut
 
 sub get_existing_user_data ($user) {
-    my $dbh  = _dbh();
+    my $dbh  = dbh();
     my $rows = $dbh->selectall_arrayref( "SELECT hash, salt, totp_secret, display_name, contact_email FROM user WHERE name=?", { Slice => {} }, $user );
     return ( undef, undef, undef ) unless ref $rows eq 'ARRAY' && @$rows;
     return ( $rows->[0]{hash}, $rows->[0]{salt}, $rows->[0]{totp_secret}, $rows->[0]{display_name}, $rows->[0]{contact_email} );
@@ -103,21 +110,21 @@ Return the associated contact email for the user.
 =cut
 
 sub email4user ($user) {
-    my $dbh  = _dbh();
+    my $dbh  = dbh();
     my $rows = $dbh->selectall_arrayref( "SELECT contact_email FROM user WHERE name=?", { Slice => {} }, $user );
     return '' unless ref $rows eq 'ARRAY' && @$rows;
     return $rows->[0]{contact_email};
 }
 
 sub display2username ($display_name) {
-    my $dbh  = _dbh();
+    my $dbh  = dbh();
     my $rows = $dbh->selectall_arrayref( "SELECT name FROM user WHERE display_name=?", { Slice => {} }, $display_name );
     return '' unless ref $rows eq 'ARRAY' && @$rows;
     return $rows->[0]{name};
 }
 
 sub username2display ($name) {
-    my $dbh  = _dbh();
+    my $dbh  = dbh();
     my $rows = $dbh->selectall_arrayref( "SELECT display_name FROM user WHERE name=?", { Slice => {} }, $name );
     return '' unless ref $rows eq 'ARRAY' && @$rows;
     return $rows->[0]{display_name};
@@ -151,7 +158,7 @@ The 'admin' ACL is the only special one, as it allows for authoring posts, confi
 =cut
 
 sub acls4user ($username) {
-    my $dbh     = _dbh();
+    my $dbh     = dbh();
     my $records = $dbh->selectall_arrayref( "SELECT acl FROM user_acl WHERE username = ?", { Slice => {} }, $username );
 
     return () unless ref $records eq 'ARRAY' && @$records;
@@ -159,6 +166,16 @@ sub acls4user ($username) {
     return \@acls;
 }
 
+my sub _totp {
+    state $totp;
+    if ( !$totp ) {
+        $totp = Trog::TOTP->new();
+        die "Cannot instantiate TOTP client!" unless $totp;
+        $totp->{DEBUG} = 1 if is_debug();
+    }
+    return $totp;
+}
+
 =head2 totp(user, domain)
 
 Enable TOTP 2fa for the specified user, or if already enabled return the existing info.
@@ -182,7 +199,7 @@ sub totp ( $user, $domain ) {
     return ( undef, undef, 1, "Refusing to build a TOTP QR for unsafe domain '" . ( $domain // '' ) . "'." ) unless $safe_domain;
 
     my $totp = _totp();
-    my $dbh  = _dbh();
+    my $dbh  = dbh();
 
     my $failure = 0;
     my $message = "TOTP Secret generated successfully.";
@@ -244,16 +261,6 @@ sub totp ( $user, $domain ) {
     return ( $uri, $qr, $failure, $message, $totp );
 }
 
-sub _totp {
-    state $totp;
-    if ( !$totp ) {
-        $totp = Trog::TOTP->new();
-        die "Cannot instantiate TOTP client!" unless $totp;
-        $totp->{DEBUG} = 1 if is_debug();
-    }
-    return $totp;
-}
-
 =head2 has_totp(user) = BOOL
 
 Whether this user has enrolled in TOTP yet.
@@ -270,7 +277,7 @@ is the same enrolment rather than a new one.
 =cut
 
 sub has_totp ($user) {
-    my $dbh  = _dbh();
+    my $dbh  = dbh();
     my $rows = $dbh->selectall_arrayref( "SELECT totp_secret FROM user WHERE name=?", { Slice => {} }, $user );
     return 0 unless ref $rows eq 'ARRAY' && @$rows;
     return $rows->[0]{totp_secret} ? 1 : 0;
@@ -305,7 +312,7 @@ our $totp_digits    = 6;
 sub spend_totp ( $user, $code ) {
     return ( 0, 'no code given' ) unless defined $code && $code =~ m/^[0-9]{$totp_digits}$/;
 
-    my $dbh    = _dbh();
+    my $dbh    = dbh();
     my $rows   = $dbh->selectall_arrayref( "SELECT totp_secret FROM user WHERE name=?", { Slice => {} }, $user );
     my $secret = ref $rows eq 'ARRAY' && @$rows ? $rows->[0]{totp_secret} : undef;
     return ( 0, 'this user has no second factor enrolled' ) unless $secret;
@@ -377,10 +384,26 @@ our $argon2_lanes   = 1;
 our $argon2_tag     = 32;
 our $argon2_saltlen = 16;
 
+# The hash and the salt that goes with it.  Argon2 carries the salt in its own
+# encoding as well; the column keeps it because the rows which have not been
+# upgraded yet are still using it for what it was for.
+my sub hash_password ($pass) {
+    my $salt = Trog::Utils::uuid();
+    $salt = substr( $salt, 0, $argon2_saltlen );
+    return ( argon2id_pass( $pass, $salt, $argon2_time, $argon2_memory, $argon2_lanes, $argon2_tag ), $salt );
+}
+
+my sub store_password ( $user, $pass ) {
+    my ( $hash, $salt ) = hash_password($pass);
+    my $dbh = dbh();
+    $dbh->do( "UPDATE user SET hash=?, salt=? WHERE name=?", undef, $hash, $salt, $user );
+    return 1;
+}
+
 sub check_password ( $user, $pass ) {
     return 0 unless $pass;
 
-    my $dbh  = _dbh();
+    my $dbh  = dbh();
     my $rows = $dbh->selectall_arrayref( "SELECT hash, salt FROM user WHERE name = ?", { Slice => {} }, $user );
     return 0 unless ref $rows eq 'ARRAY' && @$rows;
 
@@ -392,30 +415,14 @@ sub check_password ( $user, $pass ) {
 
         # Cheap, and it is the only time we hold the password, so it is the only
         # time the cost of a stronger hash can be paid.
-        _store_password( $user, $pass )
+        store_password( $user, $pass )
           if argon2_needs_rehash( $hash, 'argon2id', $argon2_time, $argon2_memory, $argon2_lanes, $argon2_tag, $argon2_saltlen );
         return 1;
     }
 
     return 0 unless sha256( $pass . ( $salt // '' ) ) eq $hash;
     INFO("Upgrading the stored password for $user from sha256 to argon2id");
-    _store_password( $user, $pass );
-    return 1;
-}
-
-# The hash and the salt that goes with it.  Argon2 carries the salt in its own
-# encoding as well; the column keeps it because the rows which have not been
-# upgraded yet are still using it for what it was for.
-sub _hash_password ($pass) {
-    my $salt = Trog::Utils::uuid();
-    $salt = substr( $salt, 0, $argon2_saltlen );
-    return ( argon2id_pass( $pass, $salt, $argon2_time, $argon2_memory, $argon2_lanes, $argon2_tag ), $salt );
-}
-
-sub _store_password ( $user, $pass ) {
-    my ( $hash, $salt ) = _hash_password($pass);
-    my $dbh = _dbh();
-    $dbh->do( "UPDATE user SET hash=?, salt=? WHERE name=?", undef, $hash, $salt, $user );
+    store_password( $user, $pass );
     return 1;
 }
 
@@ -428,7 +435,7 @@ Returns a session ID, or blank string in the event the user does not exist or in
 =cut
 
 sub mksession ( $user, $pass, $token, $ip_addr = '' ) {
-    my $dbh = _dbh();
+    my $dbh = dbh();
 
     my $records = $dbh->selectall_arrayref( "SELECT name, hash, salt, totp_secret FROM user WHERE name = ?", { Slice => {} }, $user );
     if ( !( ref $records eq 'ARRAY' && @$records ) || !check_password( $user, $pass ) ) {
@@ -466,7 +473,7 @@ Delete the provided user's session from the auth db.
 =cut
 
 sub killsession ( $user, $ip_addr = '' ) {
-    my $dbh = _dbh();
+    my $dbh = dbh();
     $dbh->do( "DELETE FROM session WHERE username=?", undef, $user );
     log_event( 'logout', $user, $ip_addr );
     return 1;
@@ -496,8 +503,8 @@ sub useradd ( $user, $displayname, $pass, $acls, $contactemail ) {
     die "ACLs must be array"             unless is_arrayref($acls);
     die "No contact email set for user!" unless $contactemail;
 
-    my $dbh = _dbh();
-    ( $hash, $salt ) = _hash_password($pass) if $pass;
+    my $dbh = dbh();
+    ( $hash, $salt ) = hash_password($pass) if $pass;
     $dbh->do( "INSERT OR REPLACE INTO user (name, display_name, salt, hash, contact_email, totp_secret) VALUES (?,?,?,?,?,?)", undef, $user, $displayname, $salt, $hash, $contactemail, $t_secret );
 
     #XXX this is clearly not normalized with an ACL mapping table, will be an issue with large number of users
@@ -508,13 +515,13 @@ sub useradd ( $user, $displayname, $pass, $acls, $contactemail ) {
 }
 
 sub add_change_request (%args) {
-    my $dbh = _dbh();
+    my $dbh = dbh();
     $dbh->do( "INSERT INTO change_request (username,token,type,secret) VALUES (?,?,?,?)", undef, $args{user}, $args{token}, $args{type}, $args{secret} );
     return 1;
 }
 
 sub process_change_request ($token) {
-    my $dbh  = _dbh();
+    my $dbh  = dbh();
     my $rows = $dbh->selectall_arrayref( "SELECT username, display_name, type, secret, contact_email FROM change_request_full WHERE processed=0 AND token=?", { Slice => {} }, $token );
     return 0 unless ref $rows eq 'ARRAY' && @$rows;
 
@@ -551,7 +558,7 @@ Supports filtering by C<username>, C<event_type>, and C<limit> (default 100).
 =cut
 
 sub audit_log (%opts) {
-    my $dbh   = _dbh();
+    my $dbh   = dbh();
     my $limit = int( $opts{limit} // 100 );
     my @where;
     my @bind;
@@ -589,7 +596,7 @@ would be a worse outcome than a login nobody wrote down.
 
 sub log_event ( $event_type, $username, $ip_addr = '', $session_id = undef ) {
     eval {
-        my $dbh = _dbh();
+        my $dbh = dbh();
         $dbh->do(
             "INSERT INTO audit_log (event_time, username, session_id, ip_addr, event_type) VALUES (?,?,?,?,?)",
             undef, time(), $username, $session_id, $ip_addr, $event_type
@@ -607,7 +614,7 @@ Return all users and their contact emails, for use in libravatar lookups.
 
 #XXX it may be worth using the sqlite extension to do SHA hashing here to speed up lookups.
 sub users_with_emails {
-    my $dbh  = _dbh();
+    my $dbh  = dbh();
     my $rows = $dbh->selectall_arrayref(
         "SELECT name, contact_email FROM user WHERE contact_email IS NOT NULL AND contact_email != ''",
         { Slice => {} }
@@ -615,11 +622,4 @@ sub users_with_emails {
     return ref $rows eq 'ARRAY' ? $rows : [];
 }
 
-# Ensure the db schema is OK, and give us a handle
-sub _dbh {
-    my $file   = 'schema/auth.schema';
-    my $dbname = "config/auth.db";
-    return Trog::SQLite::dbh( $file, $dbname );
-}
-
 1;

lib/Trog/Component.pm

@@ -47,39 +47,34 @@ our $depth     = 0;
 # does not stop an Xslate render.  Always read through a local() in the caller.
 our $error;
 
-=head2 component($name, $args) = STRING
-
-Render the named component, marked raw so that callers need no C<| mark_raw>.
+# Resolved at call time rather than compile time, so that components are free to
+# use Trog::Renderer without cycling back through us.  require() memoizes in
+# %INC; %loaded only saves us the repeat eval and string munging.
+my sub load ($name) {
+    state %loaded;
 
-$name is one flat namespace level under Trog::Component -- word characters only.
-It becomes a path handed to require(), so this is what stops a template naming
-its way out of Trog/Component/.
+    die "Component name must be given\n"   unless $name;
+    die "Invalid component name '$name'\n" unless $name =~ m/^[A-Za-z][A-Za-z0-9_]*$/;
 
-$args is an optional HASHREF, flattened into the component's render().  Nullary
-components simply ignore it.
+    my $module = "Trog::Component::$name";
+    return $module if $loaded{$module};
 
-=cut
+    local $@;
+    eval {
+        require "Trog/Component/$name.pm";    ## no critic (RequireBarewordIncludes) -- $name is validated above
+        1;
+    } or do {
+        die "Could not load component '$name': $@";
+    };
 
-sub component ( $name, $args = {} ) {
-    my ( $out, $err );
-    {
-        local $@;
-        $out = eval { _component( $name, $args ) };
-        $err = $@;
-    }
-    return $out if defined $out;
+    die "Component '$name' has no render()\n" unless $module->can('render');
 
-    # Record as well as rethrow: the die on its own gets swallowed by Xslate.
-    # First failure wins, as the ones after it tend to be consequences of it.
-    # The throw uses our own error rather than $error, so a direct caller is
-    # told what *it* did even when something earlier left a record behind.
-    $err ||= "Component '$name' failed for no stated reason\n";
-    $error //= $err;
-    die $err;
+    $loaded{$module} = 1;
+    return $module;
 }
 
-sub _component ( $name, $args ) {
-    my $module = _load($name);
+my sub _component ( $name, $args ) {
+    my $module = load($name);
 
     die "Component '$name' recursed more than $MAX_DEPTH deep\n" if $depth >= $MAX_DEPTH;
     local $depth = $depth + 1;
@@ -104,6 +99,37 @@ sub _component ( $name, $args ) {
     return Text::Xslate::mark_raw($out);
 }
 
+=head2 component($name, $args) = STRING
+
+Render the named component, marked raw so that callers need no C<| mark_raw>.
+
+$name is one flat namespace level under Trog::Component -- word characters only.
+It becomes a path handed to require(), so this is what stops a template naming
+its way out of Trog/Component/.
+
+$args is an optional HASHREF, flattened into the component's render().  Nullary
+components simply ignore it.
+
+=cut
+
+sub component ( $name, $args = {} ) {
+    my ( $out, $err );
+    {
+        local $@;
+        $out = eval { _component( $name, $args ) };
+        $err = $@;
+    }
+    return $out if defined $out;
+
+    # Record as well as rethrow: the die on its own gets swallowed by Xslate.
+    # First failure wins, as the ones after it tend to be consequences of it.
+    # The throw uses our own error rather than $error, so a direct caller is
+    # told what *it* did even when something earlier left a record behind.
+    $err ||= "Component '$name' failed for no stated reason\n";
+    $error //= $err;
+    die $err;
+}
+
 =head2 render_template($template, $data) = STRING
 
 Render a component template and hand back the body, for the many components
@@ -132,30 +158,4 @@ sub render_template ( $template, $data = {} ) {
     return $out;
 }
 
-# Resolved at call time rather than compile time, so that components are free to
-# use Trog::Renderer without cycling back through us.  require() memoizes in
-# %INC; %loaded only saves us the repeat eval and string munging.
-sub _load ($name) {
-    state %loaded;
-
-    die "Component name must be given\n"   unless $name;
-    die "Invalid component name '$name'\n" unless $name =~ m/^[A-Za-z][A-Za-z0-9_]*$/;
-
-    my $module = "Trog::Component::$name";
-    return $module if $loaded{$module};
-
-    local $@;
-    eval {
-        require "Trog/Component/$name.pm";    ## no critic (RequireBarewordIncludes) -- $name is validated above
-        1;
-    } or do {
-        die "Could not load component '$name': $@";
-    };
-
-    die "Component '$name' has no render()\n" unless $module->can('render');
-
-    $loaded{$module} = 1;
-    return $module;
-}
-
 1;

lib/Trog/Data/FlatFile.pm

@@ -36,6 +36,14 @@ our $parser = JSON::MaybeXS->new( utf8 => 1 );
 our @tags = Trog::SQLite::TagIndex::tags();
 our %posts_by_tag;
 
+my sub _index {
+    confess "Can't find datastore in $datastore !" unless -d $datastore;
+    opendir( my $dh, $datastore ) or confess;
+    my @index = grep { -f } map { "$datastore/$_" } readdir $dh;    ## no critic (ProhibitFiletest_f) -- listing names, nothing is opened
+    closedir $dh;
+    return sort { $b cmp $a } @index;
+}
+
 sub read ( $self, $query = {} ) {
     $query->{limit} //= 25;
 
@@ -68,7 +76,7 @@ sub read ( $self, $query = {} ) {
             @index = map { "$datastore/$_" } Trog::SQLite::TagIndex::posts_for_tags( @{ $query->{tags} } );
             $posts_by_tag{$tagkey} = \@index;
         }
-        @index = $self->_index() unless @index;
+        @index = _index() unless @index;
     }
 
     my @items;
@@ -118,14 +126,6 @@ sub read ( $self, $query = {} ) {
     return \@items;
 }
 
-sub _index {
-    confess "Can't find datastore in $datastore !" unless -d $datastore;
-    opendir( my $dh, $datastore ) or confess;
-    my @index = grep { -f } map { "$datastore/$_" } readdir $dh;    ## no critic (ProhibitFiletest_f) -- listing names, nothing is opened
-    closedir $dh;
-    return sort { $b cmp $a } @index;
-}
-
 sub routes {
     return Trog::SQLite::TagIndex::routes();
 }
@@ -182,8 +182,8 @@ sub write ( $self, $data ) {
     return 1;
 }
 
-sub count ($self) {
-    my @index = $self->_index();
+sub count {
+    my @index = _index();
     return scalar(@index);
 }
 

lib/Trog/Data/SQLite.pm

@@ -33,7 +33,7 @@ source of truth, the projections cost no storage, and they cannot drift from
 what they were drawn from.
 
 What that buys is get(): the filtering Trog::DataModule::filter() does in Perl
-over every post on disk happens here in one indexed query.  See _where() for
+over every post on disk happens here in one indexed query.  See where() for
 the mapping, which is filter() clause for clause.
 
 Adding a queryable field is one ALTER TABLE and one CREATE INDEX, with no
@@ -50,7 +50,7 @@ which mean there is no data model to serve from.
 
 =cut
 
-sub _dbh {
+sub dbh {
     return Trog::SQLite::dbh( $schema, $dbname );
 }
 
@@ -62,7 +62,7 @@ Trog::DataModule::get() without the filtering pass: the query does that.
 
 Everything filter() would have grepped for is a WHERE clause, and paginate()'s
 slice is LIMIT/OFFSET, so what comes back out of the database is already the
-answer.  _fixup() still runs, as that fills in display fields rather than
+answer.  fixup() still runs, as that fills in display fields rather than
 choosing rows.
 
 =cut
@@ -71,61 +71,20 @@ sub get ( $self, %request ) {
     my $posts = $self->read( \%request );
     return @$posts if $request{raw};
 
-    return $self->_fixup(@$posts);
+    return $self->fixup(@$posts);
 }
 
-=head2 read($query) = ARRAYREF $posts
-
-The rows a query selects, decoded back into posts.
-
-With C<raw>, every version of everything the query matches, untouched -- that is
-what an index build or a version history wants.  Otherwise one post per id: the
-newest version, carrying the version_max, created, modified and author fields
-that Trog::DataModule::_dedup_versions() would have computed by hand.
-
-=cut
-
-sub read ( $, $query = {} ) {
-    my ( $sql, @bind ) = _build_query($query) or return [];
-
-    my $rows = _dbh()->selectall_arrayref( $sql, { Slice => {} }, @bind );
-    return [] unless ref $rows eq 'ARRAY';
-
-    my @posts;
-    foreach my $row (@$rows) {
-        my $post = eval { $parser->decode( $row->{post_data} ) };
-        if ( !$post ) {
-            WARN("Could not decode post '$row->{uuid}' version $row->{version}: $@");
-            next;
-        }
-        if ( !$query->{raw} ) {
-
-            # What _dedup_versions() works out by sorting the versions in Perl.
-            # Deliberately the same shape, so a caller cannot tell which data
-            # model answered it.
-            $post->{version_max} = $row->{version_max};
-
-            # Only when we were not asked for one version in particular.
-            # _dedup_versions() rewrites these from the version history, and a
-            # request for version 3 wants version 3's own dates, not the post's.
-            if ( !_pinned($query) ) {
-                $post->{modified} = $post->{created};
-                $post->{created}  = $row->{first_created};
-                $post->{author}   = $row->{first_author};
-            }
-        }
-
-        push( @posts, $post );
-    }
-
-    return \@posts;
+# Whether the caller named a version.  Empty string counts as unasked, since
+# that is what a form posts for a field nobody filled in.
+my sub pinned ($query) {
+    return defined $query->{version} && $query->{version} ne '';
 }
 
 # One version of one post per row, so "the current post" is a join against
 # post_versions, which the schema's triggers keep pointing at the newest row for
-# each uuid.  f is the oldest version, which is where _dedup_versions() takes
+# each uuid.  f is the oldest version, which is where dedup_versions() takes
 # the post's own birthday and original author from.
-sub _from_clause {
+my sub from_clause {
     return q{
         FROM posts p
         JOIN post_versions v ON v.uuid = p.uuid
@@ -133,54 +92,64 @@ sub _from_clause {
     };
 }
 
-# Whether the caller named a version.  Empty string counts as unasked, since
-# that is what a form posts for a field nobody filled in.
-sub _pinned ($query) {
-    return defined $query->{version} && $query->{version} ne '';
+# A post is only visible to a caller holding one of its tags, since visibility
+# and acls are both stored as tags.  admin skips it, as it does in filter().
+# False when the caller can see nothing at all, so there is nothing to query.
+my sub acl_clause ( $query, $where, $bind ) {
+
+    # raw skips filter() altogether in the flat file model, acls included.
+    # Only bin/migrate.pl and an index rebuild ask for it.
+    return 1 if $query->{raw};
+
+    my $acls = ref $query->{acls} eq 'ARRAY' ? $query->{acls} : [];
+    return 0 unless @$acls;
+    return 1 if any { $_ eq 'admin' } @$acls;
+
+    my $binds = join( ',', map { '?' } @$acls );
+    push( @$where, "p.id IN (SELECT post_id FROM post_tags WHERE tag IN ($binds))" );
+    push( @$bind,  @$acls );
+    return 1;
 }
 
-sub _build_query ($query) {
-    my $select = q{SELECT p.post_data, p.uuid, p.version, v.version_max, v.first_created, f.author AS first_author};
+=head2 like_clause($term)
 
-    my ( $where, $bind ) = _where($query) or return;
+The 'like' filter: a case insensitive substring match over a post's title and
+its content.
 
-    # A raw read with no filters has no clauses at all, and "WHERE" on its own
-    # is a syntax error rather than "everything".
-    push( @$where, '1 = 1' ) unless @$where;
+Answered by the FTS5 index, which is built with the trigram tokenizer precisely
+so that substring is a thing it can answer.  The term goes in as a quoted
+phrase, doubling any quote in it, so that a search for C<AND> or C<"> is a
+search for that text rather than FTS5 query syntax the user did not ask for.
 
-    my $sql = "$select " . _from_clause() . " WHERE " . join( ' AND ', @$where );
+Trigram indexes nothing shorter than three characters, so shorter terms fall
+back to a LIKE scan.  That is the slow path, and it is the only one -- but a one
+or two character search matches most of the site anyway.
 
-    # Newest first, by the same date the caller gets back as created -- the
-    # post's birthday.  The flat file model returned posts in readdir order,
-    # which is to say whatever order the filesystem felt like; every caller that
-    # cared went through the tag index, which ordered by created DESC.
-    $sql .= ' ORDER BY v.first_created DESC, p.uuid DESC';
+=cut
 
-    # 0 means unlimited, as it does in the flat file model.
-    my @extra;
-    my $limit = defined $query->{limit} ? int( $query->{limit} ) : 25;
-    if ($limit) {
-        $sql .= ' LIMIT ?';
-        push( @extra, $limit );
-        if ( $query->{page} ) {
-            $sql .= ' OFFSET ?';
-            push( @extra, ( int( $query->{page} ) - 1 ) * $limit );
-        }
+my sub like_clause ($term) {
+
+    if ( length($term) < 3 ) {
+        my $escaped = $term;
+        $escaped =~ s/([\\%_])/\\$1/g;
+        return ( "(p.title LIKE ? ESCAPE '\\' OR p.data LIKE ? ESCAPE '\\')", "%$escaped%", "%$escaped%" );
     }
 
-    return ( $sql, @$bind, @extra );
+    my $phrase = $term;
+    $phrase =~ s/"/""/g;
+    return ( 'p.id IN (SELECT rowid FROM posts_fts WHERE posts_fts MATCH ?)', qq{"$phrase"} );
 }
 
 # filter(), clause for clause.  Read the two side by side when changing either.
 # Returns nothing when no post can match, and then there is no query to run.
-sub _where ($query) {
+my sub where ($query) {
     my ( @where, @bind );
 
     # Which versions are in play.  Everything else filters within that.
     #
     # raw is the exception: it means "the history, as stored", which is what a
     # migration or an index rebuild reads, so it pins nothing.
-    if ( _pinned($query) ) {
+    if ( pinned($query) ) {
         push( @where, 'p.version = ?' );
         push( @bind,  int( $query->{version} ) );
     }
@@ -196,12 +165,12 @@ sub _where ($query) {
         my $column = $key eq 'id' ? 'p.uuid' : "p.$key";
         push( @where, "$column = ?" );
         push( @bind,  $query->{$key} );
-        return unless _acl_clause( $query, \@where, \@bind );
+        return unless acl_clause( $query, \@where, \@bind );
         return ( \@where, \@bind );
     }
 
     # Against the first version's date, not this row's.  filter() applies these
-    # after _dedup_versions() has already rewritten created to the oldest
+    # after dedup_versions() has already rewritten created to the oldest
     # version's, so older/newer have always meant the post's birthday rather
     # than the date of its most recent edit.
     if ( $query->{older} ) {
@@ -230,7 +199,7 @@ sub _where ($query) {
         push( @bind,  @{ $query->{exclude_tags} } );
     }
 
-    return unless _acl_clause( $query, \@where, \@bind );
+    return unless acl_clause( $query, \@where, \@bind );
 
     if ( $query->{form} ) {
         push( @where, 'COALESCE(p.form, ?) = ?' );
@@ -243,7 +212,7 @@ sub _where ($query) {
     }
 
     if ( ( $query->{like} // q{} ) ne q{} ) {
-        my ( $clause, @like_bind ) = _like_clause( $query->{like} );
+        my ( $clause, @like_bind ) = like_clause( $query->{like} );
         push( @where, $clause );
         push( @bind,  @like_bind );
     }
@@ -251,81 +220,86 @@ sub _where ($query) {
     return ( \@where, \@bind );
 }
 
-# A post is only visible to a caller holding one of its tags, since visibility
-# and acls are both stored as tags.  admin skips it, as it does in filter().
-# False when the caller can see nothing at all, so there is nothing to query.
-sub _acl_clause ( $query, $where, $bind ) {
-
-    # raw skips filter() altogether in the flat file model, acls included.
-    # Only bin/migrate.pl and an index rebuild ask for it.
-    return 1 if $query->{raw};
-
-    my $acls = ref $query->{acls} eq 'ARRAY' ? $query->{acls} : [];
-    return 0 unless @$acls;
-    return 1 if any { $_ eq 'admin' } @$acls;
+my sub build_query ($query) {
+    my $select = q{SELECT p.post_data, p.uuid, p.version, v.version_max, v.first_created, f.author AS first_author};
 
-    my $binds = join( ',', map { '?' } @$acls );
-    push( @$where, "p.id IN (SELECT post_id FROM post_tags WHERE tag IN ($binds))" );
-    push( @$bind,  @$acls );
-    return 1;
-}
+    my ( $where, $bind ) = where($query) or return;
 
-=head2 _like_clause($term)
+    # A raw read with no filters has no clauses at all, and "WHERE" on its own
+    # is a syntax error rather than "everything".
+    push( @$where, '1 = 1' ) unless @$where;
 
-The 'like' filter: a case insensitive substring match over a post's title and
-its content.
+    my $sql = "$select " . from_clause() . " WHERE " . join( ' AND ', @$where );
 
-Answered by the FTS5 index, which is built with the trigram tokenizer precisely
-so that substring is a thing it can answer.  The term goes in as a quoted
-phrase, doubling any quote in it, so that a search for C<AND> or C<"> is a
-search for that text rather than FTS5 query syntax the user did not ask for.
+    # Newest first, by the same date the caller gets back as created -- the
+    # post's birthday.  The flat file model returned posts in readdir order,
+    # which is to say whatever order the filesystem felt like; every caller that
+    # cared went through the tag index, which ordered by created DESC.
+    $sql .= ' ORDER BY v.first_created DESC, p.uuid DESC';
 
-Trigram indexes nothing shorter than three characters, so shorter terms fall
-back to a LIKE scan.  That is the slow path, and it is the only one -- but a one
-or two character search matches most of the site anyway.
+    # 0 means unlimited, as it does in the flat file model.
+    my @extra;
+    my $limit = defined $query->{limit} ? int( $query->{limit} ) : 25;
+    if ($limit) {
+        $sql .= ' LIMIT ?';
+        push( @extra, $limit );
+        if ( $query->{page} ) {
+            $sql .= ' OFFSET ?';
+            push( @extra, ( int( $query->{page} ) - 1 ) * $limit );
+        }
+    }
 
-=cut
+    return ( $sql, @$bind, @extra );
+}
 
-sub _like_clause ($term) {
+=head2 read($query) = ARRAYREF $posts
 
-    if ( length($term) < 3 ) {
-        my $escaped = $term;
-        $escaped =~ s/([\\%_])/\\$1/g;
-        return ( "(p.title LIKE ? ESCAPE '\\' OR p.data LIKE ? ESCAPE '\\')", "%$escaped%", "%$escaped%" );
-    }
+The rows a query selects, decoded back into posts.
 
-    my $phrase = $term;
-    $phrase =~ s/"/""/g;
-    return ( 'p.id IN (SELECT rowid FROM posts_fts WHERE posts_fts MATCH ?)', qq{"$phrase"} );
-}
+With C<raw>, every version of everything the query matches, untouched -- that is
+what an index build or a version history wants.  Otherwise one post per id: the
+newest version, carrying the version_max, created, modified and author fields
+that Trog::DataModule::dedup_versions() would have computed by hand.
 
-=head1 WRITING
+=cut
 
-=head2 write($posts)
+sub read ( $, $query = {} ) {
+    my ( $sql, @bind ) = build_query($query) or return [];
 
-Insert each post as a new row.
+    my $rows = dbh()->selectall_arrayref( $sql, { Slice => {} }, @bind );
+    return [] unless ref $rows eq 'ARRAY';
 
-No read-modify-write, and so nothing to lose: the flat file model had to take a
-lock around rewriting the whole version history of a post, because the history
-was the file.  Here a version is a row, and the unique index on (uuid, version)
-is what rejects two workers writing the same version rather than one of them
-silently winning.
+    my @posts;
+    foreach my $row (@$rows) {
+        my $post = eval { $parser->decode( $row->{post_data} ) };
+        if ( !$post ) {
+            WARN("Could not decode post '$row->{uuid}' version $row->{version}: $@");
+            next;
+        }
+        if ( !$query->{raw} ) {
 
-Several posts go in as one transaction, so a batch either lands or it doesn't --
-add() hands us everything it was given at once, and half a save is not a state
-anybody asked for.  It is also the difference between a migration taking seconds
-and taking minutes, since SQLite otherwise commits once per row.
+            # What dedup_versions() works out by sorting the versions in Perl.
+            # Deliberately the same shape, so a caller cannot tell which data
+            # model answered it.
+            $post->{version_max} = $row->{version_max};
 
-=cut
+            # Only when we were not asked for one version in particular.
+            # dedup_versions() rewrites these from the version history, and a
+            # request for version 3 wants version 3's own dates, not the post's.
+            if ( !pinned($query) ) {
+                $post->{modified} = $post->{created};
+                $post->{created}  = $row->{first_created};
+                $post->{author}   = $row->{first_author};
+            }
+        }
 
-sub write ( $, $data ) {
-    my $dbh = _dbh();
+        push( @posts, $post );
+    }
 
-    Trog::SQLite::transaction( $dbh, sub { _insert( $dbh, $data ) } );
-    return 1;
+    return \@posts;
 }
 
-sub _insert ( $dbh, $data ) {
+my sub insert ( $dbh, $data ) {
     my $insert = $dbh->prepare('INSERT INTO posts (post_data) VALUES (?)');
 
     foreach my $post (@$data) {
@@ -347,6 +321,32 @@ sub _insert ( $dbh, $data ) {
     return 1;
 }
 
+=head1 WRITING
+
+=head2 write($posts)
+
+Insert each post as a new row.
+
+No read-modify-write, and so nothing to lose: the flat file model had to take a
+lock around rewriting the whole version history of a post, because the history
+was the file.  Here a version is a row, and the unique index on (uuid, version)
+is what rejects two workers writing the same version rather than one of them
+silently winning.
+
+Several posts go in as one transaction, so a batch either lands or it doesn't --
+add() hands us everything it was given at once, and half a save is not a state
+anybody asked for.  It is also the difference between a migration taking seconds
+and taking minutes, since SQLite otherwise commits once per row.
+
+=cut
+
+sub write ( $, $data ) {
+    my $dbh = dbh();
+
+    Trog::SQLite::transaction( $dbh, sub { insert( $dbh, $data ) } );
+    return 1;
+}
+
 =head2 versions_present() = HASHREF
 
 Every (uuid, version) already stored, as C<< { uuid => { version => 1 } } >>.
@@ -357,7 +357,7 @@ whether it has seen it before.  See bin/migrate.pl.
 =cut
 
 sub versions_present {
-    my $rows = _dbh()->selectall_arrayref( 'SELECT uuid, version FROM posts', { Slice => {} } ) // [];
+    my $rows = dbh()->selectall_arrayref( 'SELECT uuid, version FROM posts', { Slice => {} } ) // [];
 
     my %present;
     $present{ $_->{uuid} }{ $_->{version} } = 1 foreach @$rows;
@@ -372,7 +372,7 @@ and the search index with them.
 =cut
 
 sub delete ( $, @posts ) {
-    my $dbh    = _dbh();
+    my $dbh    = dbh();
     my $delete = $dbh->prepare('DELETE FROM posts WHERE uuid = ?');
 
     $delete->execute( $_->{id} ) foreach @posts;
@@ -387,7 +387,7 @@ How many posts there are, counting a post once however many versions it has.
 =cut
 
 sub count {
-    my ($count) = _dbh()->selectrow_array('SELECT COUNT(DISTINCT uuid) FROM posts');
+    my ($count) = dbh()->selectrow_array('SELECT COUNT(DISTINCT uuid) FROM posts');
     return $count // 0;
 }
 
@@ -424,7 +424,7 @@ our $index_prefix = 'posts_custom_';
 our %reserved = map { $_ => 1 } qw{id post_data uuid version created title user author form aclname visibility local_href data};
 
 sub index_fields ( $, @fields ) {
-    my $dbh = _dbh();
+    my $dbh = dbh();
 
     my %want;
     foreach my $field (@fields) {
@@ -492,7 +492,7 @@ Every tag in use, from the index the schema's triggers maintain.
 =cut
 
 sub tags {
-    my $rows = _dbh()->selectall_arrayref( 'SELECT DISTINCT tag FROM post_tags ORDER BY tag', { Slice => {} } );
+    my $rows = dbh()->selectall_arrayref( 'SELECT DISTINCT tag FROM post_tags ORDER BY tag', { Slice => {} } );
     return () unless ref $rows eq 'ARRAY';
     return map { $_->{tag} } @$rows;
 }

lib/Trog/DataModule.pm

@@ -126,12 +126,21 @@ sub get ( $self, %request ) {
     return @$posts if $request{raw};
 
     my @filtered = $self->filter( \%request, @$posts );
-    @filtered = $self->_fixup(@filtered);
+    @filtered = $self->fixup(@filtered);
     @filtered = $self->paginate( \%request, @filtered );
     return @filtered;
 }
 
-sub _fixup ( $, @filtered ) {
+=head2 fixup(@posts) = LIST
+
+Fill in what a post needs for display and routing, and does not store: the
+author's display_name and user_class, and a local_href, callback and method
+where the post has none.  Spaces in its href fields become %20.  Called by
+get(), and by a subclass whose get() does not call the base one.
+
+=cut
+
+sub fixup ( $, @filtered ) {
 
     my %user2display;
 
@@ -174,15 +183,15 @@ sub _fixup ( $, @filtered ) {
     return @filtered;
 }
 
-sub _filter_param ( $query, $param, @filtered ) {
+my sub filter_param ( $query, $param, @filtered ) {
     @filtered = grep { ( $_->{$param} || '' ) eq $query->{$param} } @filtered;
-    @filtered = _dedup_versions( $query->{version}, @filtered );
+    @filtered = dedup_versions( $query->{version}, @filtered );
     return @filtered;
 }
 
 # Visibility and acls are both stored as tags, so a caller sees a post when it
 # holds one of them.  admin sees everything.
-sub _filter_acls ( $query, @filtered ) {
+my sub filter_acls ( $query, @filtered ) {
     return @filtered if grep { $_ eq 'admin' } @{ $query->{acls} };
     return grep {
         my $tags = $_->{tags};
@@ -213,10 +222,10 @@ sub filter ( $, $query, @filtered ) {
     # if the caller may see it.
     foreach my $key (qw{id title aclname}) {
         next unless $query->{$key};
-        return _filter_acls( $query, _filter_param( $query, $key, @filtered ) );
+        return filter_acls( $query, filter_param( $query, $key, @filtered ) );
     }
 
-    @filtered = _dedup_versions( undef, @filtered );
+    @filtered = dedup_versions( undef, @filtered );
 
     #Filter out posts which are too old
     #Coerce older into numeric
@@ -247,7 +256,7 @@ sub filter ( $, $query, @filtered ) {
         } @$tags
     } @filtered if @{ $query->{exclude_tags} };
 
-    @filtered = _filter_acls( $query, @filtered );
+    @filtered = filter_acls( $query, @filtered );
 
     @filtered = grep { ( $_->{form} || '' ) eq $query->{form} } @filtered if $query->{form};
 
@@ -281,7 +290,17 @@ sub paginate ( $, $query, @filtered ) {
     return splice( @filtered, $start, $offset );
 }
 
-sub _dedup_versions ( $version = -1, @posts ) {
+=head2 dedup_versions($version, @posts) = LIST
+
+Given a $version, the posts of that version, each with version_max set to the
+newest version among @posts.
+
+Given undef, one post per id: its newest version, with version_max set, created
+and author taken from its oldest version, and modified from the newest one.
+
+=cut
+
+sub dedup_versions ( $version = -1, @posts ) {
 
     #ASSUMPTION made here - if we pass version this is direct ID query
     if ( defined $version ) {
@@ -426,18 +445,67 @@ picks the change up on its very next add() with no restart needed.
 # a type saved and used inside the same second validated against the schema it
 # had a moment ago.  Falls back to whatever stat gives where the filesystem
 # carries no sub-second timestamps.
-sub _sidecar_generation {
+my sub sidecar_generation {
     return join( ':', map { ( ( Time::HiRes::stat("$_/forms") )[9] // 0, ( Time::HiRes::stat($_) )[9] // 0 ) } Trog::Themes::template_dirs( 'text/html', 1 ) );
 }
 
 # A signature default only covers an absent arg, and plenty of posts have an
 # explicitly undef form.
-sub _type_of ($form) {
+my sub type_of ($form) {
     $form = '' if !defined $form || ref $form;
     my ($type) = $form =~ m/^([A-Za-z0-9_-]+)\.tx$/;
     return $type // '';
 }
 
+our %relation_schema = ( type => 'string' );
+
+# Sugar: a sidecar says {"type":"upload"} rather than spelling out the
+# string-or-hashref dance every upload field would otherwise need.  Uploads are
+# a hashref on the way in from the browser and the href string they became on
+# the way back out of the datastore.
+my sub expand_pseudo_types ($node) {
+    return unless Ref::Util::is_hashref($node);
+
+    my %pseudo = (
+        upload   => \%upload_schema,
+        relation => \%relation_schema,
+    );
+
+    my $type = $node->{type} // '';
+    if ( $pseudo{$type} ) {
+        delete $node->{type};
+        %$node = ( %$node, %{ $pseudo{$type} } );
+        return;
+    }
+
+    __SUB__->($_) foreach values( %{ $node->{properties} // {} } );
+    __SUB__->( $node->{items} ) if $node->{items};
+    foreach my $key (qw{oneOf anyOf allOf}) {
+        next unless Ref::Util::is_arrayref( $node->{$key} );
+        __SUB__->($_) foreach @{ $node->{$key} };
+    }
+    return;
+}
+
+my sub read_sidecar ($path) {
+
+    # -e, not -f: the question is whether a sidecar exists at all, and most
+    # post types have none.  Letting the read below fail instead would WARN
+    # about every type that simply does not have one.
+    return undef unless -e $path;
+
+    local $@;
+    my $spec = eval { JSON::MaybeXS::decode_json( File::Slurper::read_text($path) ) };
+    if ( !$spec ) {
+        WARN("Could not parse post type sidecar '$path': $@");
+        return undef;
+    }
+    return undef unless Ref::Util::is_hashref($spec);
+
+    expand_pseudo_types($spec);
+    return $spec;
+}
+
 =head2 type_meta_for($form)
 
 The parts of a post type's sidecar which aren't schema: x-tcms-relations,
@@ -452,14 +520,14 @@ type's own metadata live out there and something has to read them.
 sub type_meta_for ( $form = '' ) {
     state %cache;
 
-    my $generation = _sidecar_generation();
+    my $generation = sidecar_generation();
     %cache = () unless exists $cache{$generation};
 
-    my $type = _type_of($form);
+    my $type = type_of($form);
     return $cache{$generation}{$type} if exists $cache{$generation}{$type};
 
     my $path    = $type ? Trog::Themes::themed_file_in_dir( 'forms', "$type.json", 'text/html', 1 ) : undef;
-    my $sidecar = $path ? _read_sidecar($path)                                                      : undef;
+    my $sidecar = $path ? read_sidecar($path)                                                       : undef;
 
     my %meta;
     if ($sidecar) {
@@ -492,22 +560,40 @@ them, since edit_head.tx and friends collect nothing.
 sub include_schema_for ( $include = '' ) {
     state %cache;
 
-    my $generation = _sidecar_generation();
+    my $generation = sidecar_generation();
     %cache = () unless exists $cache{$generation};
 
     # Same shape as a post type, so the same check: a name and nothing else,
     # since it is about to be turned into a path.
-    my $name = _type_of($include);
+    my $name = type_of($include);
     return {} unless $name;
     return $cache{$generation}{$name} if exists $cache{$generation}{$name};
 
     my $path    = Trog::Themes::themed_component("$name.json");
-    my $sidecar = $path ? _read_sidecar($path) : undef;
+    my $sidecar = $path ? read_sidecar($path) : undef;
 
     $cache{$generation}{$name} = $sidecar // {};
     return $cache{$generation}{$name};
 }
 
+my sub includes_of ($type) {
+    my $path     = Trog::Themes::themed_file_in_dir( 'forms', "$type.tx", 'text/html', 1 );
+    my $template = $path ? eval { File::Slurper::read_text($path) } : undef;
+
+    if ( !defined $template ) {
+        my $meta     = type_meta_for("$type.tx")->{'x-tcms-post-type'};
+        my $recorded = Ref::Util::is_hashref($meta) ? $meta->{includes} : undef;
+        return [] unless Ref::Util::is_arrayref($recorded);
+        return [ grep { defined && !ref } @$recorded ];
+    }
+
+    # Kolon's line syntax, which is how every include in the tree is written --
+    # including the ones the wizard generates.  Deduped, since a template is
+    # free to splice the same block in twice.
+    my %seen;
+    return [ grep { !$seen{$_}++ } $template =~ m/^\s*:\s*include\s+"([A-Za-z0-9_-]+\.tx)"/gm ];
+}
+
 =head2 includes_for($form)
 
 The canned includes a post type splices into its editor, as an arrayref of
@@ -527,35 +613,17 @@ anything.
 sub includes_for ( $form = '' ) {
     state %cache;
 
-    my $generation = _sidecar_generation();
+    my $generation = sidecar_generation();
     %cache = () unless exists $cache{$generation};
 
-    my $type = _type_of($form);
+    my $type = type_of($form);
     return [] unless $type;
     return $cache{$generation}{$type} if exists $cache{$generation}{$type};
 
-    $cache{$generation}{$type} = _includes_of($type);
+    $cache{$generation}{$type} = includes_of($type);
     return $cache{$generation}{$type};
 }
 
-sub _includes_of ($type) {
-    my $path     = Trog::Themes::themed_file_in_dir( 'forms', "$type.tx", 'text/html', 1 );
-    my $template = $path ? eval { File::Slurper::read_text($path) } : undef;
-
-    if ( !defined $template ) {
-        my $meta     = type_meta_for("$type.tx")->{'x-tcms-post-type'};
-        my $recorded = Ref::Util::is_hashref($meta) ? $meta->{includes} : undef;
-        return [] unless Ref::Util::is_arrayref($recorded);
-        return [ grep { defined && !ref } @$recorded ];
-    }
-
-    # Kolon's line syntax, which is how every include in the tree is written --
-    # including the ones the wizard generates.  Deduped, since a template is
-    # free to splice the same block in twice.
-    my %seen;
-    return [ grep { !$seen{$_}++ } $template =~ m/^\s*:\s*include\s+"([A-Za-z0-9_-]+\.tx)"/gm ];
-}
-
 =head2 private_fields_for($form)
 
 The fields of a post type which only an editor may see, as declared by
@@ -628,12 +696,12 @@ sub relations_for ( $form = '' ) {
 sub schema_for ( $form = '' ) {
     state %cache;
 
-    my $generation = _sidecar_generation();
+    my $generation = sidecar_generation();
 
     # Only ever keep the current generation around.
     %cache = () unless exists $cache{$generation};
 
-    my $type = _type_of($form);
+    my $type = type_of($form);
     return $cache{$generation}{$type} if exists $cache{$generation}{$type};
 
     my %merged = ( %post_schema, properties => { %{ $post_schema{properties} } } );
@@ -642,7 +710,7 @@ sub schema_for ( $form = '' ) {
     # ship its own blog.json alongside it, and one that doesn't still gets the
     # stock schema rather than nothing at all.
     my $path    = $type ? Trog::Themes::themed_file_in_dir( 'forms', "$type.json", 'text/html', 1 ) : undef;
-    my $sidecar = $path ? _read_sidecar($path)                                                      : undef;
+    my $sidecar = $path ? read_sidecar($path)                                                       : undef;
     if ($sidecar) {
 
         # The base schema is merged *last*, so a sidecar can add fields but can
@@ -680,59 +748,11 @@ sub schema_for ( $form = '' ) {
     return $cache{$generation}{$type};
 }
 
-sub _read_sidecar ($path) {
-
-    # -e, not -f: the question is whether a sidecar exists at all, and most
-    # post types have none.  Letting the read below fail instead would WARN
-    # about every type that simply does not have one.
-    return undef unless -e $path;
-
-    local $@;
-    my $spec = eval { JSON::MaybeXS::decode_json( File::Slurper::read_text($path) ) };
-    if ( !$spec ) {
-        WARN("Could not parse post type sidecar '$path': $@");
-        return undef;
-    }
-    return undef unless Ref::Util::is_hashref($spec);
-
-    _expand_pseudo_types($spec);
-    return $spec;
-}
-
 # A relation is stored as the referenced post's UUID, and resolved into the
 # post itself at render time -- see the x-tcms-relations table a sidecar
-# declares alongside it, and Trog::Routes::HTML::_enrich_post.  The pseudo-type
+# declares alongside it, and Trog::Routes::HTML::enrich_post.  The pseudo-type
 # exists so a sidecar can say what a field *means* rather than just that it
 # happens to be a string.
-our %relation_schema = ( type => 'string' );
-
-# Sugar: a sidecar says {"type":"upload"} rather than spelling out the
-# string-or-hashref dance every upload field would otherwise need.  Uploads are
-# a hashref on the way in from the browser and the href string they became on
-# the way back out of the datastore.
-sub _expand_pseudo_types ($node) {
-    return unless Ref::Util::is_hashref($node);
-
-    my %pseudo = (
-        upload   => \%upload_schema,
-        relation => \%relation_schema,
-    );
-
-    my $type = $node->{type} // '';
-    if ( $pseudo{$type} ) {
-        delete $node->{type};
-        %$node = ( %$node, %{ $pseudo{$type} } );
-        return;
-    }
-
-    _expand_pseudo_types($_) foreach values( %{ $node->{properties} // {} } );
-    _expand_pseudo_types( $node->{items} ) if $node->{items};
-    foreach my $key (qw{oneOf anyOf allOf}) {
-        next unless Ref::Util::is_arrayref( $node->{$key} );
-        _expand_pseudo_types($_) foreach @{ $node->{$key} };
-    }
-    return;
-}
 
 =head2 validate($post)
 
@@ -746,14 +766,14 @@ meant to round-trip.
 
 =cut
 
-sub _validator {
+my sub validator {
     state $validator;
     $validator //= JSON::Validator::Schema::Troglodyne->new();
     return $validator;
 }
 
 sub validate ($post) {
-    my $validator = _validator();
+    my $validator = validator();
 
     my $schema = schema_for( $post->{form} );
 
@@ -786,14 +806,14 @@ sub validate ($post) {
 
 Check the post that is actually about to be written.
 
-validate() runs on what was submitted.  _process() then builds the shape that
+validate() runs on what was submitted.  process() then builds the shape that
 gets stored -- it turns a visibility into a tag, folds the acls in, resolves
 uploads into hrefs -- and until now nothing looked at the result.  That is how
 every post saved without a visibility came to carry a null in its tags: the
 schema describes tags as an array of strings and would have rejected it on the
 spot, but it was never asked.
 
-Checks rather than filters, unlike validate().  _process() adds fields the base
+Checks rather than filters, unlike validate().  process() adds fields the base
 schema has never heard of -- content_type, is_video, attachments -- and dropping
 what it does not recognise would throw away the work it just did.  So this looks
 only at the fields the schema actually describes, on a copy, and changes nothing.
@@ -807,7 +827,7 @@ sub validate_built ($post) {
 
     my %described = map { $_ => $post->{$_} } grep { exists $schema->{properties}{$_} } keys(%$post);
 
-    return _validator()->validate( \%described, $schema );
+    return validator()->validate( \%described, $schema );
 }
 
 sub add ( $self, @posts ) {
@@ -841,7 +861,7 @@ sub add ( $self, @posts ) {
             push( @{ $post->{aliases} }, "/posts/$post->{id}", "/series/$post->{id}" );
         }
 
-        # Every post needs one: _process pushes it into the tags, and an
+        # Every post needs one: process pushes it into the tags, and an
         # undef there is a tag no query will ever match, which makes the post
         # invisible to everyone but an admin.  A post type built without a
         # visibility selector would otherwise produce exactly that.  Private
@@ -873,9 +893,9 @@ sub add ( $self, @posts ) {
             $post->{local_href} =~ s|/secure||gmx;
         }
 
-        $post = _process($post);
+        $post = process($post);
 
-        # And check what _process() built, not just what arrived.  A post that
+        # And check what process() built, not just what arrived.  A post that
         # fails here is one this code has made wrong on its way to disk, so it
         # is a bug rather than bad input -- but the answer is still to refuse to
         # write it, because the alternative is what we did before, which was to
@@ -893,9 +913,41 @@ sub add ( $self, @posts ) {
     return 0;
 }
 
+my %seen_files;
+
+my sub handle_upload ( $file, $uuid, $private = 0 ) {
+    my $fname;
+    if ( ref $file ne 'HASH' ) {
+        $file =~ s/\\/\//g;
+        $fname = basename($file);
+        FATAL("Did not expect bogus file before its real counterpart!") unless $seen_files{$fname};
+        return $seen_files{$fname};
+    }
+    my $f = $file->{tempname};
+    $fname = basename( $file->{filename} );
+    my $newname = "$uuid.$file->{filename}";
+    $newname = "private/$newname" if $private;
+    File::Copy::move( $f, "www/assets/$newname" );
+
+    # Regrettably, we have no control over the perms of the temp file that starman creates for uploads.
+    chmod( 0755, "www/assets/$newname" );
+    $seen_files{$fname} = "/assets/$newname";
+    return $seen_files{$fname};
+}
+
 #XXX this level of post-processing seems gross, but may be unavoidable
 # Not actually a subprocess, kek
-sub _process ($post) {
+
+=head2 process($post) = HASHREF
+
+Build the post that gets stored from the one that was submitted.  It stores
+the uploaded files, folds the visibility, the acls and the series into the
+tags, removes the fields that only the form uses, and sets the content type
+fields from the files the post points at.  Changes $post, and returns it.
+
+=cut
+
+sub process ($post) {
 
     # Here as well as in add(), because this is the sub that turns a visibility
     # into a tag: without one it pushed an undef into tags, which is a tag no
@@ -906,10 +958,10 @@ sub _process ($post) {
     # If the post is private, make sure it's associated assets are too.
     my $is_private_post = $post->{visibility} eq 'private';
 
-    $post->{href}      = _handle_upload( $post->{file},           $post->{id}, $is_private_post ) if $post->{file};
-    $post->{preview}   = _handle_upload( $post->{preview_file},   $post->{id}, $is_private_post ) if $post->{preview_file};
-    $post->{wallpaper} = _handle_upload( $post->{wallpaper_file}, $post->{id}, $is_private_post ) if $post->{wallpaper_file};
-    @{ $post->{attachments} } = map { _handle_upload( $_, $post->{id}, $is_private_post ) } @{ $post->{attachments} } if $post->{attachments};
+    $post->{href}      = handle_upload( $post->{file},           $post->{id}, $is_private_post ) if $post->{file};
+    $post->{preview}   = handle_upload( $post->{preview_file},   $post->{id}, $is_private_post ) if $post->{preview_file};
+    $post->{wallpaper} = handle_upload( $post->{wallpaper_file}, $post->{id}, $is_private_post ) if $post->{wallpaper_file};
+    @{ $post->{attachments} } = map { handle_upload( $_, $post->{id}, $is_private_post ) } @{ $post->{attachments} } if $post->{attachments};
     $post->{preview} = $post->{href} if $post->{app} && $post->{app} eq 'image';
     delete $post->{app};
     delete $post->{file};
@@ -958,27 +1010,6 @@ sub _process ($post) {
 }
 
 # Browsers try and save time in the event that the same file is sent twice, so handle that.
-my %seen_files;
-
-sub _handle_upload ( $file, $uuid, $private = 0 ) {
-    my $fname;
-    if ( ref $file ne 'HASH' ) {
-        $file =~ s/\\/\//g;
-        $fname = basename($file);
-        FATAL("Did not expect bogus file before its real counterpart!") unless $seen_files{$fname};
-        return $seen_files{$fname};
-    }
-    my $f = $file->{tempname};
-    $fname = basename( $file->{filename} );
-    my $newname = "$uuid.$file->{filename}";
-    $newname = "private/$newname" if $private;
-    File::Copy::move( $f, "www/assets/$newname" );
-
-    # Regrettably, we have no control over the perms of the temp file that starman creates for uploads.
-    chmod( 0755, "www/assets/$newname" );
-    $seen_files{$fname} = "/assets/$newname";
-    return $seen_files{$fname};
-}
 
 =head2 delete(@posts)
 

lib/Trog/DataSource.pm

@@ -25,7 +25,7 @@ than methods, and named by a post type's sidecar in x-tcms-datasource.
     posts($series, $query) = @posts       required
 
 The children of $series, as post hashrefs.  Enough of a post to survive being
-rendered like one -- see Trog::DataSource::Virt::_post_for for the shape.
+rendered like one -- see Trog::DataSource::Virt::post_for for the shape.
 
     EDITABLE                              optional constant
 
@@ -196,7 +196,7 @@ saved -- whatever the source draws on changed instead.  So a source has to
 answer one of two questions, and it has to answer deliberately.
 
 Either it knows what it depends on and can say when that changes, in which case
-it should register a watch (Trog::DataSource::DirIndex::_watch is the worked
+it should register a watch (Trog::DataSource::DirIndex::watch is the worked
 example) and declare CACHEABLE.  Or it doesn't, in which case its pages must not
 be cached at all, because the cached copy has no way of ever becoming right
 again.

lib/Trog/DataSource/DirIndex.pm

@@ -42,7 +42,7 @@ use constant EDITABLE => 0;
 
 =head2 CACHEABLE
 
-True, which is only defensible because of the watch _watch() registers.  A
+True, which is only defensible because of the watch watch() registers.  A
 listing is cheap to build but there is no reason to build it per request, and the
 one thing that would make a cached copy wrong -- the directory changing -- is
 exactly the thing inotify tells us about.
@@ -96,55 +96,17 @@ left out of the listing rather than shown with a link that will not work.
 our $root    = 'www';
 our @refused = ('www/assets/private');
 
-=head1 FUNCTIONS
-
-=head2 posts($series, $query) = @posts
-
-One post per entry in the series' directory.
-
-Each carries, beyond what every post has:
-
-    name        the entry's own name, as on disk
-    path        its path relative to www/
-    is_dir      whether it is a directory
-    size        bytes, 0 for a directory
-    size_human  the same, as a human reads it
-    mtime       last modification, which is also the post's created
-    extension   lowercased, without the dot, empty for a directory
-    is_image / is_video / is_audio    from the content type, as a stored post gets
-
-Registers an inotify watch on the directory the first time it is asked, so that
-the static render of this page is thrown away when the directory changes.  See
-_watch().
-
-=cut
-
-sub posts ( $series, $query ) {
-    my $dir = _resolve( $series->{directory} );
-    return () unless $dir;
-
-    _watch( $query, $dir->{relative} );
-
-    opendir( my $dh, $dir->{absolute} ) or do {
-        WARN("Could not read $dir->{relative}: $!");
-        return ();
-    };
-    my @entries = grep { $_ ne '.' && $_ ne '..' && index( $_, '.' ) != 0 } readdir($dh);
-    closedir($dh);
-
-    my @out;
-    foreach my $entry ( sort @entries ) {
-        my $post = _post_for( $entry, $dir, $series );
-        push( @out, $post ) if $post;
-    }
-
-    return @out;
+# Path containment, done on the resolved paths rather than on the strings the
+# caller handed us: /www-backup is not inside /www, however it reads.
+my sub within ( $path, $within ) {
+    return 1 if $path eq $within;
+    return index( $path, "$within/" ) == 0;
 }
 
 # Everything this is allowed to look at, or nothing.  Returns the absolute path
 # and the path relative to the tCMS root, since the first is what we read and
 # the second is what we log and watch.
-sub _resolve ($directory) {
+my sub resolve ($directory) {
     return undef unless $directory;
 
     # Before abs_path, which would happily resolve one for us.
@@ -171,7 +133,7 @@ sub _resolve ($directory) {
         return undef;
     }
 
-    if ( !_within( $absolute, $base ) ) {
+    if ( !within( $absolute, $base ) ) {
         WARN("Refusing to index '$directory': it resolves outside $root");
         return undef;
     }
@@ -179,7 +141,7 @@ sub _resolve ($directory) {
     foreach my $refused (@refused) {
         my $forbidden = Cwd::abs_path($refused);
         next unless $forbidden;
-        next unless _within( $absolute, $forbidden );
+        next unless within( $absolute, $forbidden );
 
         WARN("Refusing to index '$directory': $refused holds files the webserver gates, so its names are gated too");
         return undef;
@@ -191,20 +153,26 @@ sub _resolve ($directory) {
     return { absolute => $absolute, relative => $relative ne q{} ? "$root/$relative" : $root };
 }
 
-# Path containment, done on the resolved paths rather than on the strings the
-# caller handed us: /www-backup is not inside /www, however it reads.
-sub _within ( $path, $within ) {
-    return 1 if $path eq $within;
-    return index( $path, "$within/" ) == 0;
+my sub human_size ($bytes) {
+    return '' unless defined $bytes;
+    return "$bytes B" if $bytes < 1024;
+
+    my @units = qw{KB MB GB TB PB};
+    my $size  = $bytes / 1024;
+    foreach my $unit (@units) {
+        return sprintf( '%.1f %s', $size, $unit ) if $size < 1024 || $unit eq $units[-1];
+        $size /= 1024;
+    }
+    return "$bytes B";
 }
 
-sub _post_for ( $name, $dir, $series ) {
+my sub post_for ( $name, $dir, $series ) {
     my $absolute = "$dir->{absolute}/$name";
 
     # Resolved, so a symlink pointing out of the tree is left out rather than
     # listed with a link the webserver will not honour.
     my $real = Cwd::abs_path($absolute);
-    if ( !$real || !_within( $real, Cwd::abs_path($root) ) ) {
+    if ( !$real || !within( $real, Cwd::abs_path($root) ) ) {
         DEBUG("Skipping $name: it points outside $root");
         return undef;
     }
@@ -247,7 +215,7 @@ sub _post_for ( $name, $dir, $series ) {
 
         is_dir     => $is_dir,
         size       => $size,
-        size_human => _human_size($size),
+        size_human => human_size($size),
         mtime      => $mtime,
         extension  => $extension,
 
@@ -275,17 +243,49 @@ sub _post_for ( $name, $dir, $series ) {
     return $post;
 }
 
-sub _human_size ($bytes) {
-    return '' unless defined $bytes;
-    return "$bytes B" if $bytes < 1024;
+=head1 FUNCTIONS
 
-    my @units = qw{KB MB GB TB PB};
-    my $size  = $bytes / 1024;
-    foreach my $unit (@units) {
-        return sprintf( '%.1f %s', $size, $unit ) if $size < 1024 || $unit eq $units[-1];
-        $size /= 1024;
+=head2 posts($series, $query) = @posts
+
+One post per entry in the series' directory.
+
+Each carries, beyond what every post has:
+
+    name        the entry's own name, as on disk
+    path        its path relative to www/
+    is_dir      whether it is a directory
+    size        bytes, 0 for a directory
+    size_human  the same, as a human reads it
+    mtime       last modification, which is also the post's created
+    extension   lowercased, without the dot, empty for a directory
+    is_image / is_video / is_audio    from the content type, as a stored post gets
+
+Registers an inotify watch on the directory the first time it is asked, so that
+the static render of this page is thrown away when the directory changes.  See
+watch().
+
+=cut
+
+sub posts ( $series, $query ) {
+    my $dir = resolve( $series->{directory} );
+    return () unless $dir;
+
+    watch( $query, $dir->{relative} );
+
+    opendir( my $dh, $dir->{absolute} ) or do {
+        WARN("Could not read $dir->{relative}: $!");
+        return ();
+    };
+    my @entries = grep { $_ ne '.' && $_ ne '..' && index( $_, '.' ) != 0 } readdir($dh);
+    closedir($dh);
+
+    my @out;
+    foreach my $entry ( sort @entries ) {
+        my $post = post_for( $entry, $dir, $series );
+        push( @out, $post ) if $post;
     }
-    return "$bytes B";
+
+    return @out;
 }
 
 =head2 filter($query, @posts) = @posts
@@ -338,7 +338,7 @@ Where to read about it.
 sub lang { return 'Case insensitive substring of a file name, path or extension' }
 sub help { return 'https://en.wikipedia.org/wiki/Substring' }
 
-=head2 _watch($query, $directory)
+=head2 watch($query, $directory)
 
 Ask tPSGI to tell us when the directory changes, and throw the static renders
 away when it does.
@@ -361,7 +361,7 @@ worker notices the change is the one that must do the invalidating.
 
 =cut
 
-sub _watch ( $query, $directory ) {
+sub watch ( $query, $directory ) {
     my $tpsgi = $query->{tpsgi};
     return 0 unless $tpsgi;
 

lib/Trog/DataSource/ProvisionedVirt.pm

@@ -83,47 +83,28 @@ our %states = (
     interrupted => 'reprovision interrupted',
 );
 
-=head1 FUNCTIONS
-
-=head2 posts($series, $query) = @posts
-
-The guests Trog::DataSource::Virt would have listed, each carrying what we know
-about how it was built:
-
-    recipe                the recipe's YAML, as text, for the page to show
-    recipe_path           where that came from
-    has_recipe            whether there was one at all
-    can_reprovision       whether the button should be drawn
-    reprovision_state     running, ok, failed, interrupted, or absent
-    reprovision_status    that, in words a person reads
-    reprovision_started   when the last run began
-    reprovision_finished  when it ended, if it has
-    reprovision_exit      what it exited with, if it has
-    reprovision_by        who asked for it
-    is_reprovisioning     whether one is going on right now
-    reprovision_log       the tail of the last run
-    reprovision_log_href  where to read all of it
-
-A guest with no recipe is still listed.  Plenty of guests on a hypervisor were
-not built by this, and saying nothing about them is better than hiding them.
+# A guest name reaches the filesystem here, so it is a hostname or it is nothing.
+my sub safe_domain ($domain) {
+    return undef if !$domain || length $domain >= 254;
+    return undef if $domain =~ m/(?:^|\.)\.\.?(?:\.|$)/;
 
-=cut
+    my ($safe) = $domain =~ m/^([A-Za-z0-9][A-Za-z0-9._-]*)$/;
+    return $safe;
+}
 
-sub posts ( $series, $query ) {
-    my @guests = Trog::DataSource::Virt::posts( $series, $query );
-    my $config = _config();
+# An installation's recipes are where they are whether tCMS knows about the
+# provisioner or not, but reading them is the feature, so it is off with it.
+my sub _recipe_path ( $config, $domain ) {
+    return undef unless $config->{trog_provisioner};
 
-    # Asked once for the page rather than once per guest, and asked rather than
-    # opened: what the form needs to know is which box to draw.
-    my $user = $query->{user} // '';
-    $config->{can_remember}    = ( $user                   && Trog::Vault::has_key() )                  ? 1 : 0;
-    $config->{remembered}      = ( $config->{can_remember} && Trog::Vault::has( $user, $secret_name ) ) ? 1 : 0;
-    $config->{sudo_remembered} = ( $config->{can_remember} && Trog::Vault::has( $user, $sudo_name ) )   ? 1 : 0;
+    my $safe = safe_domain($domain);
+    return undef unless $safe;
 
-    return map { _with_recipe( $_, $config ) } @guests;
+    my $path = "$config->{recipes}/$safe.yaml";
+    return -f $path ? $path : undef;    ## no critic (ProhibitFiletest_f) -- is there a recipe for this guest
 }
 
-sub _with_recipe ( $post, $config ) {
+my sub with_recipe ( $post, $config ) {
     return $post if $post->{unreachable};
 
     my $domain = $post->{domain} // '';
@@ -167,12 +148,89 @@ sub _with_recipe ( $post, $config ) {
     # anybody wants to have started by double clicking.
     $post->{can_reprovision} = 0 if $post->{is_reprovisioning};
 
-    $post->{reprovision_log}      = _log_tail($domain);
+    $post->{reprovision_log}      = log_tail($domain);
     $post->{reprovision_log_href} = $post->{reprovision_log} ? "/guest/reprovision/log/$domain" : undef;
 
     return $post;
 }
 
+=head2 config() = HASHREF
+
+Where the provisioner is checked out, from the tCMS configuration, and where the
+recipes it reads are, from trog-provisioner's own rule for that.
+
+    trog_provisioner    the checkout, or undef
+    recipes             the directory the guests' recipes are in
+
+Undef for the checkout means the feature is off rather than broken: a site which
+has not configured it gets a plain guest listing, which is what it asked for.
+
+=cut
+
+my sub config {
+    my $conf = Trog::Config::get();
+
+    # Nothing to configure here: the provisioner reads this env var or that
+    # directory, so a recipe we showed from anywhere else would be a recipe it
+    # is not going to build from.
+    my %config = ( recipes => ( $ENV{TROG_PROVISIONER_CONFIG} // $provisioner_config ) . "/$recipe_dir" );
+
+    my $dir = $conf->param('provisioner.trog_provisioner');
+    return \%config unless $dir && !ref $dir;
+
+    # Resolved, and checked to be there.  A path in a config file which does not
+    # exist is a typo, and finding that out here beats finding it out halfway
+    # through a reprovision.
+    my $absolute = Cwd::abs_path($dir);
+    if ( !$absolute || !-d $absolute ) {
+        WARN("provisioner.trog_provisioner is set to '$dir', which is not a directory here");
+        return \%config;
+    }
+
+    $config{trog_provisioner} = $absolute;
+    return \%config;
+}
+
+=head1 FUNCTIONS
+
+=head2 posts($series, $query) = @posts
+
+The guests Trog::DataSource::Virt would have listed, each carrying what we know
+about how it was built:
+
+    recipe                the recipe's YAML, as text, for the page to show
+    recipe_path           where that came from
+    has_recipe            whether there was one at all
+    can_reprovision       whether the button should be drawn
+    reprovision_state     running, ok, failed, interrupted, or absent
+    reprovision_status    that, in words a person reads
+    reprovision_started   when the last run began
+    reprovision_finished  when it ended, if it has
+    reprovision_exit      what it exited with, if it has
+    reprovision_by        who asked for it
+    is_reprovisioning     whether one is going on right now
+    reprovision_log       the tail of the last run
+    reprovision_log_href  where to read all of it
+
+A guest with no recipe is still listed.  Plenty of guests on a hypervisor were
+not built by this, and saying nothing about them is better than hiding them.
+
+=cut
+
+sub posts ( $series, $query ) {
+    my @guests = Trog::DataSource::Virt::posts( $series, $query );
+    my $config = config();
+
+    # Asked once for the page rather than once per guest, and asked rather than
+    # opened: what the form needs to know is which box to draw.
+    my $user = $query->{user} // '';
+    $config->{can_remember}    = ( $user                   && Trog::Vault::has_key() )                  ? 1 : 0;
+    $config->{remembered}      = ( $config->{can_remember} && Trog::Vault::has( $user, $secret_name ) ) ? 1 : 0;
+    $config->{sudo_remembered} = ( $config->{can_remember} && Trog::Vault::has( $user, $sudo_name ) )   ? 1 : 0;
+
+    return map { with_recipe( $_, $config ) } @guests;
+}
+
 =head2 status($domain) = HASHREF or undef
 
 What the last reprovision of this guest is doing, or did.
@@ -194,7 +252,7 @@ one: the alternative is a page that says a provision is in progress forever.
 =cut
 
 sub status ($domain) {
-    my $safe = _safe_domain($domain);
+    my $safe = safe_domain($domain);
     return undef unless $safe;
 
     my $path = "$log_dir/$safe.status";
@@ -226,7 +284,7 @@ sub status ($domain) {
 # that a page drawn while the run is writing sees the old status or the new one
 # and never half of either -- the reader would ignore a torn file, but ignoring
 # it means the page says nothing was ever run.
-sub _write_status ( $domain, %fields ) {
+my sub write_status ( $domain, %fields ) {
     my $path = "$log_dir/$domain.status";
     my $out  = join( '', map { "$_=" . ( $fields{$_} // '' ) . "\n" } sort keys %fields );
 
@@ -243,65 +301,7 @@ sub _write_status ( $domain, %fields ) {
     return;
 }
 
-=head2 _config() = HASHREF
-
-Where the provisioner is checked out, from the tCMS configuration, and where the
-recipes it reads are, from trog-provisioner's own rule for that.
-
-    trog_provisioner    the checkout, or undef
-    recipes             the directory the guests' recipes are in
-
-Undef for the checkout means the feature is off rather than broken: a site which
-has not configured it gets a plain guest listing, which is what it asked for.
-
-=cut
-
-sub _config {
-    my $conf = Trog::Config::get();
-
-    # Nothing to configure here: the provisioner reads this env var or that
-    # directory, so a recipe we showed from anywhere else would be a recipe it
-    # is not going to build from.
-    my %config = ( recipes => ( $ENV{TROG_PROVISIONER_CONFIG} // $provisioner_config ) . "/$recipe_dir" );
-
-    my $dir = $conf->param('provisioner.trog_provisioner');
-    return \%config unless $dir && !ref $dir;
-
-    # Resolved, and checked to be there.  A path in a config file which does not
-    # exist is a typo, and finding that out here beats finding it out halfway
-    # through a reprovision.
-    my $absolute = Cwd::abs_path($dir);
-    if ( !$absolute || !-d $absolute ) {
-        WARN("provisioner.trog_provisioner is set to '$dir', which is not a directory here");
-        return \%config;
-    }
-
-    $config{trog_provisioner} = $absolute;
-    return \%config;
-}
-
-# A guest name reaches the filesystem here, so it is a hostname or it is nothing.
-sub _safe_domain ($domain) {
-    return undef if !$domain || length $domain >= 254;
-    return undef if $domain =~ m/(?:^|\.)\.\.?(?:\.|$)/;
-
-    my ($safe) = $domain =~ m/^([A-Za-z0-9][A-Za-z0-9._-]*)$/;
-    return $safe;
-}
-
-# An installation's recipes are where they are whether tCMS knows about the
-# provisioner or not, but reading them is the feature, so it is off with it.
-sub _recipe_path ( $config, $domain ) {
-    return undef unless $config->{trog_provisioner};
-
-    my $safe = _safe_domain($domain);
-    return undef unless $safe;
-
-    my $path = "$config->{recipes}/$safe.yaml";
-    return -f $path ? $path : undef;    ## no critic (ProhibitFiletest_f) -- is there a recipe for this guest
-}
-
-=head2 _log_tail($domain) = STRING
+=head2 log_tail($domain) = STRING
 
 The last of whatever the previous reprovision said, or nothing.
 
@@ -312,8 +312,8 @@ is the only account of it there is.
 
 our $log_tail_bytes = 4096;
 
-sub _log_tail ($domain) {
-    my $safe = _safe_domain($domain);
+sub log_tail ($domain) {
+    my $safe = safe_domain($domain);
     return undef unless $safe;
 
     my $path = "$log_dir/$safe.log";
@@ -338,7 +338,7 @@ route that called it.
 our $log_max_bytes = 1024 * 1024;
 
 sub log_for ($domain) {
-    my $safe = _safe_domain($domain);
+    my $safe = safe_domain($domain);
     return undef unless $safe;
 
     my $path = "$log_dir/$safe.log";
@@ -353,97 +353,23 @@ sub log_for ($domain) {
       : $text;
 }
 
-=head2 reprovision(%args) = ($ok, $message)
-
-Run bin/provision for one guest, which generates its configuration from its
-recipe and then builds the machine.
-
-    domain      which guest.  Required, and validated as a hostname.
-    user        who asked.  For the log, and whose vault to look in.
-    passphrase  the KeePass passphrase the recipe's secrets need.
-    sudo        their sudo password on the hypervisor, if it wants one.
-    totp        a code, instead of those, when they have been stored.
-    remember    store what they just typed, so that next time is a code.
-
-Returns immediately.  Provisioning a machine takes minutes and an HTTP worker
-does not have minutes, so the work is handed to a detached process and the
-caller is told it started rather than told it finished.  What happened is in
-logs/reprovision/$domain.log, which is what _log_tail reads back onto the page.
-
-=head3 WHY IT ASKS FOR ANYTHING AT ALL
-
-Two passwords, for two different reasons.
-
-Every recipe inherits secret: values from _base, so the provisioner opens a
-KeePass database on its way past and wants the passphrase to it.  The
-alternative to asking is keeping the master password for every secret an
-operator holds in a file the webserver can read, which is worse than asking.
-
-And almost everything it does on the hypervisor needs root.  Where the login
-there has passwordless sudo -- which is how ours are set up, and what we would
-recommend -- there is nothing to ask for.  Where it does not, sudo over ssh has
-no terminal to ask at, and a run that finds that out dies several minutes in on
-a prompt nobody will ever see.  So it is asked for here instead, and left empty
-by anybody who does not need it.
-
-Asking every time has its own cost, though: a passphrase somebody has to have to
-hand is a passphrase that gets written down, and then it is in a text file
-instead of a config file, which is not an improvement.  So it can be stored --
-see Trog::Vault, where it is sealed under a key the database does not contain --
-and then what this asks for is a TOTP code, which proves the person is here
-without their having to be holding anything.
-
-The code is spent either way, so it authorizes this one reprovision rather than
-every reprovision inside its window.
-
-However they arrive, they go down the child's stdin as a credentials block --
-see Trog::Credentials in trog-provisioner -- and are written nowhere: not the
-log, not the process table, not the configuration.
-
-=cut
-
-sub reprovision (%args) {
-    my $safe = _safe_domain( $args{domain} );
-    return ( 0, 'bad guest name' ) unless $safe;
+# File away what they typed, so the next run is a code.
+#
+# Said rather than refused when it does not work: they asked for a reprovision
+# and gave us what it needs, and failing to keep a copy is not a reason to not do
+# the thing they asked for.
+my sub _remember ( $user, $credentials ) {
+    my %vault_name = ( keepass => $secret_name, sudo => $sudo_name );
 
-    # The template does not draw the button for this guest.  This is what
-    # actually stops it: /guest/reprovision is a POST anybody holding the admin
-    # acl can craft by hand, and there would be nothing left to report to.
-    if ( Trog::DataSource::Virt::_is_self($safe) ) {
-        WARN("Refused to reprovision '$safe': that is this server");
-        return ( 0, "'$safe' is this server -- refusing to reprovision it" );
+    foreach my $name ( sort keys %$credentials ) {
+        my ( $ok, $why ) = Trog::Vault::set( $user, $vault_name{$name}, $credentials->{$name} );
+        WARN("Could not remember the provisioner's $name for $user: $why") unless $ok;
     }
 
-    my $config = _config();
-    return ( 0, 'provisioner.trog_provisioner is not configured' ) unless $config->{trog_provisioner};
-
-    my $recipe = _recipe_path( $config, $safe );
-    return ( 0, "there is no recipe for '$safe' in $config->{recipes}" ) unless $recipe;
-
-    my ( $credentials, $why ) = _credentials(%args);
-    return ( 0, $why ) unless $credentials;
-
-    my $unsendable = _sendable($credentials);
-    return ( 0, $unsendable ) if $unsendable;
-
-    # One at a time.  Two provisions of one machine racing each other is not
-    # something anybody should be able to start by double clicking.
-    my $running = status($safe);
-    return ( 0, 'a reprovision of this guest is already running' ) if $running && $running->{state} eq 'running';
-
-    # --credentials, because nothing in there reads stdin unless it is told to.
-    my @command = ( "$config->{trog_provisioner}/bin/provision", '--credentials', $safe );
-    return ( 0, "$command[0] is not there to run" ) unless -x $command[0];    ## no critic (ProhibitFiletest_rwxRWX) -- refusing early beats finding out mid-provision
-
-    INFO( "Reprovision of '$safe' requested by " . ( $args{user} // 'somebody' ) );
-
-    my ( $ok, $failed ) = _spawn( $safe, $credentials, $config->{trog_provisioner}, \@command, $args{user} );
-    return ( 0, $failed ) unless $ok;
-
-    return ( 1, "reprovision started; watch $log_dir/$safe.log" );
+    return;
 }
 
-=head2 _credentials(%args) = ($credentials, $why)
+=head2 credentials(%args) = ($credentials, $why)
 
 What to hand the provisioner, out of whatever the form sent: a hashref of the
 names Trog::Credentials knows, or undef and a reason.
@@ -463,7 +389,7 @@ The reason, when there is one, is what the person reads -- so it has to tell
 
 =cut
 
-sub _credentials (%args) {
+my sub credentials (%args) {
     my $user = $args{user} // '';
 
     my %credentials;
@@ -516,7 +442,7 @@ sub _credentials (%args) {
 # send.  Refused rather than escaped or trimmed: no password anybody meant to
 # type has a newline in the middle of it, and quietly changing what somebody
 # typed into their own password field is worse than saying no.
-sub _sendable ($credentials) {
+my sub sendable ($credentials) {
     foreach my $name ( sort keys %$credentials ) {
         next unless $credentials->{$name} =~ m/[\r\n]/;
         return "the $name has a line break in it, which is not something this can send";
@@ -524,23 +450,97 @@ sub _sendable ($credentials) {
     return '';
 }
 
-# File away what they typed, so the next run is a code.
-#
-# Said rather than refused when it does not work: they asked for a reprovision
-# and gave us what it needs, and failing to keep a copy is not a reason to not do
-# the thing they asked for.
-sub _remember ( $user, $credentials ) {
-    my %vault_name = ( keepass => $secret_name, sudo => $sudo_name );
+=head2 reprovision(%args) = ($ok, $message)
 
-    foreach my $name ( sort keys %$credentials ) {
-        my ( $ok, $why ) = Trog::Vault::set( $user, $vault_name{$name}, $credentials->{$name} );
-        WARN("Could not remember the provisioner's $name for $user: $why") unless $ok;
+Run bin/provision for one guest, which generates its configuration from its
+recipe and then builds the machine.
+
+    domain      which guest.  Required, and validated as a hostname.
+    user        who asked.  For the log, and whose vault to look in.
+    passphrase  the KeePass passphrase the recipe's secrets need.
+    sudo        their sudo password on the hypervisor, if it wants one.
+    totp        a code, instead of those, when they have been stored.
+    remember    store what they just typed, so that next time is a code.
+
+Returns immediately.  Provisioning a machine takes minutes and an HTTP worker
+does not have minutes, so the work is handed to a detached process and the
+caller is told it started rather than told it finished.  What happened is in
+logs/reprovision/$domain.log, which is what log_tail reads back onto the page.
+
+=head3 WHY IT ASKS FOR ANYTHING AT ALL
+
+Two passwords, for two different reasons.
+
+Every recipe inherits secret: values from _base, so the provisioner opens a
+KeePass database on its way past and wants the passphrase to it.  The
+alternative to asking is keeping the master password for every secret an
+operator holds in a file the webserver can read, which is worse than asking.
+
+And almost everything it does on the hypervisor needs root.  Where the login
+there has passwordless sudo -- which is how ours are set up, and what we would
+recommend -- there is nothing to ask for.  Where it does not, sudo over ssh has
+no terminal to ask at, and a run that finds that out dies several minutes in on
+a prompt nobody will ever see.  So it is asked for here instead, and left empty
+by anybody who does not need it.
+
+Asking every time has its own cost, though: a passphrase somebody has to have to
+hand is a passphrase that gets written down, and then it is in a text file
+instead of a config file, which is not an improvement.  So it can be stored --
+see Trog::Vault, where it is sealed under a key the database does not contain --
+and then what this asks for is a TOTP code, which proves the person is here
+without their having to be holding anything.
+
+The code is spent either way, so it authorizes this one reprovision rather than
+every reprovision inside its window.
+
+However they arrive, they go down the child's stdin as a credentials block --
+see Trog::Credentials in trog-provisioner -- and are written nowhere: not the
+log, not the process table, not the configuration.
+
+=cut
+
+sub reprovision (%args) {
+    my $safe = safe_domain( $args{domain} );
+    return ( 0, 'bad guest name' ) unless $safe;
+
+    # The template does not draw the button for this guest.  This is what
+    # actually stops it: /guest/reprovision is a POST anybody holding the admin
+    # acl can craft by hand, and there would be nothing left to report to.
+    if ( Trog::DataSource::Virt::is_self($safe) ) {
+        WARN("Refused to reprovision '$safe': that is this server");
+        return ( 0, "'$safe' is this server -- refusing to reprovision it" );
     }
 
-    return;
+    my $config = config();
+    return ( 0, 'provisioner.trog_provisioner is not configured' ) unless $config->{trog_provisioner};
+
+    my $recipe = _recipe_path( $config, $safe );
+    return ( 0, "there is no recipe for '$safe' in $config->{recipes}" ) unless $recipe;
+
+    my ( $credentials, $why ) = credentials(%args);
+    return ( 0, $why ) unless $credentials;
+
+    my $unsendable = sendable($credentials);
+    return ( 0, $unsendable ) if $unsendable;
+
+    # One at a time.  Two provisions of one machine racing each other is not
+    # something anybody should be able to start by double clicking.
+    my $running = status($safe);
+    return ( 0, 'a reprovision of this guest is already running' ) if $running && $running->{state} eq 'running';
+
+    # --credentials, because nothing in there reads stdin unless it is told to.
+    my @command = ( "$config->{trog_provisioner}/bin/provision", '--credentials', $safe );
+    return ( 0, "$command[0] is not there to run" ) unless -x $command[0];    ## no critic (ProhibitFiletest_rwxRWX) -- refusing early beats finding out mid-provision
+
+    INFO( "Reprovision of '$safe' requested by " . ( $args{user} // 'somebody' ) );
+
+    my ( $ok, $failed ) = spawn( $safe, $credentials, $config->{trog_provisioner}, \@command, $args{user} );
+    return ( 0, $failed ) unless $ok;
+
+    return ( 1, "reprovision started; watch $log_dir/$safe.log" );
 }
 
-=head2 _spawn($domain, $credentials, $dir, $command, $user)
+=head2 spawn($domain, $credentials, $dir, $command, $user)
 
 Fork the provisioner off where nothing is waiting for it.
 
@@ -562,7 +562,7 @@ that has a newline in the middle of it.
 
 =cut
 
-sub _spawn ( $domain, $credentials, $dir, $command, $user ) {
+sub spawn ( $domain, $credentials, $dir, $command, $user ) {
     my $log = "$log_dir/$domain.log";
 
     local $@;
@@ -589,7 +589,7 @@ sub _spawn ( $domain, $credentials, $dir, $command, $user ) {
     # $$ is this process, which is the one that will still be here in ten
     # minutes -- the two before it have already gone.  status() checks it is
     # alive, so it has to be the pid of whatever is actually doing the work.
-    _write_status( $domain, state => 'running', pid => $$, started => $started, user => ( $user // '' ) );
+    write_status( $domain, state => 'running', pid => $$, started => $started, user => ( $user // '' ) );
 
     print {$fh} "\n--- $command->[0] $command->[1] (in $dir)\n";
 
@@ -624,7 +624,7 @@ sub _spawn ( $domain, $credentials, $dir, $command, $user ) {
     if ($?) {
         my $status = $? >> 8;
         print {$fh} "\n--- $command->[0] exited $status\n";
-        _write_status(
+        write_status(
             $domain,
             state    => 'failed',
             started  => $started,
@@ -637,7 +637,7 @@ sub _spawn ( $domain, $credentials, $dir, $command, $user ) {
     }
 
     print {$fh} "\n=== finished ===\n";
-    _write_status( $domain, state => 'ok', started => $started, finished => time(), exit => 0, user => ( $user // '' ) );
+    write_status( $domain, state => 'ok', started => $started, finished => time(), exit => 0, user => ( $user // '' ) );
     POSIX::_exit(0);
 }
 

lib/Trog/DataSource/Virt.pm

@@ -82,7 +82,7 @@ our $screenshot_dir = 'www/assets/private/datasource/virt';
 # Reconnecting per guest would be absurd -- one ssh handshake per hypervisor
 # per process is enough.  Not a state var: a connection that has gone away
 # should be retried rather than remembered.
-sub _connect ( $uri, $cache = {} ) {
+my sub _connect ( $uri, $cache = {} ) {
     return $cache->{$uri} if $cache->{$uri};
 
     local $@;
@@ -104,7 +104,7 @@ my @states = (
     'shutting down', 'shut off', 'crashed', 'suspended',
 );
 
-sub _state_name ($state) {
+my sub state_name ($state) {
     return $states[$state] // 'unknown';
 }
 
@@ -112,7 +112,7 @@ sub _state_name ($state) {
 # to be a different host without having to lie to Sys::Hostname.
 our $hostname;
 
-sub _hostname {
+my sub hostname {
     return $hostname if defined $hostname;
 
     local $@;
@@ -127,7 +127,7 @@ sub _hostname {
     return $hostname;
 }
 
-=head2 _is_self($name)
+=head2 is_self($name)
 
 Whether a guest by this name is the machine we are running on.
 
@@ -140,14 +140,37 @@ Returns false otherwise.
 
 =cut
 
-sub _is_self ($name) {
-    my $me = lc( _hostname() );
+sub is_self ($name) {
+    my $me = lc( hostname() );
     $name = lc( $name // '' );
 
     return 1 if $name eq $me;
     return 0;
 }
 
+my sub unreachable_post ( $hypervisor, $series, $form, $why ) {
+    return {
+        id               => "unreachable-$hypervisor->{id}",
+        title            => $hypervisor->{title} // 'hypervisor',
+        form             => $form,
+        data             => '',
+        state            => "unreachable: $why",
+        is_active        => 0,
+        unreachable      => 1,
+        hypervisor       => $hypervisor->{id},
+        hypervisor_title => $hypervisor->{title},
+        preview          => '',
+        local_href       => '',
+        href             => '',
+        tags             => $series->{tags}       // [],
+        visibility       => $series->{visibility} // 'private',
+        created          => time(),
+        version          => 0,
+        user             => $series->{user},
+        method           => 'GET',
+    };
+}
+
 =head2 posts($series, $query) = @posts
 
 One post per guest, across every hypervisor the series' relations pulled in.
@@ -172,7 +195,7 @@ sub posts ( $series, $ ) {
 
         my ( $conn, $why ) = _connect( $uri, \%cache );
         if ( !$conn ) {
-            push( @out, _unreachable_post( $hypervisor, $series, $form, $why ) );
+            push( @out, unreachable_post( $hypervisor, $series, $form, $why ) );
             next;
         }
 
@@ -181,11 +204,11 @@ sub posts ( $series, $ ) {
         if ($@) {
             my $err = "$@";
             $err =~ s/\n.*//s;
-            push( @out, _unreachable_post( $hypervisor, $series, $form, $err ) );
+            push( @out, unreachable_post( $hypervisor, $series, $form, $err ) );
             next;
         }
 
-        push( @out, map { _post_for( $_, $hypervisor, $series, $form ) } @domains );
+        push( @out, map { post_for( $_, $hypervisor, $series, $form ) } @domains );
     }
 
     return @out;
@@ -237,7 +260,14 @@ Where to read about it.
 sub lang { return 'Case insensitive substring of a guest name, state or hypervisor' }
 sub help { return 'https://en.wikipedia.org/wiki/Substring' }
 
-sub _post_for ( $domain, $hypervisor, $series, $form ) {
+=head2 post_for($domain, $hypervisor, $series, $form) = HASHREF
+
+The post that stands for the guest $domain, a Sys::Virt::Domain, on
+$hypervisor, in the listing of $series, rendered with $form.
+
+=cut
+
+sub post_for ( $domain, $hypervisor, $series, $form ) {
     my $name = $domain->get_name();
     my $info = $domain->get_info();
 
@@ -250,9 +280,9 @@ sub _post_for ( $domain, $hypervisor, $series, $form ) {
         data  => '',
 
         domain           => $name,
-        state            => _state_name( $info->{state} ),
+        state            => state_name( $info->{state} ),
         is_active        => $domain->is_active() ? 1 : 0,
-        is_self          => _is_self($name),
+        is_self          => is_self($name),
         memory           => $info->{memory},
         vcpus            => $info->{nrVirtCpu},
         hypervisor       => $hypervisor->{id},
@@ -274,29 +304,6 @@ sub _post_for ( $domain, $hypervisor, $series, $form ) {
     };
 }
 
-sub _unreachable_post ( $hypervisor, $series, $form, $why ) {
-    return {
-        id               => "unreachable-$hypervisor->{id}",
-        title            => $hypervisor->{title} // 'hypervisor',
-        form             => $form,
-        data             => '',
-        state            => "unreachable: $why",
-        is_active        => 0,
-        unreachable      => 1,
-        hypervisor       => $hypervisor->{id},
-        hypervisor_title => $hypervisor->{title},
-        preview          => '',
-        local_href       => '',
-        href             => '',
-        tags             => $series->{tags}       // [],
-        visibility       => $series->{visibility} // 'private',
-        created          => time(),
-        version          => 0,
-        user             => $series->{user},
-        method           => 'GET',
-    };
-}
-
 =head2 screenshot($hypervisor, $guest_name) = ($path, $error)
 
 Path to a reasonably fresh PNG of the guest's console.
@@ -379,7 +386,7 @@ sub act ( $action, $conn_uri, $domain_name, $user ) {
     # actually stops it happening.  /guest/act is a POST anybody holding the
     # admin acl can craft by hand, and if it went through there would be
     # nothing left running to report the mistake.
-    if ( _is_self($safe) && ( $action // '' ) =~ m/^(?:poweroff|destroy)$/ ) {
+    if ( is_self($safe) && ( $action // '' ) =~ m/^(?:poweroff|destroy)$/ ) {
         WARN("Refused guest action '$action' on '$safe': that is this server");
         return ( 0, "'$safe' is this server -- refusing to $action it" );
     }

lib/Trog/Enrich/Invoice.pm

@@ -11,7 +11,7 @@ use List::Util();
 The part of an invoice which has to be computed rather than merely fetched.
 
 Its payee and payor are ordinary relations, declared in invoice.json and
-resolved by Trog::Routes::HTML::_enrich_post like any other type's.  The
+resolved by Trog::Routes::HTML::enrich_post like any other type's.  The
 running total is not -- it is read out of the line items themselves.
 
 =head2 enrich($post, $query) = %extra

lib/Trog/FileHandler.pm

@@ -12,6 +12,64 @@ use Trog::Log qw{:all};
 use Trog::Vars;
 use Trog::Utils;
 
+my sub range ( $fullpath, $fh, $ranges, $sz, %headers ) {
+
+    # Set mode
+    my $primary_ct   = "Content-Type: $headers{'Content-type'}";
+    my $is_multipart = scalar(@$ranges) > 1;
+    if ($is_multipart) {
+        $headers{'Content-type'} = "multipart/byteranges; boundary=$Trog::Vars::CHUNK_SEP";
+    }
+    my $code = 206;
+
+    my $fc = '';
+
+    # Calculate the content-length up-front.  We have to fix unspecified lengths first, and reject bad requests.
+    foreach my $range (@$ranges) {
+        $range->[1] //= $sz - 1;
+        INFO("GET 416 31 $fullpath");
+        return [ 416, [%headers], ["Requested range not satisfiable"] ] if $range->[0] > $sz || $range->[0] < 0 || $range->[1] < 0 || $range->[0] > $range->[1];
+    }
+    $headers{'Content-Length'} = List::Util::sum( map { my $arr = $_; $arr->[1] + 1, -$arr->[0] } @$ranges );
+
+    #XXX Add the entity header lengths to the value - should hash-ify this to DRY
+    if ($is_multipart) {
+        foreach my $range (@$ranges) {
+            $headers{'Content-Length'} += length("$fc--$Trog::Vars::CHUNK_SEP\n$primary_ct\nContent-Range: bytes $range->[0]-$range->[1]/$sz\n\n");
+            $fc = "\n";
+        }
+        $headers{'Content-Length'} += length("\n--$Trog::Vars::CHUNK_SEP\--\n");
+        $fc = '';
+    }
+
+    #TODO log these requests with their length correctly
+    return sub {
+        my $responder = shift;
+        my $writer;
+
+        foreach my $range (@$ranges) {
+            $headers{'Content-Range'} = "bytes $range->[0]-$range->[1]/$sz" unless $is_multipart;
+            $writer //= $responder->( [ $code, [%headers] ] );
+            $writer->write("$fc--$Trog::Vars::CHUNK_SEP\n$primary_ct\nContent-Range: bytes $range->[0]-$range->[1]/$sz\n\n") if $is_multipart;
+            $fc = "\n";
+
+            my $len = List::Util::min( $sz, $range->[1] + 1 ) - $range->[0];
+
+            $fh->seek( $range->[0], 0 );
+            while ($len) {
+                $fh->read( my $buf, List::Util::min( $len, $Trog::Vars::CHUNK_SIZE ) );
+                $writer->write($buf);
+
+                # Adjust for amount written
+                $len = List::Util::max( $len - $Trog::Vars::CHUNK_SIZE, 0 );
+            }
+        }
+        $fh->close();
+        $writer->write("\n--$Trog::Vars::CHUNK_SEP\--\n") if $is_multipart;
+        $writer->close;
+    };
+}
+
 =head2 serve
 
 Serve a file, with options to stream and cache the output.
@@ -40,7 +98,7 @@ sub serve ( $fullpath, $path, $start, $streaming, $ranges, $last_fetch = 0, $def
     push( @headers, 'Vary'          => 'Accept-Encoding' );
 
     if ( open( my $fh, '<', $path ) ) {
-        return _range( $fullpath, $fh, $ranges, $sz, @headers ) if @$ranges && $streaming;
+        return range( $fullpath, $fh, $ranges, $sz, @headers ) if @$ranges && $streaming;
 
         # Transfer-encoding: chunked
         return sub {
@@ -87,62 +145,4 @@ sub serve ( $fullpath, $path, $start, $streaming, $ranges, $last_fetch = 0, $def
     return [ 403, [ $ct => $Trog::Vars::content_types{text} ], ["STAY OUT YOU RED MENACE"] ];
 }
 
-sub _range ( $fullpath, $fh, $ranges, $sz, %headers ) {
-
-    # Set mode
-    my $primary_ct   = "Content-Type: $headers{'Content-type'}";
-    my $is_multipart = scalar(@$ranges) > 1;
-    if ($is_multipart) {
-        $headers{'Content-type'} = "multipart/byteranges; boundary=$Trog::Vars::CHUNK_SEP";
-    }
-    my $code = 206;
-
-    my $fc = '';
-
-    # Calculate the content-length up-front.  We have to fix unspecified lengths first, and reject bad requests.
-    foreach my $range (@$ranges) {
-        $range->[1] //= $sz - 1;
-        INFO("GET 416 31 $fullpath");
-        return [ 416, [%headers], ["Requested range not satisfiable"] ] if $range->[0] > $sz || $range->[0] < 0 || $range->[1] < 0 || $range->[0] > $range->[1];
-    }
-    $headers{'Content-Length'} = List::Util::sum( map { my $arr = $_; $arr->[1] + 1, -$arr->[0] } @$ranges );
-
-    #XXX Add the entity header lengths to the value - should hash-ify this to DRY
-    if ($is_multipart) {
-        foreach my $range (@$ranges) {
-            $headers{'Content-Length'} += length("$fc--$Trog::Vars::CHUNK_SEP\n$primary_ct\nContent-Range: bytes $range->[0]-$range->[1]/$sz\n\n");
-            $fc = "\n";
-        }
-        $headers{'Content-Length'} += length("\n--$Trog::Vars::CHUNK_SEP\--\n");
-        $fc = '';
-    }
-
-    #TODO log these requests with their length correctly
-    return sub {
-        my $responder = shift;
-        my $writer;
-
-        foreach my $range (@$ranges) {
-            $headers{'Content-Range'} = "bytes $range->[0]-$range->[1]/$sz" unless $is_multipart;
-            $writer //= $responder->( [ $code, [%headers] ] );
-            $writer->write("$fc--$Trog::Vars::CHUNK_SEP\n$primary_ct\nContent-Range: bytes $range->[0]-$range->[1]/$sz\n\n") if $is_multipart;
-            $fc = "\n";
-
-            my $len = List::Util::min( $sz, $range->[1] + 1 ) - $range->[0];
-
-            $fh->seek( $range->[0], 0 );
-            while ($len) {
-                $fh->read( my $buf, List::Util::min( $len, $Trog::Vars::CHUNK_SIZE ) );
-                $writer->write($buf);
-
-                # Adjust for amount written
-                $len = List::Util::max( $len - $Trog::Vars::CHUNK_SIZE, 0 );
-            }
-        }
-        $fh->close();
-        $writer->write("\n--$Trog::Vars::CHUNK_SEP\--\n") if $is_multipart;
-        $writer->close;
-    };
-}
-
 1;

lib/Trog/Log.pm

@@ -110,7 +110,7 @@ sub log_init {
     my $dblog = Trog::Log::DBI->new(
         name      => 'dbi',
         min_level => $LEVEL,
-        dbh       => _dbh(),
+        dbh       => dbh(),
     );
 
     $log = Log::Dispatch->new();
@@ -129,7 +129,14 @@ sub log_init {
 #memoize
 my $rq;
 
-sub _dbh {
+=head2 dbh() = DBI::db
+
+The handle to the log database, under the log directory, with its schema
+applied.  Trog::SQLite caches it, so every call gets the same one.
+
+=cut
+
+sub dbh {
     return Trog::SQLite::dbh( 'schema/log.schema', "$LOGDIR/log.db" );
 }
 
@@ -161,7 +168,7 @@ sub uuid {
     return $requestid // $rq;
 }
 
-sub _log {
+my sub _log {
     my ( $msg, $level ) = @_;
 
     $msg //= "No message passed.  This is almost certainly a bug. ";
@@ -196,7 +203,7 @@ and the test suite.
 =cut
 
 # One path for every level so the uninitialized fallback only exists once.
-sub _emit ( $level, $method, $msg ) {
+my sub emit ( $level, $method, $msg ) {
     my $line = _log( $msg, $level );
     return $log->$method($line) if $log;
 
@@ -204,11 +211,11 @@ sub _emit ( $level, $method, $msg ) {
     return 1;
 }
 
-sub DEBUG { return _emit( 'DEBUG', 'debug', shift ) }
+sub DEBUG { return emit( 'DEBUG', 'debug', shift ) }
 
-sub INFO { return _emit( 'INFO', 'info', shift ) }
+sub INFO { return emit( 'INFO', 'info', shift ) }
 
-sub WARN { return _emit( 'WARN', 'warning', shift ) }
+sub WARN { return emit( 'WARN', 'warning', shift ) }
 
 sub FATAL {
     my $line = _log( shift, 'FATAL' );

lib/Trog/Log/Metrics.pm

@@ -59,7 +59,7 @@ sub requests_per ( $period, $num_periods, $before, @codes ) {
     ## no critic(ValuesAndExpressions::PreventSQLInjection)
     my $query = "SELECT count(*) FROM all_requests $whereclause GROUP BY date / ? HAVING date < ? LIMIT ?";
 
-    my @results = map { $_->[0] } @{ Trog::Log::_dbh()->selectall_arrayref( $query, undef, @input ) };
+    my @results = map { $_->[0] } @{ Trog::Log::dbh()->selectall_arrayref( $query, undef, @input ) };
     my $np      = @results < $num_periods ? @results : $num_periods;
     my @labels  = reverse map { "$_ $period(s) ago" } ( 1 .. $np );
 

lib/Trog/Renderer.pm

@@ -36,6 +36,31 @@ our %renderers = (
     email => \&Trog::Renderer::email::render,
 );
 
+my sub yeet ( $renderer, $error, %options ) {
+    WARN($error);
+
+    # All-else fails error page
+    my $ret;
+    local $@;
+    eval {
+        $ret = $renderer->(
+            code        => 500,
+            template    => '500.tx',
+            contenttype => 'text/html',
+            data        => { %options, content => "<h1>500 Internal Server Error</h1>$error" },
+        );
+        1;
+    } or do {
+        my $msg = $error;
+        $msg .= " and subsequently during render of error template, $@" if $renderer;
+
+        #XXX bytes is probably not correct here
+        INFO( "$options{data}{method} 500 " . length($msg) . " $options{data}{route}" );
+        FATAL($msg);
+    };
+    return $ret;
+}
+
 =head2 Trog::Renderer->render(%options)
 
 Returns either the 3-arg arrayref suitable to emit at the end of a PSGI session or a response body if the component field of options is truthy.
@@ -46,14 +71,14 @@ The idea is that components will be concatenated to other rendered templates unt
 sub render ( $, %options ) {
     local $@;
     my $renderer;
-    return _yeet( $renderer, "Renderer requires a valid content type to be passed", %options ) unless $options{contenttype};
+    return yeet( $renderer, "Renderer requires a valid content type to be passed", %options ) unless $options{contenttype};
     my $rendertype = $Trog::Vars::byct{ $options{contenttype} };
-    return _yeet( $renderer, "Renderer requires a known content type (used $options{contenttype}) to be passed", %options ) unless $rendertype;
+    return yeet( $renderer, "Renderer requires a known content type (used $options{contenttype}) to be passed", %options ) unless $rendertype;
     $renderer = $renderers{$rendertype};
-    return _yeet( $renderer, "Renderer for $rendertype is not defined!", %options ) unless $renderer;
-    return _yeet( $renderer, "Status code not provided",                 %options ) if !$options{code} && !$options{component};
-    return _yeet( $renderer, "Template data not provided",               %options ) unless $options{data};
-    return _yeet( $renderer, "Template not provided",                    %options ) unless $options{template};
+    return yeet( $renderer, "Renderer for $rendertype is not defined!", %options ) unless $renderer;
+    return yeet( $renderer, "Status code not provided",                 %options ) if !$options{code} && !$options{component};
+    return yeet( $renderer, "Template data not provided",               %options ) unless $options{data};
+    return yeet( $renderer, "Template not provided",                    %options ) unless $options{template};
 
     #TODO future - save the components too and then compose them?
     my $data = $options{data};
@@ -88,32 +113,7 @@ sub render ( $, %options ) {
         }
         1;
     } or do {
-        return _yeet( $renderer, $@, %options );
-    };
-    return $ret;
-}
-
-sub _yeet ( $renderer, $error, %options ) {
-    WARN($error);
-
-    # All-else fails error page
-    my $ret;
-    local $@;
-    eval {
-        $ret = $renderer->(
-            code        => 500,
-            template    => '500.tx',
-            contenttype => 'text/html',
-            data        => { %options, content => "<h1>500 Internal Server Error</h1>$error" },
-        );
-        1;
-    } or do {
-        my $msg = $error;
-        $msg .= " and subsequently during render of error template, $@" if $renderer;
-
-        #XXX bytes is probably not correct here
-        INFO( "$options{data}{method} 500 " . length($msg) . " $options{data}{route}" );
-        FATAL($msg);
+        return yeet( $renderer, $@, %options );
     };
     return $ret;
 }

lib/Trog/Renderer/css.pm

@@ -8,6 +8,10 @@ use parent qw{Trog::Renderer::Base};
 
 use CSS::Minifier::XS;
 
+my sub minify {
+    return CSS::Minifier::XS::minify(shift);
+}
+
 =head1 Trog::Renderer::css
 
 Render CSS, and minify the output.
@@ -15,12 +19,8 @@ Render CSS, and minify the output.
 =cut
 
 sub render (%options) {
-    $options{post_processor} = \&_minify;
+    $options{post_processor} = \&minify;
     return Trog::Renderer::Base::render(%options);
 }
 
-sub _minify {
-    return CSS::Minifier::XS::minify(shift);
-}
-
 1;

lib/Trog/Renderer/javascript.pm

@@ -8,6 +8,10 @@ use parent qw{Trog::Renderer::Base};
 
 use JavaScript::Minifier::XS;
 
+my sub minify {
+    return JavaScript::Minifier::XS::minify(shift);
+}
+
 =head1 Trog::Renderer::javascript
 
 Render JS, and minify the output.
@@ -15,12 +19,8 @@ Render JS, and minify the output.
 =cut
 
 sub render (%options) {
-    $options{post_processor} = \&_minify;
+    $options{post_processor} = \&minify;
     return Trog::Renderer::Base::render(%options);
 }
 
-sub _minify {
-    return JavaScript::Minifier::XS::minify(shift);
-}
-
 1;

lib/Trog/Routes/JSON.pm

@@ -76,7 +76,7 @@ foreach my $r ( keys(%$cloned) ) {
 }
 
 # Note to authors, don't forget to update this
-sub _version () {
+my sub _version () {
     return '1.0';
 }
 
@@ -86,6 +86,19 @@ sub version {
     return $ret;
 }
 
+my sub _render ( $code, $headers, %data ) {
+    return Trog::Renderer->render(
+        code        => $code,
+        data        => \%data,
+        template    => 'bogus.tx',
+        contenttype => 'application/json',
+        headers     => $headers,
+
+        # TODO it may be appropriate to cache some of these methods.
+        nocache => 1,
+    );
+}
+
 sub catalog {
     return _render( 200, { ETag => 'catalog-' . _version() }, %$cloned );
 }
@@ -133,7 +146,7 @@ nobody's business here.
 =cut
 
 sub posts_of_form ($query) {
-    my @posts = Trog::Routes::HTML::_post_helper( { form => $query->{form}, limit => 0 }, [], [ Trog::Routes::HTML::_viewer_acls($query) ] );
+    my @posts = Trog::Routes::HTML::post_helper( { form => $query->{form}, limit => 0 }, [], [ Trog::Routes::HTML::viewer_acls($query) ] );
 
     return _render(
         200, undef,
@@ -149,17 +162,4 @@ sub requests_per ($query) {
     );
 }
 
-sub _render ( $code, $headers, %data ) {
-    return Trog::Renderer->render(
-        code        => $code,
-        data        => \%data,
-        template    => 'bogus.tx',
-        contenttype => 'application/json',
-        headers     => $headers,
-
-        # TODO it may be appropriate to cache some of these methods.
-        nocache => 1,
-    );
-}
-
 1;

lib/Trog/Routes/TXT.pm

@@ -21,6 +21,16 @@ our %routes = (
     },
 );
 
+my sub _render ( $code, $headers, %data ) {
+    return Trog::Renderer->render(
+        code        => $code,
+        data        => \%data,
+        template    => 'zone.tx',
+        contenttype => 'text/plain',
+        headers     => $headers,
+    );
+}
+
 =head1 Trog::Routes::TXT
 
 Routes which render as text/plain.
@@ -62,14 +72,4 @@ sub zone ($query) {
     return _render( 200, {}, $query );
 }
 
-sub _render ( $code, $headers, %data ) {
-    return Trog::Renderer->render(
-        code        => $code,
-        data        => \%data,
-        template    => 'zone.tx',
-        contenttype => 'text/plain',
-        headers     => $headers,
-    );
-}
-
 1;

lib/Trog/SQLite/TagIndex.pm

@@ -20,7 +20,7 @@ Also used to retrieve cached routes from posts.
 =cut
 
 sub posts_for_tags (@tags) {
-    my $dbh    = _dbh();
+    my $dbh    = dbh();
     my $clause = @tags ? "WHERE tag IN (" . join( ',', ( map { '?' } @tags ) ) . ")" : '';
     ## no critic(ValuesAndExpressions::PreventSQLInjection)
     my $rows = $dbh->selectall_arrayref( "SELECT DISTINCT id FROM posts $clause ORDER BY created DESC", { Slice => {} }, @tags );
@@ -29,7 +29,7 @@ sub posts_for_tags (@tags) {
 }
 
 sub routes {
-    my $dbh  = _dbh();
+    my $dbh  = dbh();
     my $rows = $dbh->selectall_arrayref( "SELECT id, route, method, callback FROM all_routes", { Slice => {} } );
     return () unless ref $rows eq 'ARRAY' && @$rows;
 
@@ -39,7 +39,7 @@ sub routes {
 }
 
 sub aliases {
-    my $dbh  = _dbh();
+    my $dbh  = dbh();
     my $rows = $dbh->selectall_arrayref( "SELECT actual,alias FROM aliases", { Slice => {} } );
     return () unless ref $rows eq 'ARRAY' && @$rows;
     my %aliases = map { $_->{alias} => $_->{actual} } @$rows;
@@ -47,14 +47,14 @@ sub aliases {
 }
 
 sub tags {
-    my $dbh  = _dbh();
+    my $dbh  = dbh();
     my $rows = $dbh->selectall_arrayref( "SELECT name FROM tag", { Slice => {} } );
     return () unless ref $rows eq 'ARRAY' && @$rows;
     return map { $_->{name} } @$rows;
 }
 
 sub add_post ( $post, $data_obj ) {
-    my $dbh = _dbh();
+    my $dbh = dbh();
     Trog::SQLite::transaction(
         $dbh,
         sub {
@@ -79,7 +79,7 @@ The HTTP methods are kept, as the schema fills those rather than any post.
 =cut
 
 sub rebuild ($data_obj) {
-    my $dbh = _dbh();
+    my $dbh = dbh();
     Trog::SQLite::transaction(
         $dbh,
         sub {
@@ -95,7 +95,7 @@ sub rebuild ($data_obj) {
 }
 
 sub remove_post ($post) {
-    my $dbh = _dbh();
+    my $dbh = dbh();
 
     # Deleting the post will cascade to the post index & primary route, which cascades to the aliases
     $dbh->do( "DELETE FROM post WHERE uuid=?", undef, $post->{id} );
@@ -107,14 +107,21 @@ sub remove_post ($post) {
     return 1;
 }
 
+my sub id_for_uuid ( $dbh, @uuids ) {
+    my $bind = join( ',', ( map { '?' } @uuids ) );
+    Trog::SQLite::bulk_insert( $dbh, 'post', ['uuid'], 'IGNORE', @uuids );
+    ## no critic(ValuesAndExpressions::PreventSQLInjection)
+    return $dbh->selectall_hashref( "SELECT id,uuid FROM post WHERE uuid IN ($bind)", 'uuid', {}, @uuids );
+}
+
 sub build_index ( $data_obj, $posts = [] ) {
-    my $dbh = _dbh();
+    my $dbh = dbh();
     $posts = $data_obj->read( { limit => 0, acls => ['admin'] } ) unless @$posts;
 
     # First, slap in the UUIDs
     my @uuids = map { $_->{id} } @$posts;
     Trog::SQLite::bulk_insert( $dbh, 'post', ['uuid'], 'IGNORE', @uuids );
-    my $pids = _id_for_uuid( $dbh, @uuids );
+    my $pids = id_for_uuid( $dbh, @uuids );
     foreach my $post (@$posts) {
         $post->{post_id} = $pids->{ $post->{id} }{id};
     }
@@ -141,20 +148,13 @@ sub build_index ( $data_obj, $posts = [] ) {
     return 1;
 }
 
-sub _id_for_uuid ( $dbh, @uuids ) {
-    my $bind = join( ',', ( map { '?' } @uuids ) );
-    Trog::SQLite::bulk_insert( $dbh, 'post', ['uuid'], 'IGNORE', @uuids );
-    ## no critic(ValuesAndExpressions::PreventSQLInjection)
-    return $dbh->selectall_hashref( "SELECT id,uuid FROM post WHERE uuid IN ($bind)", 'uuid', {}, @uuids );
-}
-
 # It is important we use get() instead of read() because of incomplete data.
 sub build_routes ( $data_obj, $posts = [] ) {
-    my $dbh = _dbh();
+    my $dbh = dbh();
     @$posts = $data_obj->get( limit => 0, acls => ['admin'] ) unless @$posts;
 
     my @uuids = map { $_->{id} } @$posts;
-    my $pids  = _id_for_uuid( $dbh, @uuids );
+    my $pids  = id_for_uuid( $dbh, @uuids );
     foreach my $post (@$posts) {
         $post->{post_id} = $pids->{ $post->{id} }{id};
     }
@@ -185,8 +185,14 @@ sub build_routes ( $data_obj, $posts = [] ) {
     return 1;
 }
 
-# Ensure the db schema is OK, and give us a handle
-sub _dbh {
+=head2 dbh() = DBI::db
+
+The handle to the tag index, data/posts.db, with its schema applied.
+Trog::SQLite caches it, so every call gets the same one.
+
+=cut
+
+sub dbh {
     my $file   = 'schema/flatfile.schema';
     my $dbname = "data/posts.db";
     return Trog::SQLite::dbh( $file, $dbname );

lib/Trog/Themes.pm

@@ -82,7 +82,7 @@ sub td {
 # The theme's template dir and the stock one, in that order of preference.
 # The theme entry is empty when no theme is configured, so callers can just
 # grep for truth rather than repeating the "is there a theme" dance.
-sub _template_dirs ( $content_type, $is_component = 0 ) {
+my sub _template_dirs ( $content_type, $is_component = 0 ) {
     my $ct    = $Trog::Vars::byct{$content_type};
     my $theme = get_dir();
 
@@ -128,7 +128,7 @@ sub template_dir ( $template, $content_type, $is_component = 0, $is_dir = 0 ) {
 }
 
 # Pick appropriate dir based on whether theme override exists
-sub _dir_for_resource ($resource) {
+my sub dir_for_resource ($resource) {
     my $theme_dir = get_dir();
     return $theme_dir && -f "$theme_dir/$resource" ? $theme_dir : '';    ## no critic (ProhibitFiletest_f) -- theme override, else stock
 }
@@ -140,7 +140,7 @@ Path to a www/-relative resource, preferring the theme's copy.
 =cut
 
 sub themed ($resource) {
-    return _dir_for_resource("$resource") . "/$resource";
+    return dir_for_resource("$resource") . "/$resource";
 }
 
 =head2 themed_style($resource) = @hrefs
@@ -154,7 +154,7 @@ rules without restating the whole thing.
 # For style we want to load *both* style files and have the override come later.
 sub themed_style ($resource) {
     my @styles = ("/styles/$resource");
-    my $styled = _dir_for_resource("styles/$resource");
+    my $styled = dir_for_resource("styles/$resource");
     $styled =~ s/^www\///;
     push( @styles, "/$styled/styles/$resource" ) if $styled;
     return @styles;
@@ -167,7 +167,7 @@ Path to a script under www/scripts, preferring the theme's copy.
 =cut
 
 sub themed_script ($resource) {
-    return _dir_for_resource("scripts/$resource") . "/scripts/$resource";
+    return dir_for_resource("scripts/$resource") . "/scripts/$resource";
 }
 
 =head2 themed_template($resource)
@@ -177,7 +177,7 @@ Path to a template under www/templates, preferring the theme's copy.
 =cut
 
 sub themed_template ($resource) {
-    return _dir_for_resource("templates/$resource") . "/templates/$resource";
+    return dir_for_resource("templates/$resource") . "/templates/$resource";
 }
 
 =head2 dir_for($path, $content_type, $is_component)
@@ -204,18 +204,7 @@ sub forms_dir {
     return dir_for( 'forms', 'text/html', 1 );
 }
 
-=head2 files_in_dir($path, $content_type, $is_component, $ext)
-
-Bare filenames with the given extension in whichever single directory dir_for()
-picks.  See themed_templates_in_dir() for the version which spans both.
-
-=cut
-
-sub files_in_dir ( $path, $ct, $is_component = 0, $ext = 'tx' ) {
-    return _read_dir( dir_for( $path, $ct, $is_component ), $ext );
-}
-
-sub _read_dir ( $dir, $ext ) {
+my sub read_dir ( $dir, $ext ) {
     my $files = [];
     return $files unless -d $dir;
     opendir( my $dh, $dir ) or return $files;
@@ -226,6 +215,17 @@ sub _read_dir ( $dir, $ext ) {
     return $files;
 }
 
+=head2 files_in_dir($path, $content_type, $is_component, $ext)
+
+Bare filenames with the given extension in whichever single directory dir_for()
+picks.  See themed_templates_in_dir() for the version which spans both.
+
+=cut
+
+sub files_in_dir ( $path, $ct, $is_component = 0, $ext = 'tx' ) {
+    return read_dir( dir_for( $path, $ct, $is_component ), $ext );
+}
+
 =head2 templates_in_dir($path, $content_type, $is_component)
 
 files_in_dir() restricted to templates.
@@ -260,7 +260,7 @@ sub themed_templates_in_dir ( $path, $ct, $is_component = 0 ) {
 
     my ( @templates, %seen );
     foreach my $dir (@dirs) {
-        foreach my $template ( @{ _read_dir( $dir, 'tx' ) } ) {
+        foreach my $template ( @{ read_dir( $dir, 'tx' ) } ) {
 
             # First one wins, and the theme's dir comes first.
             push( @templates, $template ) unless $seen{$template}++;

lib/Trog/Vault.pm

@@ -108,19 +108,10 @@ so, rather than presenting as corruption.
 
 # 32 raw bytes.  Read at load: see WHERE THE KEY IS -- this is the moment the
 # environment is scrubbed, and it has to be before anything forks.
-our $key_file       = 'config/secrets.key';
-our $credential     = 'tpsgi-vault';
-our $key_bytes      = 32;
-our $master         = _from_env();
-our $looked_further = 0;
-
-sub _from_env {
-    my $raw = delete $ENV{TPSGI_VAULT_KEY};
-    return undef unless $raw;
-    return _decode( $raw, 'TPSGI_VAULT_KEY' );
-}
-
-sub _decode ( $raw, $whence ) {
+our $key_file   = 'config/secrets.key';
+our $credential = 'tpsgi-vault';
+our $key_bytes  = 32;
+my sub decode ( $raw, $whence ) {
     $raw =~ s/\s+//g;
     my $key = eval { Crypt::Misc::decode_b64($raw) };
     if ( !defined $key || length($key) != $key_bytes ) {
@@ -130,17 +121,26 @@ sub _decode ( $raw, $whence ) {
     return $key;
 }
 
+my sub from_env {
+    my $raw = delete $ENV{TPSGI_VAULT_KEY};
+    return undef unless $raw;
+    return decode( $raw, 'TPSGI_VAULT_KEY' );
+}
+
+our $master         = from_env();
+our $looked_further = 0;
+
 # The two places worth looking that are not the environment.  Deferred rather
 # than done at load, since both are files and this module is loaded by things
 # which have no interest in a vault.
-sub _look_further {
+my sub look_further {
     $looked_further = 1;
 
     my $dir = $ENV{CREDENTIALS_DIRECTORY};
     if ($dir) {
         my $path = "$dir/$credential";
         my $raw  = eval { File::Slurper::read_binary($path) };
-        return _decode( $raw, $path ) if defined $raw;
+        return decode( $raw, $path ) if defined $raw;
     }
 
     my $raw = eval { File::Slurper::read_binary($key_file) };
@@ -152,7 +152,7 @@ sub _look_further {
     my @stat = stat($key_file);
     WARN("$key_file is readable by more than its owner; chmod 600 it") if @stat && ( $stat[2] & oct('077') );
 
-    return _decode( $raw, $key_file );
+    return decode( $raw, $key_file );
 }
 
 =head2 key() = STRING or undef
@@ -168,7 +168,7 @@ losing it.
 =cut
 
 sub key {
-    $master //= _look_further() unless $looked_further;
+    $master //= look_further() unless $looked_further;
     return $master;
 }
 
@@ -188,13 +188,23 @@ sub key_id {
 
 # Bound into the ciphertext, so that moving a row between users or renaming it
 # breaks the tag rather than working.
-sub _aad ( $user, $name ) { return join( "\0", $user, $name ) }
+my sub aad ( $user, $name ) { return join( "\0", $user, $name ) }
 
-sub _derive ($salt) {
+my sub derive ($salt) {
     my $material = Crypt::KeyDerivation::hkdf( key(), $salt, 'SHA256', 44, 'tcms/user-secret' );
     return ( substr( $material, 0, 32 ), substr( $material, 32, 12 ) );
 }
 
+# A name is a label in a form and a key in a table, and it is half of what binds
+# a row to its owner, so it is a short plain thing or it is nothing.
+my sub safe_name ($name) {
+    return 0 if !$name || length $name > 64;
+    return $name =~ m/^[A-Za-z0-9][A-Za-z0-9._-]*$/ ? 1 : 0;
+}
+
+# The same database the users are in, since a secret belongs to one.
+my sub dbh { return Trog::SQLite::dbh( 'schema/auth.schema', 'config/auth.db' ) }
+
 =head2 set($user, $name, $secret) = ($ok, $message)
 
 Remember one thing for one user, replacing whatever was there under that name.
@@ -203,18 +213,18 @@ Remember one thing for one user, replacing whatever was there under that name.
 
 sub set ( $user, $name, $secret ) {
     return ( 0, 'this installation has no vault key, so there is nowhere to keep it' ) unless has_key();
-    return ( 0, 'a secret needs a name' )                                              unless _safe_name($name);
+    return ( 0, 'a secret needs a name' )                                              unless safe_name($name);
     return ( 0, 'nothing to store' )                                                   unless ( $secret // q{} ) ne q{};
 
     my $salt = Crypt::PRNG::random_bytes(32);
-    my ( $key, $iv ) = _derive($salt);
+    my ( $key, $iv ) = derive($salt);
 
     my $gcm = Crypt::AuthEnc::GCM->new( 'AES', $key, $iv );
-    $gcm->adata_add( _aad( $user, $name ) );
+    $gcm->adata_add( aad( $user, $name ) );
     my $ciphertext = $gcm->encrypt_add($secret);
     my $tag        = $gcm->encrypt_done();
 
-    my $dbh = _dbh();
+    my $dbh = dbh();
     eval {
         $dbh->do(
             "INSERT OR REPLACE INTO user_secret (username, name, key_id, salt, ciphertext, tag, created) VALUES (?,?,?,?,?,?,?)",
@@ -230,23 +240,27 @@ sub set ( $user, $name, $secret ) {
     return ( 1, "'$name' stored" );
 }
 
-=head2 get($user, $name) = STRING or undef
-
-What was stored, or undef if there is nothing under that name, no key to open it
-with, or a key which is not the one it was sealed under.
-
-Every call is an audit_log row.  Reading a stored password is the interesting
-event here, not writing one.
+# The plaintext, or undef with a reason in the log.  Never dies: a row that will
+# not open is a thing to report to somebody who can store it again, not an
+# exception halfway through drawing a page.
+my sub _open ( $row, $user, $name ) {
+    if ( $row->{key_id} ne key_id() ) {
+        WARN( "'$name' for $user was sealed under vault key $row->{key_id}, and this installation has " . key_id() );
+        return undef;
+    }
 
-=cut
+    my ( $key, $iv ) = derive( $row->{salt} );
+    my $gcm = Crypt::AuthEnc::GCM->new( 'AES', $key, $iv );
+    $gcm->adata_add( aad( $user, $name ) );
+    my $secret = $gcm->decrypt_add( $row->{ciphertext} );
 
-sub get ( $user, $name ) {
-    my $secret = _stored( $user, $name );
-    return undef unless defined $secret;
+    # The tag is the whole point: it says this ciphertext, under this key, for
+    # this user and this name, is the one that was written.
+    if ( !$gcm->decrypt_done( $row->{tag} ) ) {
+        WARN("'$name' for $user did not survive its own tag check; it has been tampered with or the database is damaged");
+        return undef;
+    }
 
-    my $dbh = _dbh();
-    $dbh->do( "UPDATE user_secret SET last_used=? WHERE username=? AND name=?", undef, time(), $user, $name );
-    Trog::Auth::log_event( 'secret_read', $user );
     return $secret;
 }
 
@@ -261,10 +275,10 @@ sub get ( $user, $name ) {
 # What get() adds is that reading a secret is an event: it moves last_used and
 # writes to the audit log.  Asking whether one is usable is not an event, and
 # does not.
-sub _stored ( $user, $name ) {
+my sub stored ( $user, $name ) {
     return undef unless has_key();
 
-    my $dbh  = _dbh();
+    my $dbh  = dbh();
     my $rows = $dbh->selectall_arrayref(
         "SELECT key_id, salt, ciphertext, tag FROM user_secret WHERE username=? AND name=?",
         { Slice => {} }, $user, $name
@@ -274,27 +288,23 @@ sub _stored ( $user, $name ) {
     return _open( $rows->[0], $user, $name );
 }
 
-# The plaintext, or undef with a reason in the log.  Never dies: a row that will
-# not open is a thing to report to somebody who can store it again, not an
-# exception halfway through drawing a page.
-sub _open ( $row, $user, $name ) {
-    if ( $row->{key_id} ne key_id() ) {
-        WARN( "'$name' for $user was sealed under vault key $row->{key_id}, and this installation has " . key_id() );
-        return undef;
-    }
+=head2 get($user, $name) = STRING or undef
 
-    my ( $key, $iv ) = _derive( $row->{salt} );
-    my $gcm = Crypt::AuthEnc::GCM->new( 'AES', $key, $iv );
-    $gcm->adata_add( _aad( $user, $name ) );
-    my $secret = $gcm->decrypt_add( $row->{ciphertext} );
+What was stored, or undef if there is nothing under that name, no key to open it
+with, or a key which is not the one it was sealed under.
 
-    # The tag is the whole point: it says this ciphertext, under this key, for
-    # this user and this name, is the one that was written.
-    if ( !$gcm->decrypt_done( $row->{tag} ) ) {
-        WARN("'$name' for $user did not survive its own tag check; it has been tampered with or the database is damaged");
-        return undef;
-    }
+Every call is an audit_log row.  Reading a stored password is the interesting
+event here, not writing one.
+
+=cut
+
+sub get ( $user, $name ) {
+    my $secret = stored( $user, $name );
+    return undef unless defined $secret;
 
+    my $dbh = dbh();
+    $dbh->do( "UPDATE user_secret SET last_used=? WHERE username=? AND name=?", undef, time(), $user, $name );
+    Trog::Auth::log_event( 'secret_read', $user );
     return $secret;
 }
 
@@ -307,7 +317,7 @@ you can read off a screen is one you did not need us to keep.
 =cut
 
 sub list ($user) {
-    my $dbh  = _dbh();
+    my $dbh  = dbh();
     my $rows = $dbh->selectall_arrayref(
         "SELECT name, created, last_used, key_id, salt, ciphertext, tag FROM user_secret WHERE username=? ORDER BY name",
         { Slice => {} }, $user
@@ -340,27 +350,17 @@ not.  This moves nothing and writes nothing to the audit log.
 
 =cut
 
-sub has ( $user, $name ) { return defined _stored( $user, $name ) ? 1 : 0 }
+sub has ( $user, $name ) { return defined stored( $user, $name ) ? 1 : 0 }
 
 =head2 forget($user, $name) = BOOL
 
 =cut
 
 sub forget ( $user, $name ) {
-    my $dbh = _dbh();
+    my $dbh = dbh();
     my $res = $dbh->do( "DELETE FROM user_secret WHERE username=? AND name=?", undef, $user, $name );
     Trog::Auth::log_event( 'secret_delete', $user ) if $res && $res != 0;
     return $res && $res != 0 ? 1 : 0;
 }
 
-# A name is a label in a form and a key in a table, and it is half of what binds
-# a row to its owner, so it is a short plain thing or it is nothing.
-sub _safe_name ($name) {
-    return 0 if !$name || length $name > 64;
-    return $name =~ m/^[A-Za-z0-9][A-Za-z0-9._-]*$/ ? 1 : 0;
-}
-
-# The same database the users are in, since a secret belongs to one.
-sub _dbh { return Trog::SQLite::dbh( 'schema/auth.schema', 'config/auth.db' ) }
-
 1;

schema/sqlite.schema

@@ -109,7 +109,7 @@ END;
 /* step with the blob on its own.                                               */
 /*                                                                              */
 /* Tags only, and deliberately.  A post's acls are folded into its tags by       */
-/* Trog::DataModule::_process(), which then deletes the acls field outright, so  */
+/* Trog::DataModule::process(), which then deletes the acls field outright, so  */
 /* tags is the whole truth about who may see a post -- and get() has always      */
 /* answered the acls filter by looking at tags.  Indexing an acls field here as  */
 /* well would let a post carrying one be found by a caller holding that acl even */
@@ -127,7 +127,7 @@ CREATE TRIGGER posts_tags_insert AFTER INSERT ON posts BEGIN
     INSERT INTO post_tags (post_id, tag)
         SELECT new.id, value FROM json_each(json_extract(new.post_data, '$.tags'))
         WHERE json_type(new.post_data, '$.tags') = 'array'
-        /* A null in the array is not a tag.  Trog::DataModule::_process() used  */
+        /* A null in the array is not a tag.  Trog::DataModule::process() used  */
         /* to push a post's visibility into its tags without defaulting it       */
         /* first, so posts written before that carry a null there -- and a null  */
         /* tag is one no query ever matches, which is exactly what leaving it    */

t/Trog-Data-SQLite.t

@@ -47,7 +47,7 @@ require_ok('Trog::Data::FlatFile') or BAIL_OUT("Can't find the model to compare
 require Trog::Config;
 require Trog::SQLite::TagIndex;
 
-# _fixup() decorates every post with the author's display name and avatar class,
+# fixup() decorates every post with the author's display name and avatar class,
 # which would otherwise drag the auth database in.  Not what is under test.
 my $auth = Test::MockModule->new('Trog::Auth');
 $auth->redefine( username2display   => sub { return "Display $_[0]" } );
@@ -78,7 +78,7 @@ sub post {
         callback   => 'Trog::Routes::HTML::posts',
         %o,
 
-        # _process() pushes visibility into tags, so the corpus does too.
+        # process() pushes visibility into tags, so the corpus does too.
         tags => [ @{ $o{tags} // ['blog'] }, $o{visibility} // 'public' ],
     };
 }
@@ -92,7 +92,7 @@ my @corpus = (
     post( id => 'p-series',   title => 'A Series',            data => 'holds other posts',                      form       => 'series.tx', aclname => 'aseries', tags => [qw{series topbar}] ),
     post( id => 'p-slides',   title => 'A Deck',              data => [ 'slide one about foxes', 'slide two' ], form       => 'presentation.tx' ),
 
-    # What _process() leaves behind for a private post with an acl: the acl is
+    # What process() leaves behind for a private post with an acl: the acl is
     # folded into tags and the acls field is deleted outright.
     post( id => 'p-acl', title => 'Members Only', data => 'for the club', visibility => 'private', tags => [qw{blog aseries}] ),
 );
@@ -228,7 +228,7 @@ subtest 'a direct lookup still answers only to the acls' => sub {
 
 subtest 'a caller who can see nothing is not queried for' => sub {
     my $mock = Test::MockModule->new('Trog::Data::SQLite');
-    $mock->redefine( _dbh => sub { die "queried the database\n" } );
+    $mock->redefine( dbh => sub { die "queried the database\n" } );
 
     is( exception { is_deeply( $sqlite->read( { limit => 0, acls => [] } ), [], 'no acls get nothing' ) }, undef, 'without asking the database' );
     is( exception { is_deeply( $sqlite->read( { limit => 0, acls => [], id => 'p-public' } ), [], 'nor by id' ) }, undef, 'nor for a direct lookup' );
@@ -398,7 +398,7 @@ subtest 'tags a post might really have' => sub {
         is( exception { $sqlite->write( [$post] ) }, undef, "a post with $id tags is storable" );
     }
 
-    # The one that actually bit: Trog::DataModule::_process() pushed a post's
+    # The one that actually bit: Trog::DataModule::process() pushed a post's
     # visibility into its tags without defaulting it first, so posts written
     # before that carry a null there, and a whole site's migration fell over on
     # the NOT NULL constraint rather than on anything wrong with the post.
@@ -427,7 +427,7 @@ subtest 'the triggers can be fixed after the fact' => sub {
     $dbh->do( 'CREATE TRIGGER posts_tags_insert AFTER INSERT ON posts BEGIN INSERT INTO post_tags (post_id, tag) VALUES (new.id, %s); END;' =~ s/%s/'wrong'/r );
 
     # What a worker starting up does.
-    Trog::Data::SQLite::_dbh();
+    Trog::Data::SQLite::dbh();
     my $schema = File::Slurper::read_text('schema/sqlite.schema');
     $dbh->{sqlite_allow_multiple_statements} = 1;
     $dbh->do($schema);

t/Trog-DataModule-schema.t

@@ -189,7 +189,7 @@ subtest 'validate() filters, coerces and reports' => sub {
 subtest 'what gets written is checked, not just what was submitted' => sub {
     set_sidecars();
 
-    # validate() runs on the submitted post.  _process() then builds the shape
+    # validate() runs on the submitted post.  process() then builds the shape
     # that is actually stored, and until it was checked too, a post could be
     # made wrong on its way to disk and nobody would ever hear about it.
     my $good = { form => 'blog.tx', title => 'Fine', tags => [qw{blog public}], visibility => 'public' };
@@ -200,7 +200,7 @@ subtest 'what gets written is checked, not just what was submitted' => sub {
     ok( scalar(@errors), 'a null in the tags is caught' );
     like( "$errors[0]", qr{/tags/1}, 'and named by where it is' );
 
-    # It checks rather than filters, unlike validate(): _process() adds fields
+    # It checks rather than filters, unlike validate(): process() adds fields
     # the base schema has never heard of, and throwing those away would discard
     # the work it just did.
     my $built = {
@@ -213,17 +213,17 @@ subtest 'what gets written is checked, not just what was submitted' => sub {
         attachments  => ['/assets/thing.txt'],
         preview      => '/assets/thumb.png',
     };
-    is_deeply( [ Trog::DataModule::validate_built($built) ], [], "the fields _process() invents do not fail it" );
+    is_deeply( [ Trog::DataModule::validate_built($built) ], [], "the fields process() invents do not fail it" );
     ok( exists $built->{is_video},    'and are not deleted' );
     ok( exists $built->{attachments}, 'any of them' );
 };
 
-subtest '_process no longer builds a post wrong' => sub {
+subtest 'process no longer builds a post wrong' => sub {
 
     # The bug: a post saved without a visibility had an undef pushed into its
     # tags, which is a tag no query ever matches -- so the post went invisible
     # to all but an admin, silently, and the bunk tag was written to disk.
-    my $post = Trog::DataModule::_process( { form => 'blog.tx', title => 'No Visibility', tags => ['blog'] } );
+    my $post = Trog::DataModule::process( { form => 'blog.tx', title => 'No Visibility', tags => ['blog'] } );
 
     is_deeply( [ grep { !defined } @{ $post->{tags} } ], [], 'no undef survives into the tags' );
     is( $post->{visibility}, 'private', 'and the visibility is defaulted where the tag is made' );
@@ -233,7 +233,7 @@ subtest '_process no longer builds a post wrong' => sub {
     is_deeply( [ Trog::DataModule::validate_built($post) ], [], 'and the result passes the check' );
 
     # An undef among the acls of a private post went the same way.
-    my $acled = Trog::DataModule::_process( { form => 'blog.tx', title => 'Acled', tags => ['blog'], visibility => 'private', acls => [ 'members', undef ] } );
+    my $acled = Trog::DataModule::process( { form => 'blog.tx', title => 'Acled', tags => ['blog'], visibility => 'private', acls => [ 'members', undef ] } );
     is_deeply( [ grep { !defined } @{ $acled->{tags} } ], [], 'nor from the acls' );
     ok( scalar( grep { $_ eq 'members' } @{ $acled->{tags} } ), 'while the real acl still lands' );
 };
@@ -241,17 +241,17 @@ subtest '_process no longer builds a post wrong' => sub {
 subtest 'add() refuses to store a post it built wrong' => sub {
     set_sidecars();
 
-    # Break _process on purpose: the point is that add() no longer takes its
+    # Break process on purpose: the point is that add() no longer takes its
     # word for it.  This is the shape the real bug produced.
     #
     # One mock object for all three, and unmocked by hand at the end.
     # Test::MockModule keeps one per package, so a second new() on the same
     # package hands back the first -- and leaving it to go out of scope left
-    # _process broken for every subtest after this one.
+    # process broken for every subtest after this one.
     my @written;
     my $mock = Test::MockModule->new('Trog::DataModule');
     $mock->redefine(
-        '_process',
+        'process',
         sub ($post) {
             push( @{ $post->{tags} }, undef );
             return $post;
@@ -271,8 +271,8 @@ subtest 'add() refuses to store a post it built wrong' => sub {
     is_deeply( \@written, [], 'and nothing was written' );
 
     # The mock really is gone, or every subtest after this one is testing it.
-    my $sane = Trog::DataModule::_process( { form => 'blog.tx', title => 'Sane', tags => ['blog'], visibility => 'public' } );
-    is_deeply( [ grep { !defined } @{ $sane->{tags} } ], [], '_process is itself again afterwards' );
+    my $sane = Trog::DataModule::process( { form => 'blog.tx', title => 'Sane', tags => ['blog'], visibility => 'public' } );
+    is_deeply( [ grep { !defined } @{ $sane->{tags} } ], [], 'process is itself again afterwards' );
 };
 
 subtest 'empty inputs are treated as absent, except for strings' => sub {
@@ -336,7 +336,7 @@ subtest 'a post always ends up with a visibility' => sub {
         *VisData::write = sub { $written = $_[1]; return 0 };
     }
 
-    # A post type built without a visibility selector submits none.  _process
+    # A post type built without a visibility selector submits none.  process
     # pushes visibility into the tags, so an undef one puts an undef in there
     # and the post becomes invisible to everyone but an admin.
     bless( {}, 'VisData' )->add( { title => 'No Visibility', tags => ['sometag'] } );
@@ -357,12 +357,12 @@ subtest 'a save message never becomes a URL' => sub {
     # saw neither the page they saved from nor the error.
     my $realistic = "Couldn't rename data/dnZHxmlXE5 to data/files/: Not a directory at /opt/perl5/lib/File/Slurper/Temp.pm line 56.\n" . "\tFile::Slurper::Temp::write_text(\"data/files/\", \"[{...}]\") called at /opt/perl5/lib/File/Slurper/Temp.pm line 63\n" . ( "\tTrog::Routes::HTML::post_save(HASH(0x5e798a626570)) called at lib/TCMS.pm line 130\n" x 40 );
 
-    my $short = Trog::Routes::HTML::_short_error($realistic);
+    my $short = Trog::Routes::HTML::short_error($realistic);
     unlike( $short, qr/\n/,         'the trace is gone' );
     unlike( $short, qr/line[ ]\d+/, 'and so is the file and line Perl glued on' );
     like( $short, qr/^Couldn't[ ]rename[ ]data/, 'leaving what actually went wrong' );
 
-    my $cookie = Trog::Routes::HTML::_feedback_cookie( 1, $realistic );
+    my $cookie = Trog::Routes::HTML::feedback_cookie( 1, $realistic );
     ok( length($cookie) < 2048, 'even the whole untrimmed thing fits in a cookie' )
       or diag( 'cookie was ' . length($cookie) . ' bytes' );
     like( $cookie, qr/^tcmsfeedback=1:/, 'flagged as a failure' );
@@ -374,25 +374,25 @@ subtest 'a save message never becomes a URL' => sub {
     unlike( URI::Escape::uri_unescape($value), qr/\n/, 'the message is one line' );
 
     # Round trips.
-    my ( $failure, $message ) = Trog::Routes::HTML::_feedback_from_cookie($cookie);
+    my ( $failure, $message ) = Trog::Routes::HTML::feedback_from_cookie($cookie);
     is( $failure, 1, 'the outcome comes back out' );
     like( $message, qr/^Couldn't[ ]rename/, 'and so does the message' );
 
-    ( $failure, $message ) = Trog::Routes::HTML::_feedback_from_cookie( Trog::Routes::HTML::_feedback_cookie( 0, "Saved post 'Thing'." ) );
+    ( $failure, $message ) = Trog::Routes::HTML::feedback_from_cookie( Trog::Routes::HTML::feedback_cookie( 0, "Saved post 'Thing'." ) );
     is( $failure, 0,                     'a success comes back as one' );
     is( $message, "Saved post 'Thing'.", 'with its message intact' );
 
     # And nothing at all when there is no cookie to read.
-    is_deeply( [ Trog::Routes::HTML::_feedback_from_cookie('') ],                 [], 'no cookies, no feedback' );
-    is_deeply( [ Trog::Routes::HTML::_feedback_from_cookie('other=thing') ],      [], 'nor other cookies' );
-    is_deeply( [ Trog::Routes::HTML::_feedback_from_cookie('tcmsfeedback=xyz') ], [], 'nor one that is malformed' );
+    is_deeply( [ Trog::Routes::HTML::feedback_from_cookie('') ],                 [], 'no cookies, no feedback' );
+    is_deeply( [ Trog::Routes::HTML::feedback_from_cookie('other=thing') ],      [], 'nor other cookies' );
+    is_deeply( [ Trog::Routes::HTML::feedback_from_cookie('tcmsfeedback=xyz') ], [], 'nor one that is malformed' );
 };
 
-subtest '_wizard_fields zips the parallel arrays' => sub {
+subtest 'wizard_fields zips the parallel arrays' => sub {
 
     # The middle row was left blank.  Dropping it must not shift the type of
     # the row after it -- this is the whole reason param_required is a select.
-    my $fields = Trog::Routes::HTML::_wizard_fields(
+    my $fields = Trog::Routes::HTML::wizard_fields(
         {
             param_name        => [ 'Servings', '', qw{cook_time id servings} ],
             param_type        => [qw{number text textarea text text}],
@@ -409,8 +409,8 @@ subtest '_wizard_fields zips the parallel arrays' => sub {
     is( $fields->[1]{type},     'textarea',  "...with its own type, not the blank row's" );
 };
 
-subtest '_wizard_sidecar emits a usable OpenAPIv3 schema' => sub {
-    my $spec = Trog::Routes::HTML::_wizard_sidecar(
+subtest 'wizard_sidecar emits a usable OpenAPIv3 schema' => sub {
+    my $spec = Trog::Routes::HTML::wizard_sidecar(
         'recipe',
         [
             { name => 'servings', type => 'number',   label => 'Servings', placeholder => '4', required => 1 },
@@ -444,7 +444,7 @@ subtest 'a type records what the wizard was told, where the validator cannot see
         },
     ];
 
-    my $spec = Trog::Routes::HTML::_wizard_sidecar(
+    my $spec = Trog::Routes::HTML::wizard_sidecar(
         'recipe', $fields, ['inc_tags'], 'form_common.tx', '',
         {
             description       => 'A recipe, with its cook time.',
@@ -475,7 +475,7 @@ subtest 'a type records what the wizard was told, where the validator cannot see
 };
 
 subtest 'a type reads back as the form that made it' => sub {
-    my $spec = Trog::Routes::HTML::_wizard_sidecar(
+    my $spec = Trog::Routes::HTML::wizard_sidecar(
         'recipe',
         [
             {
@@ -509,7 +509,7 @@ subtest 'a type reads back as the form that made it' => sub {
     );
     set_sidecars( 'recipe.json' => JSON::MaybeXS::encode_json($spec) );
 
-    my $types = Trog::Routes::HTML::_wizard_types( ['recipe.tx'] );
+    my $types = Trog::Routes::HTML::wizard_types( ['recipe.tx'] );
     my $back  = $types->{'recipe.tx'};
 
     is( $back->{name},              'recipe',                 'the name comes back without the extension' );
@@ -571,7 +571,7 @@ TEMPLATE
         'bare.tx'   => qq|<!-- a comment first, which is not the wrapper -->\n:if ( !\$post.addpost ) {\n: }\n        : include "form_common.tx";\n|,
     );
 
-    my $types = Trog::Routes::HTML::_wizard_types( [ 'deck.tx', 'bare.tx' ] );
+    my $types = Trog::Routes::HTML::wizard_types( [ 'deck.tx', 'bare.tx' ] );
 
     is( $types->{'deck.tx'}{wrapper},        1,               "the wrapper div is seen where a type opens with one" );
     is( $types->{'deck.tx'}{inc_post_title}, 1,               "as is the post title block" );
@@ -587,13 +587,13 @@ TEMPLATE
 subtest 'the types are handed to the page as JSON it cannot break out of' => sub {
     no warnings qw{once};
 
-    my $spec = Trog::Routes::HTML::_wizard_sidecar(
+    my $spec = Trog::Routes::HTML::wizard_sidecar(
         'nasty', [], [], 'form_common.tx', '',
         { description => 'ends a script </script><script>alert(1)</script>', display => '<div>markup</div>' }
     );
     set_sidecars( 'nasty.json' => JSON::MaybeXS::encode_json($spec) );
 
-    my $json = Trog::Routes::HTML::_wizard_types_json( ['nasty.tx'] );
+    my $json = Trog::Routes::HTML::wizard_types_json( ['nasty.tx'] );
     unlike( $json, qr/</, 'no bare < survives, so the script element cannot be closed early' );
 
     my $back = JSON::MaybeXS::decode_json($json);
@@ -601,10 +601,10 @@ subtest 'the types are handed to the page as JSON it cannot break out of' => sub
     is( $back->{'nasty.tx'}{display}, '<div>markup</div>', 'and so is the display template' );
 
     # A description is free text, but it still goes in a file.
-    my $long = Trog::Routes::HTML::_wizard_description( 'x' x 9000 );
+    my $long = Trog::Routes::HTML::wizard_description( 'x' x 9000 );
     ok( length($long) <= $Trog::Routes::HTML::wizard_description_max, 'a very long description is capped' );
-    is( Trog::Routes::HTML::_wizard_description(),                    '', 'and no description at all is empty rather than undef' );
-    is( Trog::Routes::HTML::_wizard_description( [ 'an', 'array' ] ), '', 'as is one that is not a string' );
+    is( Trog::Routes::HTML::wizard_description(),                    '', 'and no description at all is empty rather than undef' );
+    is( Trog::Routes::HTML::wizard_description( [ 'an', 'array' ] ), '', 'as is one that is not a string' );
 };
 
 subtest 'a canned block declares what it collects, and the types including it get it' => sub {
@@ -620,7 +620,7 @@ subtest 'a canned block declares what it collects, and the types including it ge
     # What the wizard writes for a type with 'Preview image upload' ticked: the
     # block spliced into the template, and a sidecar naming only the field
     # somebody actually typed into the form.
-    my $spec = Trog::Routes::HTML::_wizard_sidecar(
+    my $spec = Trog::Routes::HTML::wizard_sidecar(
         'recipe',
         [
             {
@@ -695,7 +695,7 @@ subtest 'the wizard tells a canned field apart from one somebody typed in' => su
         'guests.tx'   => qq|        : include "post_title.tx";\n|,
     );
 
-    my $types = Trog::Routes::HTML::_wizard_types( [ 'blog.tx', 'guests.tx' ] );
+    my $types = Trog::Routes::HTML::wizard_types( [ 'blog.tx', 'guests.tx' ] );
 
     is( $types->{'blog.tx'}{inc_preview}, 1, "the box for a block the template includes comes back ticked" );
     is_deeply(
@@ -712,11 +712,11 @@ subtest 'the wizard tells a canned field apart from one somebody typed in' => su
     );
 };
 
-subtest '_kolon_safe defuses template syntax' => sub {
-    my $safe = Trog::Routes::HTML::_kolon_safe(qq{<: \$post.id :>\n: include "evil.tx";});
+subtest 'kolon_safe defuses template syntax' => sub {
+    my $safe = Trog::Routes::HTML::kolon_safe(qq{<: \$post.id :>\n: include "evil.tx";});
     unlike( $safe, qr/</,      "no angle brackets survive" );
     unlike( $safe, qr/[\r\n]/, "no newlines survive, so ':' can't start a directive" );
-    is( Trog::Routes::HTML::_kolon_safe( [] ), '', "a repeated param can't sneak a ref through" );
+    is( Trog::Routes::HTML::kolon_safe( [] ), '', "a repeated param can't sneak a ref through" );
 };
 
 done_testing();

t/Trog-DataSource-DirIndex.t

@@ -269,7 +269,7 @@ subtest 'no tPSGI, or one without watches, is not fatal' => sub {
 subtest 'the wizard can find it' => sub {
     require Trog::Routes::HTML;
 
-    my $sources = Trog::Routes::HTML::_get_datasources();
+    my $sources = Trog::Routes::HTML::get_datasources();
     ok( scalar( grep { $_ eq 'Trog::DataSource::DirIndex' } @$sources ), 'it is offered as a datasource' );
 
     is( Trog::DataSource::DirIndex->EDITABLE, 0, 'and declares it wants no editor' );

t/Trog-DataSource-ProvisionedVirt.t

@@ -1,7 +1,7 @@
 #!/usr/bin/env perl
 
 # Reprovisioning destroys a machine and builds it again, so the whole of this
-# file is about what has to be true before anything runs.  _spawn is mocked
+# file is about what has to be true before anything runs.  spawn is mocked
 # throughout: nothing here forks, and nothing here executes a provisioner.
 
 use 5.040;
@@ -39,7 +39,7 @@ BEGIN {
     $ENV{TPSGI_VAULT_KEY} = Crypt::Misc::encode_b64( Crypt::PRNG::random_bytes(32) );
 
     # A stand-in for the checkout, with the one program a reprovision runs.
-    # Never executed -- _spawn is mocked -- but it has to be there and
+    # Never executed -- spawn is mocked -- but it has to be there and
     # executable, because reprovision() checks that before it commits to
     # anything.
     File::Path::make_path("$ROOT/trog-provisioner/bin");
@@ -93,7 +93,7 @@ $log->redefine( INFO => sub { note(shift) } );
 # Nothing in this file forks, and nothing in it runs a provisioner.
 our @SPAWNED;
 $log->redefine(
-    _spawn => sub {
+    spawn => sub {
         my ( $domain, $credentials, $dir, $command, $user ) = @_;
         push( @SPAWNED, { domain => $domain, credentials => $credentials, dir => $dir, command => $command, user => $user } );
         return ( 1, 'started' );
@@ -102,7 +102,7 @@ $log->redefine(
 
 # Nor reaches a hypervisor.
 my $virt = Test::MockModule->new('Trog::DataSource::Virt');
-$virt->redefine( _is_self => sub { return $_[0] eq 'thisserver.example.com' ? 1 : 0 } );
+$virt->redefine( is_self => sub { return $_[0] eq 'thisserver.example.com' ? 1 : 0 } );
 
 write_config( trog_provisioner => "$ROOT/trog-provisioner" );
 
@@ -408,12 +408,12 @@ subtest 'the log is read back onto the page' => sub {
     print {$fh} ( 'x' x 9000 ) . "\n=== finished ===\n";
     close $fh;
 
-    my $tail = Trog::DataSource::ProvisionedVirt::_log_tail('guest.example.com');
+    my $tail = Trog::DataSource::ProvisionedVirt::log_tail('guest.example.com');
     ok( length($tail) <= $Trog::DataSource::ProvisionedVirt::log_tail_bytes, 'only the tail of it' );
     like( $tail, qr/===[ ]finished[ ]===/, 'which is the part that says how it went' );
 
-    is( Trog::DataSource::ProvisionedVirt::_log_tail('norecipe.example.com'), undef, 'nothing when it has never run' );
-    is( Trog::DataSource::ProvisionedVirt::_log_tail('../../etc/passwd'),     undef, 'and a name that is not one reads nothing' );
+    is( Trog::DataSource::ProvisionedVirt::log_tail('norecipe.example.com'), undef, 'nothing when it has never run' );
+    is( Trog::DataSource::ProvisionedVirt::log_tail('../../etc/passwd'),     undef, 'and a name that is not one reads nothing' );
 };
 
 subtest 'the state a reprovision leaves behind' => sub {

t/Trog-DataSource-Virt.t

@@ -125,7 +125,7 @@ subtest 'a guest is this server when it is named like it' => sub {
     foreach my $case (@same) {
         my ( $guest, $host, $why ) = @$case;
         local $Trog::DataSource::Virt::hostname = $host;
-        ok( Trog::DataSource::Virt::_is_self($guest), "$why is this server" );
+        ok( Trog::DataSource::Virt::is_self($guest), "$why is this server" );
     }
 
     my @different = (
@@ -138,7 +138,7 @@ subtest 'a guest is this server when it is named like it' => sub {
     foreach my $case (@different) {
         my ( $guest, $host, $why ) = @$case;
         local $Trog::DataSource::Virt::hostname = $host;
-        ok( !Trog::DataSource::Virt::_is_self($guest), "$why is not" );
+        ok( !Trog::DataSource::Virt::is_self($guest), "$why is not" );
     }
 };
 
@@ -277,23 +277,23 @@ subtest 'the datasource hook only loads what it should' => sub {
     # A type that declares nothing keeps its own posts -- this hook must be
     # invisible to the overwhelming majority of pages.
     $declared = undef;
-    is_deeply( [ Trog::Routes::HTML::_datasource_posts( $query, \@stored ) ], \@stored, 'no datasource declared, posts untouched' );
+    is_deeply( [ Trog::Routes::HTML::datasource_posts( $query, \@stored ) ], \@stored, 'no datasource declared, posts untouched' );
 
     # The namespace restriction is the point: a sidecar is a file on disk, and
     # it must not be able to make us require an arbitrary module.
     foreach my $bad (qw{Trog::Routes::HTML File::Path ../../etc/passwd Trog::DataSource::Virt::act}) {
         $declared = $bad;
-        is_deeply( [ Trog::Routes::HTML::_datasource_posts( $query, \@stored ) ], \@stored, "'$bad' is refused as a datasource" );
+        is_deeply( [ Trog::Routes::HTML::datasource_posts( $query, \@stored ) ], \@stored, "'$bad' is refused as a datasource" );
     }
 
     # One that does not exist is a warning, not a dead page.
     $declared = 'Trog::DataSource::Nonexistent';
-    is_deeply( [ Trog::Routes::HTML::_datasource_posts( $query, \@stored ) ], \@stored, 'a datasource that will not load falls back' );
+    is_deeply( [ Trog::Routes::HTML::datasource_posts( $query, \@stored ) ], \@stored, 'a datasource that will not load falls back' );
 
     # And a real one is actually used.
     $declared = 'Trog::DataSource::Virt';
     $query->{primary_post}{hypervisors} = [ { id => 'hv-1', title => 'spec-hv', conn_uri => 'test:///default' } ];
-    my @got = Trog::Routes::HTML::_datasource_posts( $query, \@stored );
+    my @got = Trog::Routes::HTML::datasource_posts( $query, \@stored );
     is( scalar @got,    2,       'a declared datasource replaces the stored posts' );
     is( $got[0]{title}, 'alpha', 'with what it built' );
 };
@@ -357,7 +357,7 @@ subtest 'guests show nothing an unprivileged viewer cannot use' => sub {
         # thing that actually protects the capture -- the template only decides
         # whether to draw an img for a value it was given.
         my %shown = %post;
-        Trog::Routes::HTML::_redact_private( \%shown ) unless $admin;
+        Trog::Routes::HTML::redact_private( \%shown ) unless $admin;
 
         my $out = $tx->render( 'forms/guests.tx', { post => \%shown, style => '', route => '/vm', %{ $views{$view} } } );
 
@@ -434,15 +434,15 @@ subtest 'the server itself is drawn without the controls that would kill it' =>
 subtest 'a datasource says whether its posts can be edited' => sub {
     require Trog::Routes::HTML;
 
-    my $sources = Trog::Routes::HTML::_get_datasources();
+    my $sources = Trog::Routes::HTML::get_datasources();
     ok( ( grep { $_ eq 'Trog::DataSource::Virt' } @$sources ), 'the wizard can find this datasource' );
     ok( !( grep { !m/^Trog::DataSource::\w+$/ } @$sources ),   'and finds nothing that is not one' );
 
-    is( Trog::DataSource::Virt->EDITABLE,                                   0, 'a guest cannot be edited' );
-    is( Trog::Routes::HTML::_datasource_editable('Trog::DataSource::Virt'), 0, 'so no editor is appropriate' );
+    is( Trog::DataSource::Virt->EDITABLE,                                  0, 'a guest cannot be edited' );
+    is( Trog::Routes::HTML::datasource_editable('Trog::DataSource::Virt'), 0, 'so no editor is appropriate' );
 
     # The datastore is the default, and posts in it are written by people.
-    is( Trog::Routes::HTML::_datasource_editable(''), 1, 'the datastore is editable' );
+    is( Trog::Routes::HTML::datasource_editable(''), 1, 'the datastore is editable' );
 
     # A datasource that says nothing is assumed editable, since that is what a
     # post type is unless it has a reason not to be.
@@ -451,7 +451,7 @@ subtest 'a datasource says whether its posts can be edited' => sub {
         $INC{'Trog/DataSource/SpecMute.pm'} = 1;
         @Trog::DataSource::SpecMute::ISA = ();
     }
-    is( Trog::Routes::HTML::_datasource_editable('Trog::DataSource::SpecMute'), 1, 'one that declares nothing is assumed editable' );
+    is( Trog::Routes::HTML::datasource_editable('Trog::DataSource::SpecMute'), 1, 'one that declares nothing is assumed editable' );
 };
 
 subtest 'the guests type is built by the wizard, from a datasource' => sub {
@@ -499,7 +499,7 @@ subtest 'private fields are dropped before a non-editor sees them' => sub {
         other   => { form => 'ordinary.tx', hidden => 'not declared private here' },
     };
 
-    Trog::Routes::HTML::_redact_private($post);
+    Trog::Routes::HTML::redact_private($post);
 
     ok( !exists $post->{hidden}, 'the private field is gone' );
     is( $post->{shown}, 'not a secret', 'and the public ones are not' );
@@ -520,7 +520,7 @@ subtest 'a post that refers to itself does not hang the redactor' => sub {
     $post->{itself} = $post;
 
     # A relation can point back at whatever pulled it in.
-    is( exception { Trog::Routes::HTML::_redact_private($post) }, undef, 'it terminates' );
+    is( exception { Trog::Routes::HTML::redact_private($post) }, undef, 'it terminates' );
     ok( !exists $post->{hidden}, 'having done the job' );
 };
 

t/Trog-DataSource.t

@@ -147,17 +147,17 @@ subtest 'the route marks an uncacheable page nocache' => sub {
     # An ordinary page is left alone.
     $source = undef;
     my $ordinary = $query->();
-    Trog::Routes::HTML::_datasource_posts( $ordinary, [ guest('stored') ] );
+    Trog::Routes::HTML::datasource_posts( $ordinary, [ guest('stored') ] );
     ok( !$ordinary->{nocache}, 'an ordinary page is not marked' );
 
     $source = 'Trog::DataSource::TestPlain';
     my $uncacheable = $query->();
-    Trog::Routes::HTML::_datasource_posts( $uncacheable, [] );
+    Trog::Routes::HTML::datasource_posts( $uncacheable, [] );
     is( $uncacheable->{nocache}, 1, 'a source which has not said is marked nocache' );
 
     $source = 'Trog::DataSource::TestCached';
     my $cacheable = $query->();
-    Trog::Routes::HTML::_datasource_posts( $cacheable, [] );
+    Trog::Routes::HTML::datasource_posts( $cacheable, [] );
     ok( !$cacheable->{nocache}, 'and one which has said so is not' );
 };
 
@@ -269,19 +269,19 @@ subtest 'the route applies the search to synthesized posts' => sub {
     # No datasource at all: the stored posts are handed straight back.
     $source = undef;
     my @stored = ( guest('stored') );
-    is_deeply( titles( Trog::Routes::HTML::_datasource_posts( $query->(), \@stored ) ), ['stored'], 'an ordinary type is left alone' );
+    is_deeply( titles( Trog::Routes::HTML::datasource_posts( $query->(), \@stored ) ), ['stored'], 'an ordinary type is left alone' );
 
     $source = 'Trog::DataSource::TestPlain';
-    is_deeply( titles( Trog::Routes::HTML::_datasource_posts( $query->(), \@stored ) ), [ sort qw{alpha beta} ], 'a datasource replaces them' );
+    is_deeply( titles( Trog::Routes::HTML::datasource_posts( $query->(), \@stored ) ), [ sort qw{alpha beta} ], 'a datasource replaces them' );
 
     # The point of the exercise.
     is_deeply(
-        titles( Trog::Routes::HTML::_datasource_posts( $query->( like => 'alph' ), \@stored ) ),
+        titles( Trog::Routes::HTML::datasource_posts( $query->( like => 'alph' ), \@stored ) ),
         ['alpha'],
         'and the search reaches them, rather than being dropped'
     );
     is_deeply(
-        titles( Trog::Routes::HTML::_datasource_posts( $query->( like => 'nonesuch' ), \@stored ) ),
+        titles( Trog::Routes::HTML::datasource_posts( $query->( like => 'nonesuch' ), \@stored ) ),
         [],
         'including when it matches nothing'
     );
@@ -290,7 +290,7 @@ subtest 'the route applies the search to synthesized posts' => sub {
     $source                                = 'Trog::DataSource::TestPicky';
     @Trog::DataSource::TestPicky::FILTERED = ();
     is_deeply(
-        titles( Trog::Routes::HTML::_datasource_posts( $query->( like => 'alph' ), \@stored ) ),
+        titles( Trog::Routes::HTML::datasource_posts( $query->( like => 'alph' ), \@stored ) ),
         ['beta'],
         "a source's own filter wins over the default"
     );
@@ -302,7 +302,7 @@ subtest 'the route applies the search to synthesized posts' => sub {
     {
         my $log = Test::MockModule->new('Trog::Routes::HTML');
         $log->redefine( WARN => sub { note(shift) } );
-        @survived = Trog::Routes::HTML::_datasource_posts( $query->( like => 'x' ), \@stored );
+        @survived = Trog::Routes::HTML::datasource_posts( $query->( like => 'x' ), \@stored );
     }
     is_deeply( titles(@survived), ['alpha'], 'a filter that dies falls back to the unfiltered posts' );
 
@@ -312,7 +312,7 @@ subtest 'the route applies the search to synthesized posts' => sub {
     {
         my $log = Test::MockModule->new('Trog::DataSource');
         $log->redefine( WARN => sub { note(shift) } );
-        @refused = Trog::Routes::HTML::_datasource_posts( $query->(), \@stored );
+        @refused = Trog::Routes::HTML::datasource_posts( $query->(), \@stored );
     }
     is_deeply( titles(@refused), ['stored'], 'a datasource outside the namespace is refused' );
 };
@@ -338,12 +338,12 @@ subtest 'the search box says what it is searching' => sub {
 
     $source = undef;
     is_deeply(
-        [ Trog::Routes::HTML::_search_language( { primary_post => { child_form => 'blog.tx' } } ) ],
+        [ Trog::Routes::HTML::search_language( { primary_post => { child_form => 'blog.tx' } } ) ],
         [ 'Model language', 'https://example.com/model' ],
         'an ordinary page advertises the data model'
     );
     is_deeply(
-        [ Trog::Routes::HTML::_search_language( {} ) ],
+        [ Trog::Routes::HTML::search_language( {} ) ],
         [ 'Model language', 'https://example.com/model' ],
         'and so does a page with no series at all'
     );
@@ -352,14 +352,14 @@ subtest 'the search box says what it is searching' => sub {
     # query language is the wrong thing to advertise on it.
     $source = 'Trog::DataSource::TestPlain';
     is_deeply(
-        [ Trog::Routes::HTML::_search_language( { primary_post => { child_form => 'fake.tx' } } ) ],
+        [ Trog::Routes::HTML::search_language( { primary_post => { child_form => 'fake.tx' } } ) ],
         [ Trog::DataSource::lang(), Trog::DataSource::help() ],
         'a datasource page advertises the datasource default'
     );
 
     $source = 'Trog::DataSource::TestPicky';
     is_deeply(
-        [ Trog::Routes::HTML::_search_language( { primary_post => { child_form => 'fake.tx' } } ) ],
+        [ Trog::Routes::HTML::search_language( { primary_post => { child_form => 'fake.tx' } } ) ],
         [ 'Picky search', 'https://example.com/picky' ],
         'or its own, when it has one'
     );
@@ -398,48 +398,48 @@ subtest 'offset pagination' => sub {
 
     my @ten = map { guest( sprintf( 'g%02d', $_ ), created => 100 + $_ ) } 1 .. 10;
 
-    my ( $page, $total, @slice ) = Trog::Routes::HTML::_paginate_offset( { page => 1 }, 4, @ten );
+    my ( $page, $total, @slice ) = Trog::Routes::HTML::paginate_offset( { page => 1 }, 4, @ten );
     is( $page,            1,     'page one is page one' );
     is( $total,           3,     'ten posts at four a page is three pages' );
     is( scalar(@slice),   4,     'and a full page' );
     is( $slice[0]{title}, 'g01', 'starting at the beginning' );
 
-    ( $page, $total, @slice ) = Trog::Routes::HTML::_paginate_offset( { page => 2 }, 4, @ten );
+    ( $page, $total, @slice ) = Trog::Routes::HTML::paginate_offset( { page => 2 }, 4, @ten );
     is( $slice[0]{title}, 'g05', 'page two carries on where page one stopped' );
     is( scalar(@slice),   4,     'and is also full' );
 
-    ( $page, $total, @slice ) = Trog::Routes::HTML::_paginate_offset( { page => 3 }, 4, @ten );
+    ( $page, $total, @slice ) = Trog::Routes::HTML::paginate_offset( { page => 3 }, 4, @ten );
     is( scalar(@slice),   2,     'the last page holds the remainder' );
     is( $slice[0]{title}, 'g09', 'from where page two stopped' );
 
     # Every post appears exactly once across the pages, which is the whole point.
     my @walked;
-    push( @walked, ( Trog::Routes::HTML::_paginate_offset( { page => $_ }, 4, @ten ) )[ 2 .. 5 ] ) for 1 .. 3;
+    push( @walked, ( Trog::Routes::HTML::paginate_offset( { page => $_ }, 4, @ten ) )[ 2 .. 5 ] ) for 1 .. 3;
     @walked = grep { defined } @walked;
     is_deeply( [ sort map { $_->{title} } @walked ], [ sort map { $_->{title} } @ten ], 'walking the pages visits everything, once' );
 
     # Straight off a query string.
-    ( $page, $total, @slice ) = Trog::Routes::HTML::_paginate_offset( { page => 99 }, 4, @ten );
+    ( $page, $total, @slice ) = Trog::Routes::HTML::paginate_offset( { page => 99 }, 4, @ten );
     is( $page, 3, 'a page past the end shows the last one' );
     ok( scalar(@slice), 'rather than nothing at all' );
 
-    ( $page, $total, @slice ) = Trog::Routes::HTML::_paginate_offset( { page => 0 }, 4, @ten );
+    ( $page, $total, @slice ) = Trog::Routes::HTML::paginate_offset( { page => 0 }, 4, @ten );
     is( $page, 1, 'and page zero is page one' );
-    ( $page, $total, @slice ) = Trog::Routes::HTML::_paginate_offset( { page => 'nonsense' }, 4, @ten );
+    ( $page, $total, @slice ) = Trog::Routes::HTML::paginate_offset( { page => 'nonsense' }, 4, @ten );
     is( $page, 1, 'as is a page that is not a number' );
-    ( $page, $total, @slice ) = Trog::Routes::HTML::_paginate_offset( {}, 4, @ten );
+    ( $page, $total, @slice ) = Trog::Routes::HTML::paginate_offset( {}, 4, @ten );
     is( $page, 1, 'and no page at all' );
 
     # A limit that would divide by zero.
-    ( $page, $total, @slice ) = Trog::Routes::HTML::_paginate_offset( { page => 1 }, 0, @ten );
+    ( $page, $total, @slice ) = Trog::Routes::HTML::paginate_offset( { page => 1 }, 0, @ten );
     is( $total,         1,  'a limit of zero falls back to the default rather than dividing by it' );
     is( scalar(@slice), 10, 'and shows everything' );
 
-    ( $page, $total, @slice ) = Trog::Routes::HTML::_paginate_offset( { page => 1 }, 4 );
+    ( $page, $total, @slice ) = Trog::Routes::HTML::paginate_offset( { page => 1 }, 4 );
     is( $total,         1, 'no posts is one empty page' );
     is( scalar(@slice), 0, 'holding nothing' );
 
-    ( $page, $total, @slice ) = Trog::Routes::HTML::_paginate_offset( { page => 1 }, 25, @ten );
+    ( $page, $total, @slice ) = Trog::Routes::HTML::paginate_offset( { page => 1 }, 25, @ten );
     is( $total,         1,  'fewer posts than a page is one page' );
     is( scalar(@slice), 10, 'holding all of them' );
 };

t/Trog-Routes-HTML-config.t

@@ -51,7 +51,7 @@ CFG
 require_ok('Trog::Routes::HTML') or BAIL_OUT("Can't find SUT");
 
 my %field;
-my $sections = Trog::Routes::HTML::_config_sections();
+my $sections = Trog::Routes::HTML::config_sections();
 foreach my $section (@$sections) {
     $field{ $_->{name} } = $_ foreach @{ $section->{fields} };
 }
@@ -97,7 +97,7 @@ subtest 'saving only writes what the defaults describe' => sub {
     require Config::Simple;
     my $conf = Config::Simple->new( syntax => 'ini' );
 
-    Trog::Routes::HTML::_config_apply(
+    Trog::Routes::HTML::config_apply(
         $conf,
         {
             'general.title' => 'Renamed',

t/Trog-Routes-HTML-series-lifecycle.t

@@ -51,7 +51,7 @@ BEGIN {
 
 # name => (size, mtime) for every file under the repo dirs this test could
 # plausibly disturb.  Cheap enough, and it is the only real proof of isolation.
-sub _snapshot {
+state sub snapshot {
     my ($dir) = @_;
     my %seen;
     File::Find::find(
@@ -68,7 +68,7 @@ sub _snapshot {
     return %seen;
 }
 
-sub _copy_tree {
+state sub copy_tree {
     my ( $from, $to ) = @_;
     File::Path::make_path($to);
     File::Find::find(
@@ -96,7 +96,7 @@ BEGIN {
     $REPO   = Cwd::abs_path("$FindBin::Bin/..");
     $OLDCWD = Cwd::getcwd();
 
-    %REPO_BEFORE = map { _snapshot("$REPO/$_") } qw{config data www/templates www/assets logs totp};
+    %REPO_BEFORE = map { snapshot("$REPO/$_") } qw{config data www/templates www/assets logs totp};
 
     $ROOT = File::Temp::tempdir( 'tcms-lifecycle-XXXXXX', TMPDIR => 1, CLEANUP => 0 );
 
@@ -123,7 +123,7 @@ BEGIN {
 
     # COPY, don't symlink: post_wizard_save() writes into Trog::Themes::forms_dir(),
     # and a symlink would land the generated post type in the real repo.
-    _copy_tree( "$REPO/www/templates", "$ROOT/www/templates" );
+    copy_tree( "$REPO/www/templates", "$ROOT/www/templates" );
 
     # posts.tx pulls in the EmojiPicker component for an editor, and EmojiPicker
     # dies outright if this file is missing.  Only category and emoji are read.
@@ -202,12 +202,12 @@ require Trog::Routes::JSON;
     sub redirect           { return [ 302, [ 'Location' => $_[1], 'Content-Length' => 0 ], [''] ] }
     sub redirect_permanent { return [ 301, [ 'Location' => $_[1], 'Content-Length' => 0 ], [''] ] }
 
-    sub _reply     { return [ $_[1], [ 'Content-type' => 'text/html' ], [ defined $_[2] ? $_[2] : '' ] ] }
-    sub ok         { return $_[0]->_reply( 200, $_[2] ) }
-    sub notfound   { return $_[0]->_reply( 404, $_[2] // 'Not Found' ) }
-    sub forbidden  { return $_[0]->_reply( 403, $_[2] // 'Forbidden' ) }
-    sub badrequest { return $_[0]->_reply( 400, $_[2] // 'Bad Request' ) }
-    sub error      { return $_[0]->_reply( 500, $_[2] // 'Error' ) }
+    sub reply      { return [ $_[1], [ 'Content-type' => 'text/html' ], [ defined $_[2] ? $_[2] : '' ] ] }
+    sub ok         { return $_[0]->reply( 200, $_[2] ) }
+    sub notfound   { return $_[0]->reply( 404, $_[2] // 'Not Found' ) }
+    sub forbidden  { return $_[0]->reply( 403, $_[2] // 'Forbidden' ) }
+    sub badrequest { return $_[0]->reply( 400, $_[2] // 'Bad Request' ) }
+    sub error      { return $_[0]->reply( 500, $_[2] // 'Error' ) }
     sub serve      { return [ 200, [], [''] ] }
 
     # These two must be inert.
@@ -256,7 +256,7 @@ our $ADMIN_PASS    = 'spec-password';
 
 # Always build a fresh query: posts() pushes onto user_acls, and series()
 # rewrites route/aclname/tag/in_series/primary_post in place.
-sub _query {
+my sub query {
     my (%over) = @_;
     my %q = (
         route        => '/',
@@ -280,13 +280,13 @@ sub _query {
     return \%q;
 }
 
-sub _anon  { return _query( user => undef,       user_acls => [],        @_ ) }
-sub _admin { return _query( user => $ADMIN_USER, user_acls => ['admin'], @_ ) }
+my sub anon  { return query( user => undef,       user_acls => [],        @_ ) }
+my sub admin { return query( user => $ADMIN_USER, user_acls => ['admin'], @_ ) }
 
 # Returns ($code, $body, $error).  Never dies, so one bad post type cannot take
 # the rest of the file with it -- which matters because a failed render inside
 # index() dies rather than returning a 500 (there is no www/templates/html/500.tx).
-sub _render {
+my sub render {
     my ( $query, $how ) = @_;
     $how ||= \&Trog::Routes::HTML::index;
 
@@ -308,7 +308,7 @@ sub _render {
 # Nothing to do for a model that asks the database each time, which is the
 # point: this helper exists to paper over a cache, and a model without one
 # needs no paper.
-sub _reindex {
+my sub reindex {
     return unless $MODEL eq 'FlatFile';
 
     no warnings 'once';
@@ -317,11 +317,11 @@ sub _reindex {
     return;
 }
 
-sub _data { return Trog::Data->new( Trog::Config::get() ) }
+my sub _data { return Trog::Data->new( Trog::Config::get() ) }
 
 # categories.tx renders into <span id="categories">.  Scope to it -- index.tx
 # emits other class="topbar" anchors outside that span.
-sub _topbar_titles {
+my sub topbar_titles {
     my ($body) = @_;
     my ($span) = $body =~ m{<span[ ]id="categories">(.*?)</span>}s;
     return () unless defined $span;
@@ -329,13 +329,13 @@ sub _topbar_titles {
 }
 
 # post_title.tx emits exactly one of these per displayed post.
-sub _post_count {
+my sub post_count {
     my $n = () = $_[0] =~ m{<h3[ ]class='blogtitles'>}g;
     return $n;
 }
 
 # The rendered page is ~40KB and mostly JavaScript.  Show the content well.
-sub _kontent {
+my sub kontent {
     my ($body) = @_;
     my ($k)    = $body =~ m{<div[ ]id="kontent"[ ]class="kontained">(.*?)<div[ ]id="rightbar"}s;
     $k //= $body;
@@ -347,11 +347,11 @@ sub _kontent {
 # arrayref of validator errors, whereas post_save catches them and hands back a
 # 400 with the field-level detail in the body -- which is the single most
 # useful thing to see when a fixture is wrong.
-sub _save_post {
+my sub save_post {
     my ( $label, %post ) = @_;
     my $to = delete $post{to};
 
-    my $res = eval { Trog::Routes::HTML::post_save( _admin( route => '/post/save', method => 'POST', to => $to, %post ) ) };
+    my $res = eval { Trog::Routes::HTML::post_save( admin( route => '/post/save', method => 'POST', to => $to, %post ) ) };
 
     if ( !$res || ref $res ne 'ARRAY' ) {
         fail("$label: saved");
@@ -372,14 +372,14 @@ sub _save_post {
     }
     pass("$label: saved");
 
-    _reindex();    # mandatory: see the comment on _reindex
+    reindex();    # mandatory: see the comment on reindex
 
-    my $saved = _find_post( $post{title} );
+    my $saved = find_post( $post{title} );
     ok( $saved, "$label: readable back out of the datastore" ) or return undef;
     return $saved;
 }
 
-sub _find_post {
+sub find_post {
     my ($title) = @_;
 
     # filter() short-circuits on title; the admin acl skips the visibility filter.
@@ -406,8 +406,8 @@ subtest 'the sandbox is what we are actually running against' => sub {
 subtest 'registering the first admin bootstraps the install' => sub {
     ok( !-f 'config/has_users', 'no users yet, so login() is in register mode' );
 
-    my ( $code, undef, $err, $headers ) = _render(
-        _anon(
+    my ( $code, undef, $err, $headers ) = render(
+        anon(
             route         => '/login',
             method        => 'POST',
             username      => $ADMIN_USER,
@@ -426,7 +426,7 @@ subtest 'registering the first admin bootstraps the install' => sub {
     ok( -f 'config/has_users', 'registration is now closed' );
     is_deeply( Trog::Auth::acls4user($ADMIN_USER), ['admin'], 'the new user is an admin' );
 
-    _reindex();
+    reindex();
 
     my @seeded = _data()->get( acls => ['admin'], limit => 0 );
     is( scalar @seeded, 4, 'the four seed posts were written' )
@@ -453,8 +453,8 @@ subtest 'the post wizard invents a new post type' => sub {
         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>},
     );
 
-    my ( $code, $body, $err ) = _render(
-        _admin( route => '/admin/wyzzerdd/save', method => 'POST', %wizard ),
+    my ( $code, $body, $err ) = render(
+        admin( route => '/admin/wyzzerdd/save', method => 'POST', %wizard ),
         \&Trog::Routes::HTML::post_wizard_save,
     );
     is( $code, 200, 'wizard save rendered' ) or diag($err);
@@ -508,8 +508,8 @@ subtest 'a datasource-backed type gets no editor' => sub {
     # A datasource whose posts are built rather than written has nothing behind
     # a form to save, so generating one would produce an editor that writes
     # real posts to sit alongside the synthesized ones.
-    my ( $code, $body, $err ) = _render(
-        _admin(
+    my ( $code, $body, $err ) = render(
+        admin(
             route          => '/admin/wyzzerdd/save',
             method         => 'POST',
             name           => 'spec_sourced',
@@ -532,8 +532,8 @@ subtest 'a datasource-backed type gets no editor' => sub {
     is( $sidecar->{'x-tcms-datasource'}, 'Trog::DataSource::Virt', 'and the sidecar records the datasource' );
 
     # The same type without one keeps its editor.
-    _render(
-        _admin(
+    render(
+        admin(
             route          => '/admin/wyzzerdd/save',
             method         => 'POST',
             name           => 'spec_stored',
@@ -548,14 +548,68 @@ subtest 'a datasource-backed type gets no editor' => sub {
     like( $stored, qr{action="/post/save"}, 'a type on the datastore still gets one' );
 
     # The name is require()d later, so it has to be one we found.
-    ( $code, $body ) = _render(
-        _admin( route => '/admin/wyzzerdd/save', method => 'POST', name => 'spec_bogus', datasource => 'Evil::Module' ),
+    ( $code, $body ) = render(
+        admin( route => '/admin/wyzzerdd/save', method => 'POST', name => 'spec_bogus', datasource => 'Evil::Module' ),
         \&Trog::Routes::HTML::post_wizard_save,
     );
     like( $body, qr/not[ ]a[ ]datasource[ ]I[ ]can[ ]find/, 'a datasource we did not find is refused' );
     ok( !-e 'www/templates/html/components/forms/spec_bogus.tx', 'and nothing was written' );
 };
 
+#--------------------------------------------------------------------------
+# The matrix.
+#
+# Per type: build a topbar series whose child_form is that type, check it shows
+# up in the nav, add a child post, check the child renders on the series page.
+#
+# Everything is verified ANONYMOUSLY.  can_edit is then false, so the editor
+# half of each form never renders and a title appears exactly once -- which is
+# what makes like($body, qr/$title/) mean anything.  It also sidesteps the
+# /secure prefixing that both post_helper and categories.tx apply when a user
+# is set.
+#--------------------------------------------------------------------------
+
+my sub make_series {
+    my ( $label, $aclname, $child_form, $title, %opt ) = @_;
+
+    # _get_series caps the bar at 10 and the seeds already use two, so only the
+    # series whose topbar behaviour we actually care about get tagged.
+    my @tags = $opt{no_topbar} ? ('series') : ( 'series', 'topbar' );
+
+    my %extra = map { $_ => $opt{$_} } grep { $_ ne 'no_topbar' } keys(%opt);
+
+    my $series = save_post(
+        "$label series",
+        %extra,
+        form       => 'series.tx',
+        title      => $title,
+        aclname    => $aclname,                       # required by series.json
+        child_form => $child_form,                    # required by series.json
+        local_href => "/$aclname",
+        href       => "/$aclname",
+        data       => "$title subhead",
+        callback   => 'Trog::Routes::HTML::series',
+        visibility => 'public',
+        tags       => \@tags,
+        tiled      => 0,
+        to         => '/',
+    ) or return undef;
+
+    return $series if $opt{no_topbar};
+
+    # The topbar comes from _get_series(), which index() renders through
+    # categories.tx.  Check it on / -- the series has no children yet, and
+    # posts() 404s on an empty series.
+    my ( $code, $body, $err ) = render( anon( route => '/' ) );
+    is( $code, 200, "$label: / renders" ) or diag($err);
+
+    my @titles = topbar_titles($body);
+    ok( ( grep { $_ eq $title } @titles ), "$label: series is in the topbar" )
+      or diag( 'topbar was: ' . join( ', ', @titles ) );
+
+    return $series;
+}
+
 subtest 'a datasource-backed series searches and paginates' => sub {
 
     # The whole point of a datasource is that its posts are built rather than
@@ -565,8 +619,8 @@ subtest 'a datasource-backed series searches and paginates' => sub {
     require Test::MockModule;
     require Trog::DataSource::Virt;
 
-    my ( $code, undef, $err ) = _render(
-        _admin(
+    my ( $code, undef, $err ) = render(
+        admin(
             route          => '/admin/wyzzerdd/save',
             method         => 'POST',
             name           => 'spec_guests',
@@ -580,8 +634,8 @@ subtest 'a datasource-backed series searches and paginates' => sub {
     );
     is( $code, 200, 'the datasource-backed type was created' ) or diag($err);
 
-    _reindex();
-    _make_series( qw{spec_guests specguests spec_guests.tx}, 'Spec Guests Series', no_topbar => 1 ) or return;
+    reindex();
+    make_series( qw{spec_guests specguests spec_guests.tx}, 'Spec Guests Series', no_topbar => 1 ) or return;
 
     # Twelve guests, every one stamped with the same created -- which is what
     # libvirt guests really are, and precisely what the cursor paginator cannot
@@ -613,7 +667,7 @@ subtest 'a datasource-backed series searches and paginates' => sub {
 
     my $page_of = sub {
         my (%q) = @_;
-        my ( $c, $b, $e ) = _render( _anon( route => '/specguests', %q ), \&Trog::Routes::HTML::series );
+        my ( $c, $b, $e ) = render( anon( route => '/specguests', %q ), \&Trog::Routes::HTML::series );
         is( $c, 200, 'guests page renders' ) or diag($e);
         return $b // '';
     };
@@ -641,7 +695,7 @@ subtest 'a datasource-backed series searches and paginates' => sub {
     # cached copy: a guest starting is not a post being saved, and libvirt is
     # not going to tell us about it.
     my $vtpsgi = Test::TPSGI->new( run_callbacks => 1 );
-    _render( _anon( route => '/specguests', tpsgi => $vtpsgi ), \&Trog::Routes::HTML::series );
+    render( anon( route => '/specguests', tpsgi => $vtpsgi ), \&Trog::Routes::HTML::series );
     is_deeply( [ keys %{ $vtpsgi->{renders} } ], [], 'a guests page is never saved as a static' );
 
     # The cursor paginator would be worse than useless here: every guest shares
@@ -671,11 +725,11 @@ subtest 'an ordinary series survives a page number in its URL' => sub {
     # of one post being nothing, the series could not find itself and 404'd on
     # its own page.  Latent until the datasource paginator started emitting page
     # numbers, and it was never about datasources.
-    _reindex();
-    _make_series( qw{spec_paged specpaged blog.tx}, 'Spec Paged Series', no_topbar => 1 ) or return;
+    reindex();
+    make_series( qw{spec_paged specpaged blog.tx}, 'Spec Paged Series', no_topbar => 1 ) or return;
 
     foreach my $n ( 1, 2 ) {
-        _save_post(
+        save_post(
             "spec_paged child $n",
             form       => 'blog.tx',
             title      => "Spec Paged Child $n",
@@ -687,11 +741,11 @@ subtest 'an ordinary series survives a page number in its URL' => sub {
     }
 
     # One child a page, so page two exists and holds the other one.
-    my ( $code, $body, $err ) = _render( _anon( route => '/specpaged', limit => 1, page => 2 ), \&Trog::Routes::HTML::series );
+    my ( $code, $body, $err ) = render( anon( route => '/specpaged', limit => 1, page => 2 ), \&Trog::Routes::HTML::series );
     is( $code, 200, 'a series page with ?page=2 still finds its series' ) or diag($err);
     like( $body, qr/Spec[ ]Paged[ ]Series/, 'and is the right one' );
 
-    ( $code, $body, $err ) = _render( _anon( route => '/specpaged', limit => 1, page => 1 ), \&Trog::Routes::HTML::series );
+    ( $code, $body, $err ) = render( anon( route => '/specpaged', limit => 1, page => 1 ), \&Trog::Routes::HTML::series );
     is( $code, 200, 'as does page one' ) or diag($err);
 
     # A stored series still pages by cursor, not by number: nothing about this
@@ -705,8 +759,8 @@ subtest 'a directory index series' => sub {
     # route, on whichever data model this run is using.
     require Trog::DataSource::DirIndex;
 
-    my ( $code, $body, $err ) = _render(
-        _admin(
+    my ( $code, $body, $err ) = render(
+        admin(
             route          => '/admin/wyzzerdd/save',
             method         => 'POST',
             name           => 'spec_files',
@@ -727,8 +781,8 @@ subtest 'a directory index series' => sub {
         close $fh;
     }
 
-    _reindex();
-    my $series = _make_series(
+    reindex();
+    my $series = make_series(
         qw{spec_files specfiles spec_files.tx}, 'Spec Files Series',
         no_topbar => 1,
         directory => 'assets/spec_downloads',
@@ -741,7 +795,7 @@ subtest 'a directory index series' => sub {
         return [ $html =~ m{<div[ ]class="entry">(file\d+\.txt)[ ]\(}g ];
     };
 
-    ( $code, $body, $err ) = _render( _anon( route => '/specfiles' ), \&Trog::Routes::HTML::series );
+    ( $code, $body, $err ) = render( anon( route => '/specfiles' ), \&Trog::Routes::HTML::series );
     is( $code, 200, 'the listing renders' ) or diag($err);
     is_deeply( $names->($body), [ map { "file$_.txt" } 1 .. 7 ], 'listing the directory, in name order' );
     like( $body, qr/\(10[ ]B\)/, 'with each entry\'s size' );
@@ -750,20 +804,20 @@ subtest 'a directory index series' => sub {
     like( $body, qr{href=['"]/assets/spec_downloads/file1\.txt['"]}, 'and a link to the file itself' );
 
     # It paginates like any other datasource page.
-    ( $code, $body, $err ) = _render( _anon( route => '/specfiles', limit => 3, page => 2 ), \&Trog::Routes::HTML::series );
+    ( $code, $body, $err ) = render( anon( route => '/specfiles', limit => 3, page => 2 ), \&Trog::Routes::HTML::series );
     is( $code, 200, 'page two renders' ) or diag($err);
     is_deeply( $names->($body), [qw{file4.txt file5.txt file6.txt}], 'holding the next three' );
     like( $body, qr/Page[ ]2[ ]of[ ]3/, 'and saying so' );
 
     # And searches like one.
-    ( $code, $body, $err ) = _render( _anon( route => '/specfiles', limit => 25, like => 'file3' ), \&Trog::Routes::HTML::series );
+    ( $code, $body, $err ) = render( anon( route => '/specfiles', limit => 25, like => 'file3' ), \&Trog::Routes::HTML::series );
     is_deeply( $names->($body), ['file3.txt'], 'searching the listing searches the filenames' );
 
     # The point of the exercise: this page is cached like any other, and
     # nothing else would ever throw that cache away, because no post is saved
     # when somebody drops a file in a directory.
     my $tpsgi = Test::TPSGI->new( run_callbacks => 1 );
-    _render( _anon( route => '/specfiles', tpsgi => $tpsgi ), \&Trog::Routes::HTML::series );
+    render( anon( route => '/specfiles', tpsgi => $tpsgi ), \&Trog::Routes::HTML::series );
 
     # And it really is cached, rather than merely being cacheable in principle:
     # the renderer hands anonymous, unparameterised, successful renders to tPSGI
@@ -784,8 +838,8 @@ subtest 'the wizard offers the types that exist, and can reopen one' => sub {
 
     # Make a type with everything the form can carry, then check the wizard
     # hands it back as the form that would have produced it.
-    my ( $code, $body, $err ) = _render(
-        _admin(
+    my ( $code, $body, $err ) = render(
+        admin(
             route               => '/admin/wyzzerdd/save',
             method              => 'POST',
             name                => 'spec_reopen',
@@ -816,7 +870,7 @@ subtest 'the wizard offers the types that exist, and can reopen one' => sub {
     like( $sidecar->{'x-tcms-post-type'}{display}, qr/widget_size/, 'and so is the display template' );
 
     # Now the wizard page itself.
-    ( $code, $body, $err ) = _render( _admin( route => '/admin/wyzzerdd' ), \&Trog::Routes::HTML::post_wizard );
+    ( $code, $body, $err ) = render( admin( route => '/admin/wyzzerdd' ), \&Trog::Routes::HTML::post_wizard );
     is( $code, 200, 'the wizard renders' ) or diag($err);
 
     like( $body, qr/id="wizard-existing"/,                     'the existing types are a dropdown' );
@@ -852,8 +906,8 @@ subtest 'the wizard offers the types that exist, and can reopen one' => sub {
 };
 
 subtest 'a field can be declared indexed' => sub {
-    my ( $code, undef, $err ) = _render(
-        _admin(
+    my ( $code, undef, $err ) = render(
+        admin(
             route          => '/admin/wyzzerdd/save',
             method         => 'POST',
             name           => 'spec_indexed',
@@ -904,9 +958,9 @@ subtest 'a field can be declared indexed' => sub {
     }
 
     # A post of the type still saves and reads back the same as any other.
-    _reindex();
-    _make_series( qw{spec_indexed specindexed spec_indexed.tx}, 'Spec Indexed Series', no_topbar => 1 ) or return;
-    my $child = _save_post(
+    reindex();
+    make_series( qw{spec_indexed specindexed spec_indexed.tx}, 'Spec Indexed Series', no_topbar => 1 ) or return;
+    my $child = save_post(
         'spec_indexed child',
         form       => 'spec_indexed.tx',
         title      => 'Spec Indexed Child',
@@ -922,8 +976,8 @@ subtest 'a field can be declared indexed' => sub {
 };
 
 subtest 'a field can be declared editors-only' => sub {
-    my ( $code, undef, $err ) = _render(
-        _admin(
+    my ( $code, undef, $err ) = render(
+        admin(
             route               => '/admin/wyzzerdd/save',
             method              => 'POST',
             name                => 'spec_secretive',
@@ -952,10 +1006,10 @@ subtest 'a field can be declared editors-only' => sub {
     ok( $sidecar->{properties}{hidden}{'x-tcms-private'},        'the private field is marked so' );
     ok( !exists $sidecar->{properties}{shown}{'x-tcms-private'}, 'and a public one carries no flag at all' );
 
-    _reindex();
+    reindex();
 
-    _make_series( qw{spec_secretive specsecretive spec_secretive.tx}, 'Spec Secretive Series', no_topbar => 1 ) or return;
-    my $child = _save_post(
+    make_series( qw{spec_secretive specsecretive spec_secretive.tx}, 'Spec Secretive Series', no_topbar => 1 ) or return;
+    my $child = save_post(
         'spec_secretive child',
         form       => 'spec_secretive.tx',
         title      => 'Spec Secretive Child',
@@ -969,81 +1023,27 @@ subtest 'a field can be declared editors-only' => sub {
     is( $child->{hidden}, 'private value', 'the value is stored like any other' );
 
     # An editor sees both.
-    my ( $acode, $abody ) = _render( _admin( route => '/specsecretive' ), \&Trog::Routes::HTML::series );
+    my ( $acode, $abody ) = render( admin( route => '/specsecretive' ), \&Trog::Routes::HTML::series );
     is( $acode, 200, 'the series renders for an admin' );
     like( $abody, qr{<div[ ]class="h">private[ ]value</div>}, 'who sees the private field' );
 
     # A logged out reader sees only the public one, without the template
     # having guarded anything.
-    my ( $ncode, $nbody ) = _render( _anon( route => '/specsecretive' ), \&Trog::Routes::HTML::series );
+    my ( $ncode, $nbody ) = render( anon( route => '/specsecretive' ), \&Trog::Routes::HTML::series );
     is( $ncode, 200, 'and for everyone else' );
     like( $nbody, qr{<div[ ]class="s">public[ ]value</div>}, 'who still sees the public field' );
     unlike( $nbody, qr/private[ ]value/, 'but not the private one' );
 };
 
-#--------------------------------------------------------------------------
-# The matrix.
-#
-# Per type: build a topbar series whose child_form is that type, check it shows
-# up in the nav, add a child post, check the child renders on the series page.
-#
-# Everything is verified ANONYMOUSLY.  can_edit is then false, so the editor
-# half of each form never renders and a title appears exactly once -- which is
-# what makes like($body, qr/$title/) mean anything.  It also sidesteps the
-# /secure prefixing that both _post_helper and categories.tx apply when a user
-# is set.
-#--------------------------------------------------------------------------
-
-sub _make_series {
-    my ( $label, $aclname, $child_form, $title, %opt ) = @_;
-
-    # _get_series caps the bar at 10 and the seeds already use two, so only the
-    # series whose topbar behaviour we actually care about get tagged.
-    my @tags = $opt{no_topbar} ? ('series') : ( 'series', 'topbar' );
-
-    my %extra = map { $_ => $opt{$_} } grep { $_ ne 'no_topbar' } keys(%opt);
-
-    my $series = _save_post(
-        "$label series",
-        %extra,
-        form       => 'series.tx',
-        title      => $title,
-        aclname    => $aclname,                       # required by series.json
-        child_form => $child_form,                    # required by series.json
-        local_href => "/$aclname",
-        href       => "/$aclname",
-        data       => "$title subhead",
-        callback   => 'Trog::Routes::HTML::series',
-        visibility => 'public',
-        tags       => \@tags,
-        tiled      => 0,
-        to         => '/',
-    ) or return undef;
-
-    return $series if $opt{no_topbar};
-
-    # The topbar comes from _get_series(), which index() renders through
-    # categories.tx.  Check it on / -- the series has no children yet, and
-    # posts() 404s on an empty series.
-    my ( $code, $body, $err ) = _render( _anon( route => '/' ) );
-    is( $code, 200, "$label: / renders" ) or diag($err);
-
-    my @titles = _topbar_titles($body);
-    ok( ( grep { $_ eq $title } @titles ), "$label: series is in the topbar" )
-      or diag( 'topbar was: ' . join( ', ', @titles ) );
-
-    return $series;
-}
-
-sub _series_page {
+my sub series_page {
     my ( $label, $aclname, $series_title, $expected_posts ) = @_;
 
-    my ( $code, $body, $err ) = _render( _anon( route => "/$aclname" ), \&Trog::Routes::HTML::series );
+    my ( $code, $body, $err ) = render( anon( route => "/$aclname" ), \&Trog::Routes::HTML::series );
     is( $code, 200, "$label: series page renders" ) or do { diag($err); return '' };
 
     like( $body, qr{<title>[^<]*\Q$series_title\E}, "$label: series page is the right series" );
-    is( _post_count($body), $expected_posts, "$label: exactly $expected_posts post(s) listed" )
-      or diag( _kontent($body) );
+    is( post_count($body), $expected_posts, "$label: exactly $expected_posts post(s) listed" )
+      or diag( kontent($body) );
 
     return $body;
 }
@@ -1054,9 +1054,9 @@ our ( $PAYEE, $PAYOR );
 
 subtest 'entities' => sub {
     my $title = 'Spec Entities Series';
-    _make_series( qw{entities specentities entities.tx}, $title ) or return;
+    make_series( qw{entities specentities entities.tx}, $title ) or return;
 
-    $PAYEE = _save_post(
+    $PAYEE = save_post(
         'entities payee child',
         form            => 'entities.tx',
         title           => 'Spec Payee Entity',
@@ -1068,7 +1068,7 @@ subtest 'entities' => sub {
         to              => '/specentities',
     ) or return;
 
-    $PAYOR = _save_post(
+    $PAYOR = save_post(
         'entities payor child',
         form            => 'entities.tx',
         title           => 'Spec Payor Entity',
@@ -1080,7 +1080,7 @@ subtest 'entities' => sub {
         to              => '/specentities',
     ) or return;
 
-    my $body = _series_page( 'entities', 'specentities', $title, 2 ) or return;
+    my $body = series_page( 'entities', 'specentities', $title, 2 ) or return;
 
     like( $body, qr{id="postData-\Q$PAYEE->{id}\E"}, 'payee body rendered' );
     like( $body, qr/Acme[ ]Payments[ ]LLC/,          'payee data rendered' );
@@ -1089,14 +1089,14 @@ subtest 'entities' => sub {
     # entity_details.tx is included only in the editor half, so these are stored
     # but never displayed.  Pinning that so a template change is noticed.
     unlike( $body, qr/Carrier[ ]Pigeon/, 'payment details are not shown to anonymous readers' );
-    is( _find_post('Spec Payee Entity')->{payment_method}, 'ACH', 'but payment_method did survive the schema' );
+    is( find_post('Spec Payee Entity')->{payment_method}, 'ACH', 'but payment_method did survive the schema' );
 };
 
 subtest 'blog' => sub {
     my $title = 'Spec Blog Series';
-    _make_series( qw{blog specblog blog.tx}, $title ) or return;
+    make_series( qw{blog specblog blog.tx}, $title ) or return;
 
-    my $child = _save_post(
+    my $child = save_post(
         'blog child',
         form       => 'blog.tx',
         title      => 'Spec Blog Child',
@@ -1106,7 +1106,7 @@ subtest 'blog' => sub {
         to         => '/specblog',
     ) or return;
 
-    my $body = _series_page( 'blog', 'specblog', $title, 1 ) or return;
+    my $body = series_page( 'blog', 'specblog', $title, 1 ) or return;
 
     like( $body, qr/Spec[ ]Blog[ ]Child/,            'child title rendered' );
     like( $body, qr{href='/posts/\Q$child->{id}\E'}, 'child permalink rendered' );
@@ -1117,9 +1117,9 @@ subtest 'blog' => sub {
 
 subtest 'microblog' => sub {
     my $title = 'Spec Microblog Series';
-    _make_series( qw{microblog specmicroblog microblog.tx}, $title ) or return;
+    make_series( qw{microblog specmicroblog microblog.tx}, $title ) or return;
 
-    my $child = _save_post(
+    my $child = save_post(
         'microblog child',
         form       => 'microblog.tx',
         title      => 'Spec Microblog Child',
@@ -1130,7 +1130,7 @@ subtest 'microblog' => sub {
         to         => '/specmicroblog',
     ) or return;
 
-    my $body = _series_page( 'microblog', 'specmicroblog', $title, 1 ) or return;
+    my $body = series_page( 'microblog', 'specmicroblog', $title, 1 ) or return;
 
     like( $body, qr{href='https://example\.com/spec'[ ]>Spec[ ]Microblog[ ]Child</a>}, 'title links out to href' );
     like( $body, qr{id="postData-\Q$child->{id}\E"},                                   'body block rendered' );
@@ -1139,7 +1139,7 @@ subtest 'microblog' => sub {
 
 subtest 'file' => sub {
     my $title = 'Spec File Series';
-    _make_series( qw{file specfile file.tx}, $title ) or return;
+    make_series( qw{file specfile file.tx}, $title ) or return;
 
     # _handle_upload MOVES the file, so it has to be created fresh here.
     my $src = "$ROOT/upload-src/spec-upload.txt";
@@ -1147,7 +1147,7 @@ subtest 'file' => sub {
     print {$fh} "spec upload contents\n";
     close $fh;
 
-    my $child = _save_post(
+    my $child = save_post(
         'file child',
         form       => 'file.tx',
         title      => 'Spec File Child',
@@ -1161,7 +1161,7 @@ subtest 'file' => sub {
     ok( !-e $src,                                     'the upload was moved out of its temp location, not copied' );
     ok( -f "www/assets/$child->{id}.spec-upload.txt", 'and it landed in www/assets' );
 
-    my $body = _series_page( 'file', 'specfile', $title, 1 ) or return;
+    my $body = series_page( 'file', 'specfile', $title, 1 ) or return;
 
     like( $body, qr{href='/assets/\Q$child->{id}\E\.spec-upload\.txt'}, 'title links to the asset' );
     like( $body, qr{id="postData-\Q$child->{id}\E"},                    'body block carries a unique id, like every other form' );
@@ -1179,9 +1179,9 @@ subtest 'file' => sub {
 
 subtest 'presentation' => sub {
     my $title = 'Spec Presentation Series';
-    _make_series( qw{presentation specpresentation presentation.tx}, $title ) or return;
+    make_series( qw{presentation specpresentation presentation.tx}, $title ) or return;
 
-    my $child = _save_post(
+    my $child = save_post(
         'presentation child',
         form          => 'presentation.tx',
         title         => 'Spec Presentation Child',
@@ -1194,7 +1194,7 @@ subtest 'presentation' => sub {
 
     is_deeply( $child->{data}, [ 'Slide one body.', 'Slide two body.' ], 'the multi-page data round-tripped as an array' );
 
-    my $body = _series_page( 'presentation', 'specpresentation', $title, 1 ) or return;
+    my $body = series_page( 'presentation', 'specpresentation', $title, 1 ) or return;
 
     # Slides only render under nochrome; the series page just links to the deck.
     like( $body, qr{<a[ ]href="/posts/\Q$child->{id}\E\?embed=1&nochrome=1">Click[ ]Here[ ]to[ ]view</a>}, 'deck link rendered' );
@@ -1203,7 +1203,7 @@ subtest 'presentation' => sub {
 
 subtest 'invoice' => sub {
     my $title = 'Spec Invoice Series';
-    _make_series( qw{invoice specinvoice invoice.tx}, $title ) or return;
+    make_series( qw{invoice specinvoice invoice.tx}, $title ) or return;
 
     my %invoice = (
         form          => 'invoice.tx',
@@ -1219,15 +1219,15 @@ subtest 'invoice' => sub {
     );
 
     my $sent  = time() - 10 * 86400;
-    my $child = do { local $NOW = $sent; _save_post( 'invoice child', %invoice ) }
+    my $child = do { local $NOW = $sent; save_post( 'invoice child', %invoice ) }
       or return;
     is( $child->{created}, $sent, 'the first save is stamped with the clock the test set' );
 
-    $child = _save_post( 'invoice child, edited', %invoice, id => $child->{id} ) or return;
+    $child = save_post( 'invoice child, edited', %invoice, id => $child->{id} ) or return;
     is( $child->{created}, $sent, 'an edit keeps the date the invoice was first made' );
     cmp_ok( $child->{modified}, '>', $sent, 'and the edit carries a later one' );
 
-    my $body = _series_page( 'invoice', 'specinvoice', $title, 1 ) or return;
+    my $body = series_page( 'invoice', 'specinvoice', $title, 1 ) or return;
 
     like( $body, qr/Invoice[ ]ID[#][ ]\Q$child->{id}\E/, 'invoice header rendered' );
 
@@ -1245,7 +1245,7 @@ subtest 'invoice' => sub {
 };
 
 subtest 'a private post is not served to a visitor who asks for it by id' => sub {
-    my $secret = _save_post(
+    my $secret = save_post(
         'private post',
         form       => 'blog.tx',
         title      => 'Spec Private Post',
@@ -1254,20 +1254,20 @@ subtest 'a private post is not served to a visitor who asks for it by id' => sub
         to         => '/posts',
     ) or return;
 
-    my ( $code, $body ) = _render( _anon( route => "/posts/$secret->{id}" ), \&Trog::Routes::HTML::posts );
+    my ( $code, $body ) = render( anon( route => "/posts/$secret->{id}" ), \&Trog::Routes::HTML::posts );
     is( $code, 404, 'a visitor gets a 404' );
     unlike( $body, qr/Spec[ ]private[ ]body/, 'and none of the post' );
 
-    ( $code, $body ) = _render( _admin( route => "/posts/$secret->{id}" ), \&Trog::Routes::HTML::posts );
+    ( $code, $body ) = render( admin( route => "/posts/$secret->{id}" ), \&Trog::Routes::HTML::posts );
     is( $code, 200, 'an admin gets the post' );
     like( $body, qr/Spec[ ]private[ ]body/, 'with its body' );
 };
 
 subtest 'spec_widget (the wizard-built type)' => sub {
     my $title = 'Spec Widget Series';
-    _make_series( qw{spec_widget specwidget spec_widget.tx}, $title ) or return;
+    make_series( qw{spec_widget specwidget spec_widget.tx}, $title ) or return;
 
-    my $child = _save_post(
+    my $child = save_post(
         'spec_widget child',
         form        => 'spec_widget.tx',
         title       => 'Spec Widget Child',
@@ -1282,7 +1282,7 @@ subtest 'spec_widget (the wizard-built type)' => sub {
     is( $child->{flavor}, 'Strawberry', 'the custom field survived validation' );
     ok( !exists $child->{bogus_field}, 'an undeclared field was still stripped' );
 
-    my $body = _series_page( 'spec_widget', 'specwidget', $title, 1 ) or return;
+    my $body = series_page( 'spec_widget', 'specwidget', $title, 1 ) or return;
 
     # The payoff: this can only render if the wizard wrote spec_widget.json,
     # schema_for merged it over the base post schema, and validate() therefore
@@ -1295,8 +1295,8 @@ subtest 'a wizard-built type can depend on another type' => sub {
 
     # The type we will point at.  The relation is what is under test, so keep
     # the target itself boring.
-    my ( $code, $body, $err ) = _render(
-        _admin(
+    my ( $code, $body, $err ) = render(
+        admin(
             route           => '/admin/wyzzerdd/save',
             method          => 'POST',
             name            => 'spec_target',
@@ -1314,8 +1314,8 @@ subtest 'a wizard-built type can depend on another type' => sub {
 
     # ...and the type that depends on it: one picked by id, one pulling in the
     # whole set.
-    ( $code, $body, $err ) = _render(
-        _admin(
+    ( $code, $body, $err ) = render(
+        admin(
             route               => '/admin/wyzzerdd/save',
             method              => 'POST',
             name                => 'spec_relator',
@@ -1361,11 +1361,11 @@ subtest 'a wizard-built type can depend on another type' => sub {
         'string', "'relation' expands to a real schema type"
     );
 
-    _reindex();
+    reindex();
 
     # Now exercise it end to end.
-    _make_series( qw{spec_target spectarget spec_target.tx}, 'Spec Target Series', no_topbar => 1 ) or return;
-    my $target = _save_post(
+    make_series( qw{spec_target spectarget spec_target.tx}, 'Spec Target Series', no_topbar => 1 ) or return;
+    my $target = save_post(
         'spec_target child',
         form       => 'spec_target.tx',
         title      => 'Spec Target Post',
@@ -1375,8 +1375,8 @@ subtest 'a wizard-built type can depend on another type' => sub {
         to         => '/spectarget',
     ) or return;
 
-    _make_series( qw{spec_relator specrelator spec_relator.tx}, 'Spec Relator Series', no_topbar => 1 ) or return;
-    my $relator = _save_post(
+    make_series( qw{spec_relator specrelator spec_relator.tx}, 'Spec Relator Series', no_topbar => 1 ) or return;
+    my $relator = save_post(
         'spec_relator child',
         form       => 'spec_relator.tx',
         title      => 'Spec Relator Post',
@@ -1389,7 +1389,7 @@ subtest 'a wizard-built type can depend on another type' => sub {
 
     is( $relator->{chosen}, $target->{id}, 'the referenced id survived validation' );
 
-    my $page = _series_page( 'spec_relator', 'specrelator', 'Spec Relator Series', 1 ) or return;
+    my $page = series_page( 'spec_relator', 'specrelator', 'Spec Relator Series', 1 ) or return;
 
     # Both halves of the relation resolved: the one we picked, and the set.
     like( $page, qr{<span[ ]class="chosen">Spec[ ]Target[ ]Post</span>}, 'the picked post resolved into the page' );
@@ -1397,10 +1397,10 @@ subtest 'a wizard-built type can depend on another type' => sub {
 };
 
 subtest '/api/posts_of_form feeds the relation picker' => sub {
-    my $target = _find_post('Spec Target Post');
+    my $target = find_post('Spec Target Post');
     ok( $target, 'the target post is there to be listed' ) or return;
 
-    my $res = Trog::Routes::JSON::posts_of_form( _admin( route => '/api/posts_of_form', form => 'spec_target.tx' ) );
+    my $res = Trog::Routes::JSON::posts_of_form( admin( route => '/api/posts_of_form', form => 'spec_target.tx' ) );
     is( ref $res, 'ARRAY', 'a PSGI response came back' ) or return;
 
     my ( $code, undef, $body ) = @$res;
@@ -1415,13 +1415,13 @@ subtest '/api/posts_of_form feeds the relation picker' => sub {
 
     # An editor who is not an admin holds only acls of their own, which no
     # public post carries.
-    $res     = Trog::Routes::JSON::posts_of_form( _query( user => 'spec-editor', user_acls => ['spec-editors'], route => '/api/posts_of_form', form => 'spec_target.tx' ) );
+    $res     = Trog::Routes::JSON::posts_of_form( query( user => 'spec-editor', user_acls => ['spec-editors'], route => '/api/posts_of_form', form => 'spec_target.tx' ) );
     $payload = JSON::MaybeXS::decode_json( join( '', @{ $res->[2] } ) );
     is_deeply( [ map { $_->{id} } @{ $payload->{posts} } ], [ $target->{id} ], 'an editor who is not an admin can pick a public post too' );
 
     # An unknown type is an empty list, not an error -- a type with no posts
     # yet is the normal state of affairs right after you create it.
-    $res     = Trog::Routes::JSON::posts_of_form( _admin( route => '/api/posts_of_form', form => 'nosuchtype.tx' ) );
+    $res     = Trog::Routes::JSON::posts_of_form( admin( route => '/api/posts_of_form', form => 'nosuchtype.tx' ) );
     $payload = JSON::MaybeXS::decode_json( join( '', @{ $res->[2] } ) );
     is_deeply( $payload->{posts}, [], 'an unknown type lists nothing rather than failing' );
 
@@ -1439,10 +1439,10 @@ subtest 'a series resolves its relations for logged out visitors too' => sub {
     # datasource reads to find its hypervisors -- so assert on that rather than
     # on the rendered children, whose relations posts() resolves later, after
     # it has widened user_acls and thus by a path that was never broken.
-    foreach my $case ( [ 'anonymously', _anon( route => '/specrelator' ) ], [ 'as an admin', _admin( route => '/specrelator' ) ] ) {
+    foreach my $case ( [ 'anonymously', anon( route => '/specrelator' ) ], [ 'as an admin', admin( route => '/specrelator' ) ] ) {
         my ( $label, $query ) = @$case;
 
-        my ( $code, undef, $err ) = _render( $query, \&Trog::Routes::HTML::series );
+        my ( $code, undef, $err ) = render( $query, \&Trog::Routes::HTML::series );
         is( $code, 200, "the series renders $label" ) or do { diag($err); next };
 
         my $resolved = $query->{primary_post}{everything};
@@ -1455,7 +1455,7 @@ subtest 'saves report back through the jsalert banner' => sub {
 
     # A good save redirects to where you came from, carrying the outcome.
     my $res = Trog::Routes::HTML::post_save(
-        _admin(
+        admin(
             route      => '/post/save',
             method     => 'POST',
             to         => '/specblog',
@@ -1480,14 +1480,14 @@ subtest 'saves report back through the jsalert banner' => sub {
     like( $h{'Set-Cookie'}, qr/^tcmsfeedback=0:/, 'the outcome is in a cookie instead' );
     unlike( $h{'Set-Cookie'}, qr/\n/, 'and the message is one line, since it lands in a JS string' );
 
-    _reindex();
+    reindex();
 
     # Follow the redirect the way a browser would: same destination, carrying
     # the cookie it was just handed.
     my $feedback = ( split( /;/, $h{'Set-Cookie'} ) )[0];
 
-    my ( $rcode, $body, $err ) = _render(
-        _admin( route => '/specblog', cookies => $feedback ),
+    my ( $rcode, $body, $err ) = render(
+        admin( route => '/specblog', cookies => $feedback ),
         \&Trog::Routes::HTML::series,
     );
     is( $rcode, 200, 'the destination renders' ) or diag($err);
@@ -1499,7 +1499,7 @@ subtest 'saves report back through the jsalert banner' => sub {
 
     # A rejected save comes back the same way, in red.
     $res = Trog::Routes::HTML::post_save(
-        _admin(
+        admin(
             route      => '/post/save',
             method     => 'POST',
             to         => '/specblog',
@@ -1516,12 +1516,12 @@ subtest 'saves report back through the jsalert banner' => sub {
     like( $h{'Set-Cookie'},                              qr/^tcmsfeedback=1:/,       'flagged as failed' );
     like( URI::Escape::uri_unescape( $h{'Set-Cookie'} ), qr/Not[ ]in[ ]enum[ ]list/, 'carrying the validator error' );
 
-    ok( !_find_post('Spec Rejected Child'), 'and the bad post was not written' );
+    ok( !find_post('Spec Rejected Child'), 'and the bad post was not written' );
 
     $feedback = ( split( /;/, $h{'Set-Cookie'} ) )[0];
 
-    ( $rcode, $body, $err ) = _render(
-        _admin( route => '/specblog', cookies => $feedback ),
+    ( $rcode, $body, $err ) = render(
+        admin( route => '/specblog', cookies => $feedback ),
         \&Trog::Routes::HTML::series,
     );
     is( $rcode, 200, 'the destination still renders' ) or diag($err);
@@ -1530,8 +1530,8 @@ subtest 'saves report back through the jsalert banner' => sub {
 
     # Read once: the cookie is expired by the page that rendered it, or the
     # banner follows the reader around until it times out on its own.
-    my ( undef, undef, undef, $rheaders ) = _render(
-        _admin( route => '/specblog', cookies => $feedback ),
+    my ( undef, undef, undef, $rheaders ) = render(
+        admin( route => '/specblog', cookies => $feedback ),
         \&Trog::Routes::HTML::series,
     );
     my %rh = @{ $rheaders || [] };
@@ -1541,7 +1541,7 @@ subtest 'saves report back through the jsalert banner' => sub {
     # something has their message served to everybody.  The query parameter
     # form was accidentally safe here; a cookie is not.
     my $tpsgi = Test::TPSGI->new( run_callbacks => 1 );
-    _render( _anon( route => '/specblog', cookies => $feedback, tpsgi => $tpsgi ), \&Trog::Routes::HTML::series );
+    render( anon( route => '/specblog', cookies => $feedback, tpsgi => $tpsgi ), \&Trog::Routes::HTML::series );
     is_deeply( [ keys %{ $tpsgi->{renders} } ], [], 'and it is never saved as a static' );
 };
 
@@ -1554,7 +1554,7 @@ subtest 'a hidden id that was never filled in' => sub {
     # directory rather than a post in it.  The error named File::Slurper, and
     # its stack trace then went into the redirect URL and produced a 419.
     my $res = Trog::Routes::HTML::post_save(
-        _admin(
+        admin(
             route      => '/post/save',
             method     => 'POST',
             to         => '/specblog',
@@ -1571,8 +1571,8 @@ subtest 'a hidden id that was never filled in' => sub {
     is( $code, 303, 'the save succeeds' );
     like( $h{'Set-Cookie'}, qr/^tcmsfeedback=0:/, 'and reports success' );
 
-    _reindex();
-    my $saved = _find_post('Spec Empty Id Child');
+    reindex();
+    my $saved = find_post('Spec Empty Id Child');
     ok( $saved,                       'the post was written' ) or return;
     ok( length( $saved->{id} // '' ), 'with an id of its own' );
     isnt( $saved->{id}, '', 'rather than the empty one it was handed' );
@@ -1582,10 +1582,10 @@ subtest 'a hidden id that was never filled in' => sub {
 };
 
 subtest 'the topbar did not silently overflow' => sub {
-    my ( $code, $body, $err ) = _render( _anon( route => '/' ) );
+    my ( $code, $body, $err ) = render( anon( route => '/' ) );
     is( $code, 200, '/ renders' ) or diag($err);
 
-    my @titles = _topbar_titles($body);
+    my @titles = topbar_titles($body);
 
     # 2 seeded series (Series, About) + the 7 we built.  _get_series() caps at
     # 10 (HTML.pm), so an eighth post type would start silently dropping one.
@@ -1608,7 +1608,7 @@ subtest 'the tpsgi side effects stayed inert' => sub {
 };
 
 subtest 'the real repo was not touched' => sub {
-    my %after = map { _snapshot("$REPO/$_") } qw{config data www/templates www/assets logs totp};
+    my %after = map { snapshot("$REPO/$_") } qw{config data www/templates www/assets logs totp};
 
     my @changed = grep { ( $REPO_BEFORE{$_} // '' ) ne ( $after{$_} // '' ) } keys %after;
     my @removed = grep { !exists $after{$_} } keys %REPO_BEFORE;

t/Trog-SQLite-TagIndex.t

@@ -50,7 +50,7 @@ sub post {
 }
 
 sub index_rows {
-    my $rows = Trog::SQLite::TagIndex::_dbh()->selectall_arrayref( 'SELECT id, tag FROM posts ORDER BY id, tag', { Slice => {} } );
+    my $rows = Trog::SQLite::TagIndex::dbh()->selectall_arrayref( 'SELECT id, tag FROM posts ORDER BY id, tag', { Slice => {} } );
     return [ map { "$_->{id}:$_->{tag}" } @$rows ];
 }
 
@@ -67,7 +67,7 @@ subtest 'add_post' => sub {
 };
 
 subtest 'rebuild' => sub {
-    my $dbh = Trog::SQLite::TagIndex::_dbh();
+    my $dbh = Trog::SQLite::TagIndex::dbh();
 
     # What an index looks like after something other than tCMS changed the
     # posts: a post that is gone, and a route to it.