Keep the files of a theme apart from their URLs

Trog::Themes answered two kinds of path without saying which.  td()
said that it was a URL path, but it answered /www/themes/x, and the
webserver serves no URL under /www.  themed() and themed_script()
answered the file of the theme's copy, www/themes/x/..., but the URL
of the stock copy, /img/....  So each caller took the answer apart in
its own way: three of them removed /www/ from theme_dir, Bundle turned
a leading / back into www/, and themed_style removed www/.

Four links of a themed site were broken by it:

- header.tx linked each favicon at themes/x/img/icon/..., a relative
  path, so below the top level of the site every favicon was a 404.
  It also linked the theme's directory for each icon, whether the
  theme had that icon or not.
- og:image and twitter:image pointed at /www/themes/x/..., a 404.
- The icons of /api/webmanifest were www/themes/x/..., relative to
  /api/, so each one was a 404.
- /favicon.ico handed tPSGI /img/icon//favicon.ico to open, a path
  from the root of the filesystem, so it served nothing.

Now get_dir() and themed() answer files, td() answers a URL path, and
url_path() turns a file under www/ into the URL that serves it.  No
caller rewrites a path any more.  The header, the manifest and the
social image resolve each icon through themed(), so a theme that has
some of the icons gets its own and the stock ones for the rest.

A theme whose templates wrote /<: $theme_dir :>/ to make up for the
relative path must drop the leading slash.  Such a theme
needs that change in its own repository.

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

lib/Theme.pm

@@ -27,8 +27,8 @@ Fallback <title> for pages which have no post of their own to name them.
 
 =item $default_image
 
-The image handed to social media scrapers as the site's preview, relative to
-the theme directory.
+The image handed to social media scrapers as the site's preview, as a path
+relative to www/.  The theme's copy wins when it has one.
 
 =item $display_name
 

lib/Trog/Bundle.pm

