Themes.pm 9.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305
  1. package Trog::Themes;
  2. use 5.040;
  3. use re '/aasx';
  4. use warnings FATAL => 'all';
  5. use FindBin::libs;
  6. use Trog::Vars;
  7. use Trog::Config;
  8. =head1 Trog::Themes
  9. Utility functions for getting themed paths.
  10. =cut
  11. our $template_dir = 'www/templates';
  12. =head2 routes() = %routes
  13. The active theme's own routing table, from its routes.pm.
  14. Themes can add routes of their own by shipping a routes.pm which populates
  15. %Theme::routes. Returns an empty list when there's no theme, or when the theme
  16. hasn't got one. Dies if there is a routes.pm and it won't load, as silently
  17. serving a site with half its routes missing is worse than not starting.
  18. =cut
  19. sub routes {
  20. my $rdir = get_dir();
  21. return () unless -f "$rdir/routes.pm"; ## no critic (ProhibitFiletest_f) -- theme ships routes, or it does not
  22. # get_dir() is relative to the tCMS root, which require only searches from '.'.
  23. local @INC = ( '.', @INC );
  24. local $@;
  25. eval { require "$rdir/routes.pm"; 1; } or do {
  26. die "Could not load Theme routing package: $@";
  27. };
  28. no warnings 'once';
  29. return %Theme::routes;
  30. }
  31. =head2 get_dir() = STRING $dir
  32. The active theme's directory, relative to the tCMS root, e.g.
  33. C<www/themes/mytheme>. Empty string when no theme is configured, or when the
  34. configured one doesn't exist on disk -- so it's safe to interpolate either way,
  35. and truthiness is the test for "is there a theme".
  36. Memoized for the life of the process: changing the theme goes through
  37. /config/save, which signals the workers to restart.
  38. =cut
  39. sub get_dir {
  40. state $tdir = '';
  41. return $tdir if $tdir;
  42. my $conf = Trog::Config::get();
  43. my $theme = $conf->param('general.theme') || '';
  44. if ($theme) {
  45. my $themedir = "www/themes/$theme";
  46. $tdir = $themedir if -d $themedir;
  47. }
  48. return $tdir;
  49. }
  50. =head2 td() = STRING $dir
  51. get_dir() as a rooted URL path rather than a filesystem one, for templates to
  52. build asset links with. Empty string when there's no theme.
  53. =cut
  54. sub td {
  55. my $dir = get_dir();
  56. return $dir ? "/$dir" : '';
  57. }
  58. # The theme's template dir and the stock one, in that order of preference.
  59. # The theme entry is empty when no theme is configured, so callers can just
  60. # grep for truth rather than repeating the "is there a theme" dance.
  61. sub _template_dirs ( $content_type, $is_component = 0 ) {
  62. my $ct = $Trog::Vars::byct{$content_type};
  63. my $theme = get_dir();
  64. my ( $themed, $stock ) = ( $theme ? "$theme/templates/$ct" : '', "$template_dir/$ct" );
  65. if ($is_component) {
  66. $themed .= "/components" if $themed;
  67. $stock .= "/components";
  68. }
  69. return ( $themed, $stock );
  70. }
  71. =head2 template_dirs($content_type, $is_component)
  72. Every directory which could satisfy a template, most specific first.
  73. Hand this to Text::Xslate as its C<path> and a theme gets to override
  74. individual templates without having to fork every last one of them.
  75. =cut
  76. sub template_dirs ( $content_type, $is_component = 0 ) {
  77. return grep { $_ && -d $_ } _template_dirs( $content_type, $is_component );
  78. }
  79. =head2 template_dir($template, $content_type, $is_component, $is_dir)
  80. The single directory which owns $template: the theme's if it has its own copy,
  81. the stock one otherwise. With $is_dir, $template names a subdirectory (forms,
  82. headers, footers) rather than a file.
  83. This answers "who owns this one thing", which is what you want when *writing*.
  84. For reading a whole directory you almost always want themed_templates_in_dir()
  85. instead, which spans both rather than making you pick.
  86. =cut
  87. sub template_dir ( $template, $content_type, $is_component = 0, $is_dir = 0 ) {
  88. my ( $mtd, $mtemp ) = _template_dirs( $content_type, $is_component );
  89. if ($is_dir) {
  90. return $mtd && -d "$mtd/$template" ? $mtd : $mtemp;
  91. }
  92. return $mtd && -f "$mtd/$template" ? $mtd : $mtemp; ## no critic (ProhibitFiletest_f) -- which dir owns the template
  93. }
  94. # Pick appropriate dir based on whether theme override exists
  95. sub _dir_for_resource ($resource) {
  96. my $theme_dir = get_dir();
  97. return $theme_dir && -f "$theme_dir/$resource" ? $theme_dir : ''; ## no critic (ProhibitFiletest_f) -- theme override, else stock
  98. }
  99. =head2 themed($resource)
  100. Path to a www/-relative resource, preferring the theme's copy.
  101. =cut
  102. sub themed ($resource) {
  103. return _dir_for_resource("$resource") . "/$resource";
  104. }
  105. =head2 themed_style($resource) = @hrefs
  106. Stylesheets are the exception to the "one or the other" rule: you get the stock
  107. sheet *and* the theme's, in that order, so a theme can override a handful of
  108. rules without restating the whole thing.
  109. =cut
  110. # For style we want to load *both* style files and have the override come later.
  111. sub themed_style ($resource) {
  112. my @styles = ("/styles/$resource");
  113. my $styled = _dir_for_resource("styles/$resource");
  114. $styled =~ s/^www\///;
  115. push( @styles, "/$styled/styles/$resource" ) if $styled;
  116. return @styles;
  117. }
  118. =head2 themed_script($resource)
  119. Path to a script under www/scripts, preferring the theme's copy.
  120. =cut
  121. sub themed_script ($resource) {
  122. return _dir_for_resource("scripts/$resource") . "/scripts/$resource";
  123. }
  124. =head2 themed_template($resource)
  125. Path to a template under www/templates, preferring the theme's copy.
  126. =cut
  127. sub themed_template ($resource) {
  128. return _dir_for_resource("templates/$resource") . "/templates/$resource";
  129. }
  130. =head2 dir_for($path, $content_type, $is_component)
  131. The single directory which owns a given component subdir: the theme's if it has
  132. one, the stock one otherwise. This is the right answer for I<writing> -- see
  133. forms_dir() and the post type wizard. For reading, you almost certainly want
  134. themed_templates_in_dir() instead, which spans both.
  135. =cut
  136. sub dir_for ( $path, $ct, $is_component = 0 ) {
  137. return template_dir( $path, $ct, $is_component, 1 ) . "/$path";
  138. }
  139. =head2 forms_dir()
  140. dir_for() the post type forms directory, which is where the post type wizard
  141. writes new types and their schema sidecars.
  142. =cut
  143. sub forms_dir {
  144. return dir_for( 'forms', 'text/html', 1 );
  145. }
  146. =head2 files_in_dir($path, $content_type, $is_component, $ext)
  147. Bare filenames with the given extension in whichever single directory dir_for()
  148. picks. See themed_templates_in_dir() for the version which spans both.
  149. =cut
  150. sub files_in_dir ( $path, $ct, $is_component = 0, $ext = 'tx' ) {
  151. return _read_dir( dir_for( $path, $ct, $is_component ), $ext );
  152. }
  153. sub _read_dir ( $dir, $ext ) {
  154. my $files = [];
  155. return $files unless -d $dir;
  156. opendir( my $dh, $dir ) or return $files;
  157. while ( my $file = readdir($dh) ) {
  158. push( @$files, $file ) if -f "$dir/$file" && $file =~ m/\.\Q$ext\E$/; ## no critic (ProhibitFiletest_f) -- listing names, nothing is opened
  159. }
  160. closedir($dh);
  161. return $files;
  162. }
  163. =head2 templates_in_dir($path, $content_type, $is_component)
  164. files_in_dir() restricted to templates.
  165. Beware that this only ever reads one directory -- see themed_templates_in_dir()
  166. for why that's usually not what you want.
  167. =cut
  168. sub templates_in_dir ( $path, $ct, $is_component = 0 ) {
  169. return files_in_dir( $path, $ct, $is_component, 'tx' );
  170. }
  171. =head2 themed_templates_in_dir($path, $content_type, $is_component)
  172. Same calling convention as templates_in_dir(), but it doesn't make you pick a
  173. side: you get the theme's templates where the theme has them, plus the stock
  174. ones it hasn't overridden.
  175. templates_in_dir() resolves through template_dir(), which is winner-take-all --
  176. if a theme has a forms/ dir at all, its contents are the *only* post types the
  177. site can see, and every core one vanishes. That's rarely what a theme author
  178. means by overriding a template.
  179. Returns bare filenames, deduped, theme first. Which of the two files a given
  180. name resolves to is then up to whoever renders it -- see template_dirs().
  181. =cut
  182. sub themed_templates_in_dir ( $path, $ct, $is_component = 0 ) {
  183. my @dirs = grep { $_ } map { "$_/$path" } _template_dirs( $ct, $is_component );
  184. my ( @templates, %seen );
  185. foreach my $dir (@dirs) {
  186. foreach my $template ( @{ _read_dir( $dir, 'tx' ) } ) {
  187. # First one wins, and the theme's dir comes first.
  188. push( @templates, $template ) unless $seen{$template}++;
  189. }
  190. }
  191. return \@templates;
  192. }
  193. =head2 themed_file_in_dir($path, $file, $content_type, $is_component)
  194. The path to a single named file in an abstract template dir, preferring the
  195. theme's copy. Returns undef when neither has it.
  196. =cut
  197. sub themed_file_in_dir ( $path, $file, $ct, $is_component = 0 ) {
  198. foreach my $dir ( grep { $_ } _template_dirs( $ct, $is_component ) ) {
  199. return "$dir/$path/$file" if -f "$dir/$path/$file"; ## no critic (ProhibitFiletest_f) -- search path, first hit wins
  200. }
  201. return undef;
  202. }
  203. =head2 themed_component($file, $content_type)
  204. The path to a file sitting directly in the components dir rather than in one of
  205. its subdirectories, preferring the theme's copy. Returns undef when neither has
  206. it.
  207. This is themed_file_in_dir() for the components which are not post types: the
  208. canned editor blocks every form splices in, and the JSON sidecars beside them
  209. which say what each one collects -- see Trog::DataModule::include_schema_for().
  210. =cut
  211. sub themed_component ( $file, $ct = 'text/html' ) {
  212. foreach my $dir ( template_dirs( $ct, 1 ) ) {
  213. return "$dir/$file" if -f "$dir/$file"; ## no critic (ProhibitFiletest_f) -- search path, first hit wins
  214. }
  215. return undef;
  216. }
  217. 1;