Keep only the bundles that pages link, and die on a script that is not there

The cache of bundles was emptied when it held 16, because the route
built and kept any list that a URL named. The lists that pages link are
a few per route, and they are the only ones worth keeping. So
scripts(), which finish_render calls, now keeps its bundle, and the new
served(), which the route calls, keeps nothing. served() returns the
bundle that a page linked when that bundle is current, and otherwise it
builds one for the request. The limit is gone.

A page that named a missing script used to get a bundle without that
script, and a warning. The page then failed in the browser, far from the
cause. scripts() now dies and names the script. served() returns undef
for such a name, so the route answers 404 to a URL.

The editing scripts now load for any reader who is logged in, not only
for an admin.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>

lib/Trog/Bundle.pm

@@ -9,7 +9,6 @@ use File::Slurper            ();
 use JavaScript::Minifier::XS ();
 use List::Util               ();
 
-use Trog::Log    qw{:all};
 use Trog::Themes ();
 
 =head1 Trog::Bundle
@@ -22,22 +21,53 @@ C</bundle/{version}/{names}.js> serves that bundle.
 
 =cut
 
-# The names of a bundle, as its href carries them, to the bundle.
+# The names of each bundle that a page links, as its href carries them, to the
+# bundle.
 my %bundles;
 
-# The number of bundles kept.  A site has a few lists of scripts, and anyone can
-# ask for another one, so the cache is emptied when it grows past this.
-my $max_bundles = 16;
+# The file of each name, or undef for a name that is not a script.
+my sub files_of (@names) {
+    return map {
+        my $file = m/\A\w[\w.-]*[.]js\z/ ? Trog::Themes::themed_script($_) =~ s{\A/}{www/}r : undef;
+        $file && -f $file ? $file : undef;    ## no critic (ProhibitFiletest_f) -- a name that is not a file is not a script
+    } @names;
+}
+
+# The names as an href carries them, and what changes when a file does.
+my sub identify ( $names, $files ) {
+    return (
+        join( '+',  map { s/[.]js\z//r } @$names ),
+        join( "\0", map { join( ':', $_, ( stat $_ )[ 7, 9 ] ) } @$files ),
+    );
+}
+
+my sub build ( $key, $signature, @files ) {
+
+    # A newline before the semicolon, because a file can end in a line comment.
+    my $body = join(
+        "\n;\n",
+        map {
+            my $js = File::Slurper::read_binary($_);
+            m/[.]min[.]js\z/ ? $js : JavaScript::Minifier::XS::minify($js)
+        } @files
+    );
+    my $version = substr( Digest::SHA::sha256_hex($body), 0, 16 );
+    return {
+        href      => "/bundle/$version/$key.js",
+        version   => $version,
+        body      => $body,
+        signature => $signature,
+    };
+}
 
 =head2 scripts(@names) = HASHREF or undef
 
-The bundle of the scripts that @names names, each of them a file name under
-F<www/scripts>, such as C<post.js>.  The theme's copy of a script is used in
-place of the stock one.  The order is the order of @names, and a name that is
-given twice is used once.
+The bundle that a page links, of the scripts that @names names.  Each name is a
+file name under F<www/scripts>, such as C<post.js>.  The theme's copy of a
+script is used in place of the stock one.  The order is the order of @names, and
+a name that is given twice is used once.
 
-Returns undef if no name is a script.  A name that is not a script is left out,
-with a warning.
+Returns undef for an empty list, and dies if a name is not a script.
 
 The hash has these keys:
 
@@ -51,39 +81,37 @@ changes.
 =cut
 
 sub scripts (@names) {
-    my ( @kept, @files );
-    foreach my $name ( List::Util::uniq(@names) ) {
-        my $file = $name =~ m/\A\w[\w.-]*[.]js\z/ ? Trog::Themes::themed_script($name) =~ s{\A/}{www/}r : undef;
-        if ( !$file || !-f $file ) {    ## no critic (ProhibitFiletest_f) -- a name that is not a file is left out
-            WARN("There is no script $name to bundle");
-            next;
-        }
-        push( @kept,  $name );
-        push( @files, $file );
-    }
-    return undef unless @files;
+    @names = List::Util::uniq(@names);
+    return undef unless @names;
 
-    my $names     = join( '+',  map { s/[.]js\z//r } @kept );
-    my $signature = join( "\0", map { join( ':', $_, ( stat $_ )[ 7, 9 ] ) } @files );
-    return $bundles{$names} if $bundles{$names} && $bundles{$names}{signature} eq $signature;
+    my @files   = files_of(@names);
+    my @missing = map { $names[$_] } grep { !defined $files[$_] } 0 .. $#names;
+    die "There is no script to bundle named @missing\n" if @missing;
 
-    # A newline before the semicolon, because a file can end in a line comment.
-    my $body = join(
-        "\n;\n",
-        map {
-            my $js = File::Slurper::read_binary($_);
-            m/[.]min[.]js\z/ ? $js : JavaScript::Minifier::XS::minify($js)
-        } @files
-    );
-    my $version = substr( Digest::SHA::sha256_hex($body), 0, 16 );
+    my ( $key, $signature ) = identify( \@names, \@files );
+    return $bundles{$key} if $bundles{$key} && $bundles{$key}{signature} eq $signature;
+    return $bundles{$key} = build( $key, $signature, @files );
+}
 
-    %bundles = () if keys %bundles >= $max_bundles;
-    return $bundles{$names} = {
-        href      => "/bundle/$version/$names.js",
-        version   => $version,
-        body      => $body,
-        signature => $signature,
-    };
+=head2 served(@names) = HASHREF or undef
+
+The bundle that the route serves for @names, as scripts() describes it, or undef
+if a name is not a script.
+
+It is the bundle that scripts() built, if that one is current.  Otherwise it is
+built for this request and not kept, because anyone can put any list in a URL.
+
+=cut
+
+sub served (@names) {
+    @names = List::Util::uniq(@names);
+    my @files = files_of(@names);
+    return undef if !@names || List::Util::any { !defined } @files;
+
+    my ( $key, $signature ) = identify( \@names, \@files );
+    my $linked = $bundles{$key};
+    return $linked if $linked && $linked->{signature} eq $signature;
+    return build( $key, $signature, @files );
 }
 
 =head2 save($tpsgi, $bundle)

lib/Trog/Routes/HTML.pm

@@ -1886,7 +1886,7 @@ sub posts ( $query, $direct = 0 ) {
     return $content if ref $content eq "ARRAY";
 
     return $content if $direct;
-    my @scripts = ( ( $is_admin ? qw{post.js post_relations.js} : () ), qw{highlight.min.js reveal.min.js} );
+    my @scripts = ( ( $query->{user} ? qw{post.js post_relations.js} : () ), qw{highlight.min.js reveal.min.js} );
     return Trog::Routes::HTML::index( $query, $content, $styles, \@scripts );
 }
 
@@ -3396,7 +3396,7 @@ cached before a script changed still gets its scripts.
 =cut
 
 sub bundle ($query) {
-    my $bundle = Trog::Bundle::scripts( map { "$_.js" } split( /[+]/, $query->{names} ) );
+    my $bundle = Trog::Bundle::served( map { "$_.js" } split( /[+]/, $query->{names} ) );
     return $query->{tpsgi}->notfound($query) unless $bundle;
     return $query->{tpsgi}->redirect( $bundle->{href} ) if $query->{route} ne $bundle->{href};
     return [

t/Trog-Bundle.t

@@ -5,6 +5,7 @@ use warnings FATAL => 'all';
 
 use Test::More;
 use Test::MockModule qw{strict};
+use Test::Fatal      qw{exception};
 use Cwd();
 use File::Path();
 use File::Temp();
@@ -38,9 +39,6 @@ my $themedir = '';
 my $mock     = Test::MockModule->new('Trog::Themes');
 $mock->redefine( 'get_dir', sub { $themedir } );
 
-my @warned;
-local $SIG{__WARN__} = sub { push @warned, $_[0] };
-
 subtest 'the scripts, in the order named' => sub {
     my $bundle = Trog::Bundle::scripts(qw{two.js vendor.min.js one.js two.js});
 
@@ -50,15 +48,13 @@ subtest 'the scripts, in the order named' => sub {
 };
 
 subtest 'a name that is not a script' => sub {
-    @warned = ();
-    my $bundle = Trog::Bundle::scripts( qw{one.js nothere.js ../one.js .hidden.js sub/one.js one.css}, 'one.js+two' );
-    is( $bundle->{href}, "/bundle/$bundle->{version}/one.js", 'is left out' );
-    is( scalar(@warned), 6,                                   'with a warning for each' ) or diag( explain( \@warned ) );
-    like( $warned[0], qr/no[ ]script[ ]nothere[.]js/, 'that names it' );
-
-    @warned = ();
-    is( Trog::Bundle::scripts(qw{nothere.js}), undef, 'and a list of nothing else is no bundle' );
-    is( Trog::Bundle::scripts(),               undef, 'nor is an empty one' );
+    my @not = ( qw{nothere.js ../one.js .hidden.js sub/one.js one.css}, 'one.js+two' );
+    foreach my $name (@not) {
+        like( exception { Trog::Bundle::scripts( 'one.js', $name ) }, qr/no[ ]script[ ]to[ ]bundle[ ]named[ ]\Q$name\E/, "$name is fatal on a page, and named" );
+        is( Trog::Bundle::served( 'one.js', $name ), undef, '...and not served' );
+    }
+    is( Trog::Bundle::scripts(), undef, 'an empty list is no bundle' );
+    is( Trog::Bundle::served(),  undef, '...on a page or in a URL' );
 };
 
 subtest "the theme's copy" => sub {
@@ -82,15 +78,13 @@ subtest 'a script that changes' => sub {
     isnt( $after->{href}, $before->{href}, 'at a new href' );
 };
 
-subtest 'many lists' => sub {
-    $stock->child("s$_.js")->spew_raw("var s$_;") for 1 .. 20;
+subtest 'a list that only a URL names' => sub {
+    my $served = Trog::Bundle::served(qw{two.js one.js});
+    is( $served->{body}, Trog::Bundle::scripts(qw{two.js one.js})->{body}, 'is the bundle that a page would link' );
+    isnt( Trog::Bundle::served(qw{one.js two.js}), Trog::Bundle::served(qw{one.js two.js}), 'but is built for each request, and not kept' );
 
-    @warned = ();
-    my %bundle = map { $_ => Trog::Bundle::scripts( 'one.js', "s$_.js" ) } 1 .. 20;
-    my %body   = map { $_ => $bundle{$_}{body} } keys %bundle;
-    is( scalar(@warned), 0, 'twenty lists' );
-    isnt( Trog::Bundle::scripts(qw{one.js s1.js}), $bundle{1}, 'are more than the cache keeps, so it was emptied' );
-    is( Trog::Bundle::scripts( 'one.js', "s$_.js" )->{body}, $body{$_}, "list $_ still has its body after the cache is emptied" ) for 1, 20;
+    my $linked = Trog::Bundle::scripts(qw{two.js one.js});
+    is( Trog::Bundle::served(qw{two.js one.js}), $linked, 'while a list that a page links is the one built for the page' );
 };
 
 done_testing();

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

@@ -1283,6 +1283,10 @@ subtest 'presentation' => sub {
     $watch->{callback}->( $tpsgi, {} );
     is_deeply( [ @{ $tpsgi->{invalidated} }[ -2, -1 ] ], [qw{html js}], 'and a change throws away the saved pages and bundles' );
 
+    ( $code, $page, $err ) = render( query( user => 'spec_reader', user_acls => [], $deck_query->() ), \&Trog::Routes::HTML::posts );
+    is( $code, 200, 'the deck renders for a reader who is logged in' ) or return diag($err);
+    like( $page, qr{src="/bundle/\w+/post[+]post_relations[+]}, 'with the editing scripts, though the reader is not an admin' );
+
     ( $code, $page, $err ) = render( admin( $deck_query->() ), \&Trog::Routes::HTML::posts );
     is( $code, 200, 'the deck renders for an editor' ) or return diag($err);
     my $editing = qr{post[+]post_relations};