@@ -76,7 +76,7 @@ sub scripts (@names) {
     return undef unless @names;
 
     my @files = map {
-        my $file = m/\A\w[\w.-]*[.]js\z/ ? Trog::Themes::themed_script($_) =~ s{\A/}{www/}r : undef;
+        my $file = m/\A\w[\w.-]*[.]js\z/ ? Trog::Themes::themed_script($_) : undef;
         $file && -f $file ? $file : undef;    ## no critic (ProhibitFiletest_f) -- a name that is not a file is not a script
     } @names;
     my @missing = map { $names[$_] } grep { !defined $files[$_] } 0 .. $#names;

lib/Trog/Component.pm

@@ -137,10 +137,8 @@ sub component ( $name, $args = {} ) {
 Render a component template and hand back the body, for the many components
 whose whole job is exactly that.
 
-The template gets theme_dir as well as $data, unless $data gives it a value: the
-active theme's directory as a path under the site root, such as
-C<themes/mytheme>, for building asset links.  It is empty when there is no
-theme.
+The template gets theme_dir as well as $data, unless $data gives it a value:
+Trog::Themes::td(), for building asset links.
 
 Dies naming the template if the render fails, rather than answering with the
 PSGI triplet Trog::Renderer::render() produces on failure.
@@ -154,9 +152,8 @@ sub render_template ( $template, $data = {} ) {
     # would close the cycle.  By the time anyone calls this it is already loaded.
     require Trog::Renderer;
 
-    # td() is rooted at /www, which is not in the URL space.
     my %data = %$data;
-    $data{theme_dir} //= Trog::Themes::td() =~ s{\A/www/}{}r;
+    $data{theme_dir} //= Trog::Themes::td();
 
     my $out = Trog::Renderer->render(
         contenttype => 'text/html',

lib/Trog/Component/Header.pm

@@ -5,6 +5,7 @@ use re '/aasx';
 use warnings FATAL => 'all';
 
 use Trog::Component ();
+use Trog::Themes    ();
 
 =head1 Trog::Component::Header
 
@@ -30,6 +31,10 @@ It takes these arguments, all optional, and dies on any other:
     theme_dir                             as Trog::Component::render_template()
                                           gives it, when it is not passed
 
+The template also gets icons, the URL path of each favicon by its file name,
+from the theme where it has that icon and from the stock ones where it does
+not.
+
 The list arguments default to empty rather than to the stock sheets, so that a
 caller which has none -- rss_style(), notably -- gets a header with none, as it
 did when the route rendered this itself.
@@ -50,6 +55,8 @@ sub render (%args) {
     $args{print_styles} //= [];
     $args{scripts}      //= [];
 
+    $args{icons} = { map { $_ => Trog::Themes::url_path( Trog::Themes::themed("img/icon/$_") ) } qw{favicon.svg favicon-167.png favicon-180.png favicon-48.png favicon-192.png} };
+
     return Trog::Component::render_template( 'header.tx', \%args );
 }
 

lib/Trog/Component/PostFooter.pm

@@ -37,7 +37,6 @@ sub render (%args) {
 
     die "No such footer '$name'\n" unless List::Util::any { $_ eq $name } @{ available() };
 
-    $args{theme_dir} //= Trog::Themes::td();
     return Trog::Component::render_template( "footers/$name", \%args );
 }
 

lib/Trog/Component/PostHeader.pm

@@ -37,7 +37,6 @@ sub render (%args) {
 
     die "No such header '$name'\n" unless List::Util::any { $_ eq $name } @{ available() };
 
-    $args{theme_dir} //= Trog::Themes::td();
     return Trog::Component::render_template( "headers/$name", \%args );
 }
 

lib/Trog/Routes/HTML.pm

@@ -525,7 +525,7 @@ my sub build_social_meta ( $query, $title ) {    ## no critic (ProhibitSingleUse
     $card_type = 'featured_image' if $query->{primary_post} && $query->{primary_post}{is_image};
     $card_type = 'player'         if $query->{primary_post} && $query->{primary_post}{is_video};
 
-    my $image = $Theme::default_image ? "https://$query->{domain}/" . Trog::Themes::get_dir() . "/$Theme::default_image" : '';
+    my $image = $Theme::default_image ? "https://$query->{domain}" . Trog::Themes::url_path( Trog::Themes::themed($Theme::default_image) ) : '';
     $image = "https://$query->{domain}/$query->{primary_post}{preview}" if $query->{primary_post} && $query->{primary_post}{preview};
     $image = "https://$query->{domain}/$query->{primary_post}{href}"    if $query->{primary_post} && $query->{primary_post}{is_image};
 
@@ -615,7 +615,6 @@ sub index ( $query, $content = '', $i_styles = [] ) {
 
     #Do embed content
     my $tmpl = $embed ? 'embed.tx' : 'index.tx';
-    $query->{theme_dir} =~ s/^\/www\///;
 
     # Grab the avatar class for the logged in user
     if ( $query->{user} ) {
@@ -3469,7 +3468,7 @@ steps, essentially, so that themes can replace individual icons.
 
 sub icon ($query) {
     my $path  = $query->{route};
-    my $tpath = Trog::Themes::themed("img/icon/$path");
+    my $tpath = Trog::Themes::themed( 'img/icon' . $path );
     return $query->{tpsgi}->serve( $path, $tpath, $query->{start}, $query->{streaming}, $query->{ranges}, $query->{last_fetched}, $query->{deflate} );
 }
 
@@ -3600,7 +3599,6 @@ sub finish_render ( $template, $vars, %headers ) {
     $vars->{cachecontrol} //= $Trog::Vars::cache_control{revalidate};
 
     $vars->{code} ||= 200;
-    $vars->{theme_dir} =~ s/^\/www\/// if $vars->{theme_dir};
 
     # %headers was accepted and then ignored, which nothing noticed because
     # nothing passed any.  index() passes one now, to expire the feedback cookie

lib/Trog/Routes/JSON.pm

@@ -100,17 +100,9 @@ sub catalog {
 }
 
 sub webmanifest {
-    state $headers = { ETag => 'manifest-' . _version() };
-    my $theme_dir = Trog::Themes::get_dir();
+    state $headers  = { ETag => 'manifest-' . _version() };
     state %manifest = (
-        "icons" => [
-            { "src" => "$theme_dir/img/icon/favicon-32.png",  "type" => "image/png", "sizes" => "32x32" },
-            { "src" => "$theme_dir/img/icon/favicon-48.png",  "type" => "image/png", "sizes" => "48x48" },
-            { "src" => "$theme_dir/img/icon/favicon-167.png", "type" => "image/png", "sizes" => "167x167" },
-            { "src" => "$theme_dir/img/icon/favicon-180.png", "type" => "image/png", "sizes" => "180x180" },
-            { "src" => "$theme_dir/img/icon/favicon-192.png", "type" => "image/png", "sizes" => "192x192" },
-            { "src" => "$theme_dir/img/icon/favicon-512.png", "type" => "image/png", "sizes" => "512x512" },
-        ],
+        "icons" => [ map { +{ "src" => Trog::Themes::url_path( Trog::Themes::themed("img/icon/favicon-$_.png") ), "type" => "image/png", "sizes" => "${_}x$_" } } qw{32 48 167 180 192 512} ],
     );
     return _render( 200, $headers, %manifest );
 }

lib/Trog/Themes.pm

@@ -16,7 +16,10 @@ Utility functions for getting themed paths.
 
 =cut
 
-our $template_dir = 'www/templates';
+# The directory that the webserver serves at /.
+our $docroot = 'www';
+
+our $template_dir = "$docroot/templates";
 
 =head2 routes() = %routes
 
@@ -62,7 +65,7 @@ sub get_dir {
     my $conf  = Trog::Config::get();
     my $theme = $conf->param('general.theme') || '';
     if ($theme) {
-        my $themedir = "www/themes/$theme";
+        my $themedir = "$docroot/themes/$theme";
         $tdir = $themedir if -d $themedir;
     }
     return $tdir;
@@ -70,14 +73,27 @@ sub get_dir {
 
 =head2 td() = STRING $dir
 
-get_dir() as a rooted URL path rather than a filesystem one, for templates to
-build asset links with.  Empty string when there's no theme.
+The URL path of the active theme's directory, e.g. C</themes/mytheme>, for
+templates to build asset links with.  Empty string when there's no theme.
 
 =cut
 
 sub td {
     my $dir = get_dir();
-    return $dir ? "/$dir" : '';
+    return $dir ? url_path($dir) : '';
+}
+
+=head2 url_path($file) = STRING $path
+
+The URL path at which the webserver serves $file, a path under the document
+root such as C<www/themes/mytheme/img/a.png>.  Dies when $file is not under it,
+as the webserver does not serve it.
+
+=cut
+
+sub url_path ($file) {
+    die "$file is not under $docroot/\n" unless CORE::index( $file, "$docroot/" ) == 0;
+    return substr( $file, length $docroot );
 }
 
 # The theme's template dir and the stock one, in that order of preference.
@@ -134,41 +150,39 @@ my sub dir_for_resource ($resource) {
     return $theme_dir && -f "$theme_dir/$resource" ? $theme_dir : '';    ## no critic (ProhibitFiletest_f) -- theme override, else stock
 }
 
-=head2 themed($resource)
+=head2 themed($resource) = STRING $file
 
-Path to a www/-relative resource, preferring the theme's copy.
+The file of $resource, a path relative to the document root, preferring the
+theme's copy, e.g. C<www/themes/mytheme/img/a.png> or C<www/img/a.png>.  Hand
+it to url_path() for its link.
 
 =cut
 
 sub themed ($resource) {
-    return dir_for_resource("$resource") . "/$resource";
+    return ( dir_for_resource($resource) || $docroot ) . "/$resource";
 }
 
 =head2 themed_style($resource) = @hrefs
 
-Stylesheets are the exception to the "one or the other" rule: you get the stock
-sheet *and* the theme's, in that order, so a theme can override a handful of
-rules without restating the whole thing.
+Stylesheets are the exception to the "one or the other" rule: you get the URL
+path of the stock sheet *and* the theme's, in that order, so a theme can
+override a handful of rules without restating the whole thing.
 
 =cut
 
-# 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");
-    $styled =~ s/^www\///;
-    push( @styles, "/$styled/styles/$resource" ) if $styled;
-    return @styles;
+    my $theme = dir_for_resource("styles/$resource");
+    return ( "/styles/$resource", $theme ? url_path("$theme/styles/$resource") : () );
 }
 
-=head2 themed_script($resource)
+=head2 themed_script($resource) = STRING $file
 
-Path to a script under www/scripts, preferring the theme's copy.
+themed() for a script under scripts/.
 
 =cut
 
 sub themed_script ($resource) {
-    return dir_for_resource("scripts/$resource") . "/scripts/$resource";
+    return themed("scripts/$resource");
 }
 
 =head2 dir_for($path, $content_type, $is_component)

t/Trog-Component-page.t

@@ -4,7 +4,8 @@ use re '/aasx';
 use warnings FATAL => 'all';
 
 use Test::More;
-use Test::Fatal qw{exception};
+use Test::Fatal      qw{exception};
+use Test::MockModule qw{strict};
 use FindBin;
 
 use FindBin::libs;
@@ -86,6 +87,21 @@ subtest 'Header' => sub {
     like( $social, qr{<meta[ ]name="twitter:card"[ ]/>}, "meta_tags stay markup" );
 };
 
+subtest 'Header links each icon from the theme or the stock icons' => sub {
+    my $themes = Test::MockModule->new('Trog::Themes');
+    $themes->redefine( get_dir => sub { '' } );
+
+    my $stock = Trog::Component::component('Header');
+    like( $stock, qr{href="/img/icon/favicon[.]svg"}, "with no theme, the stock icon is linked from the root of the site" );
+    unlike( $stock, qr{href="(?!/)[^"]*favicon}, "and no icon has a relative link, which would break below the top level" );
+
+    my $original = Trog::Themes->can('themed');
+    $themes->redefine( themed => sub ($resource) { $resource eq 'img/icon/favicon.svg' ? "www/themes/spec/$resource" : $original->($resource) } );
+    my $themed = Trog::Component::component('Header');
+    like( $themed, qr{href="/themes/spec/img/icon/favicon\.svg"}, "an icon that the theme has is linked from the theme" );
+    like( $themed, qr{href="/img/icon/favicon-48\.png"},          "and one that it has not is linked from the stock icons" );
+};
+
 subtest 'CategoryBar' => sub {
     my $categories = [ { local_href => '/series/blog', title => 'Blog' } ];
 

t/Trog-Component.t

@@ -195,15 +195,15 @@ subtest 'render_template' => sub {
     $renderer->redefine( render => sub ( $class, %args ) { %seen = %{ $args{data} }; return 'rendered' } );
     my $themes = Test::MockModule->new('Trog::Themes');
 
-    $themes->redefine( td => sub { '/www/themes/bogus' } );
+    $themes->redefine( td => sub { '/themes/bogus' } );
     is( Trog::Component::render_template( 'bogus.tx', { title => 'x' } ), 'rendered', "the body of the render comes back" );
-    is_deeply( \%seen, { title => 'x', theme_dir => 'themes/bogus' }, "a template that is passed no theme_dir gets the path of the theme under the site root" );
+    is_deeply( \%seen, { title => 'x', theme_dir => '/themes/bogus' }, "a template that is passed no theme_dir gets the URL path of the theme" );
 
     Trog::Component::render_template( 'bogus.tx', { theme_dir => undef } );
-    is( $seen{theme_dir}, 'themes/bogus', "an undefined theme_dir is filled in, as the Header component passes one" );
+    is( $seen{theme_dir}, '/themes/bogus', "an undefined theme_dir is filled in, as the Header component passes one" );
 
-    Trog::Component::render_template( 'bogus.tx', { theme_dir => 'themes/other' } );
-    is( $seen{theme_dir}, 'themes/other', "a theme_dir that the caller passes wins" );
+    Trog::Component::render_template( 'bogus.tx', { theme_dir => '/themes/other' } );
+    is( $seen{theme_dir}, '/themes/other', "a theme_dir that the caller passes wins" );
 
     $themes->redefine( td => sub { '' } );
     Trog::Component::render_template('bogus.tx');

t/Trog-Routes-HTML-icon.t

@@ -0,0 +1,36 @@
+#!/usr/bin/env perl
+use 5.040;
+use re '/aasx';
+use warnings FATAL => 'all';
+
+use Test::More;
+use Test::MockModule qw{strict};
+
+use FindBin::libs;
+
+require_ok('Trog::Routes::HTML') or BAIL_OUT("Can't find SUT");
+
+# A tPSGI that records what it was asked to serve.
+my @served;
+{
+
+    package Fake::TPSGI;
+    sub new                { return bless( {}, shift ) }
+    sub serve ( $, @args ) { @served = @args; return 'served' }
+}
+
+subtest 'icon' => sub {
+    my $themes = Test::MockModule->new('Trog::Themes');
+    my $query  = { route => '/favicon.ico', tpsgi => Fake::TPSGI->new(), ranges => [] };
+
+    $themes->redefine( get_dir => sub { '' } );
+    is( Trog::Routes::HTML::icon($query), 'served', "the icon is served" );
+    is_deeply( [ @served[ 0, 1 ] ], [ '/favicon.ico', 'www/img/icon/favicon.ico' ], "with no theme, from the file of the stock icon" );
+
+    my $original = Trog::Themes->can('themed');
+    $themes->redefine( themed => sub ($resource) { $resource eq 'img/icon/favicon.ico' ? "www/themes/spec/$resource" : $original->($resource) } );
+    Trog::Routes::HTML::icon($query);
+    is( $served[1], 'www/themes/spec/img/icon/favicon.ico', "and from the theme's file where the theme has one" );
+};
+
+done_testing();

t/Trog-Routes-JSON.t

@@ -4,7 +4,9 @@ use re '/aasx';
 use warnings FATAL => 'all';
 
 use Test::More;
-use JSON::Validator ();
+use JSON::Validator  ();
+use JSON::MaybeXS    ();
+use Test::MockModule qw{strict};
 
 use FindBin::libs;
 
@@ -24,4 +26,17 @@ subtest 'the change request token is a uuid, and nothing else' => sub {
     ok( !$valid->('a|b'),                                    'nor a pipe, which the class used to hold' );
 };
 
+subtest 'webmanifest links each icon from the theme or the stock icons' => sub {
+    my $themes = Test::MockModule->new('Trog::Themes');
+    $themes->redefine( themed => sub ($resource) { $resource eq 'img/icon/favicon-192.png' ? "www/themes/spec/$resource" : "www/$resource" } );
+
+    my $res      = Trog::Routes::JSON::webmanifest();
+    my $manifest = JSON::MaybeXS::decode_json( join( '', @{ $res->[2] } ) );
+    my %src      = map { $_->{sizes} => $_->{src} } @{ $manifest->{icons} };
+
+    is( $src{'192x192'},     '/themes/spec/img/icon/favicon-192.png', "an icon that the theme has is linked from the theme" );
+    is( $src{'48x48'},       '/img/icon/favicon-48.png',              "and one that it has not is linked from the stock icons" );
+    is( scalar( keys %src ), 6,                                       "every size is listed" );
+};
+
 done_testing();

t/Trog-Themes.t

@@ -0,0 +1,61 @@
+#!/usr/bin/env perl
+use 5.040;
+use re '/aasx';
+use warnings FATAL => 'all';
+
+use Test::More;
+use Test::Fatal      qw{exception};
+use Test::MockModule qw{strict};
+use Path::Tiny();
+
+use FindBin::libs;
+
+require_ok('Trog::Themes') or BAIL_OUT("Can't find SUT");
+
+# A document root with a stock copy of every file, and a theme which overrides
+# some of them.  The helpers answer paths relative to the tCMS root, so the
+# test runs from the root of the fixture.
+my $root = Path::Tiny->tempdir();
+foreach my $file (qw{img/a.png img/b.png scripts/a.js styles/a.css styles/b.css}) {
+    $root->child("www/$file")->touchpath;
+}
+$root->child("www/themes/spec/$_")->touchpath foreach qw{img/a.png scripts/a.js styles/a.css};
+
+chdir("$root") or BAIL_OUT("Cannot enter the fixture: $!");
+
+my $themedir = '';
+my $mock     = Test::MockModule->new('Trog::Themes');
+$mock->redefine( 'get_dir', sub { $themedir } );
+
+subtest 'url_path' => sub {
+    is( Trog::Themes::url_path('www/img/a.png'),             '/img/a.png',             "a file under www/ is served from the root of the site" );
+    is( Trog::Themes::url_path('www/themes/spec/img/a.png'), '/themes/spec/img/a.png', "and so is one in a theme" );
+
+    like( exception { Trog::Themes::url_path('lib/Trog/Themes.pm') }, qr/not[ ]under[ ]www/, "a file outside the document root has no URL" );
+    like( exception { Trog::Themes::url_path('wwwx/img/a.png') },     qr/not[ ]under[ ]www/, "nor does one in a directory whose name only starts with www" );
+    like( exception { Trog::Themes::url_path('/www/img/a.png') },     qr/not[ ]under[ ]www/, "nor a URL path, which is not a file" );
+};
+
+subtest 'with no theme' => sub {
+    $themedir = '';
+
+    is( Trog::Themes::td(),                  '',                 "td() is empty" );
+    is( Trog::Themes::themed('img/a.png'),   'www/img/a.png',    "themed() answers the stock file" );
+    is( Trog::Themes::themed_script('a.js'), 'www/scripts/a.js', "and so does themed_script()" );
+    is_deeply( [ Trog::Themes::themed_style('a.css') ], ['/styles/a.css'], "themed_style() links the stock sheet alone" );
+};
+
+subtest 'with a theme' => sub {
+    $themedir = 'www/themes/spec';
+
+    is( Trog::Themes::td(),                  '/themes/spec',                 "td() is the URL path of the theme, not its directory" );
+    is( Trog::Themes::themed('img/a.png'),   'www/themes/spec/img/a.png',    "themed() answers the theme's copy" );
+    is( Trog::Themes::themed('img/b.png'),   'www/img/b.png',                "and the stock file where the theme has no copy" );
+    is( Trog::Themes::themed_script('a.js'), 'www/themes/spec/scripts/a.js', "themed_script() answers the theme's copy" );
+    ok( Path::Tiny::path( Trog::Themes::themed("img/b.png") )->is_file, "what themed() answers is a file" );
+
+    is_deeply( [ Trog::Themes::themed_style('a.css') ], [ '/styles/a.css', '/themes/spec/styles/a.css' ], "themed_style() links the stock sheet, then the theme's" );
+    is_deeply( [ Trog::Themes::themed_style('b.css') ], ['/styles/b.css'],                                "and the stock sheet alone where the theme has none" );
+};
+
+done_testing();

www/templates/html/components/header.tx

@@ -11,11 +11,11 @@
         <meta charset="utf-8" />
 
         <link rel="alternate" title="rss" type="application/rss+xml" href="<: $route :>?format=rss" />
-        <link rel="icon" type="image/svg+xml" href="<: $theme_dir :>/img/icon/favicon.svg" />
-        <link rel="apple-touch-icon" type="image/png" sizes="167x167" href="<: $theme_dir :>/img/icon/favicon-167.png" />
-        <link rel="apple-touch-icon" type="image/png" sizes="180x180" href="<: $theme_dir :>/img/icon/favicon-180.png" />
-        <link rel="icon" type="image/png" sizes="48x48" href="<: $theme_dir :>/img/icon/favicon-48.png" />
-        <link rel="icon" type="image/png" sizes="192x192" href="<: $theme_dir :>/img/icon/favicon-192.png" />
+        <link rel="icon" type="image/svg+xml" href="<: $icons['favicon.svg'] :>" />
+        <link rel="apple-touch-icon" type="image/png" sizes="167x167" href="<: $icons['favicon-167.png'] :>" />
+        <link rel="apple-touch-icon" type="image/png" sizes="180x180" href="<: $icons['favicon-180.png'] :>" />
+        <link rel="icon" type="image/png" sizes="48x48" href="<: $icons['favicon-48.png'] :>" />
+        <link rel="icon" type="image/png" sizes="192x192" href="<: $icons['favicon-192.png'] :>" />
         <link rel="manifest" href="/api/webmanifest" />
 
         : if ($author) {