Renderer.pm 3.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114
  1. package Trog::Renderer;
  2. use strict;
  3. use warnings;
  4. no warnings 'experimental';
  5. use feature qw{signatures state};
  6. use Carp::Always;
  7. use Trog::Vars;
  8. use Trog::Log qw{:all};
  9. use Trog::Renderer::text;
  10. use Trog::Renderer::html;
  11. use Trog::Renderer::json;
  12. use Trog::Renderer::blob;
  13. use Trog::Renderer::css;
  14. use Trog::Renderer::email;
  15. =head1 Trog::Renderer
  16. Idea here is to have a renderer per known/supported content-type we need to output that is also theme-aware.
  17. We have an abstraction here, render() which you feed everything to.
  18. =cut;
  19. our %renderers = (
  20. text => \&Trog::Renderer::text::render,
  21. html => \&Trog::Renderer::html::render,
  22. json => \&Trog::Renderer::json::render,
  23. blob => \&Trog::Renderer::blob::render,
  24. xsl => \&Trog::Renderer::text::render,
  25. xml => \&Trog::Renderer::text::render,
  26. rss => \&Trog::Renderer::html::render,
  27. css => \&Trog::Renderer::css::render,
  28. email => \&Trog::Renderer::email::render,
  29. );
  30. =head2 Trog::Renderer->render(%options)
  31. 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.
  32. The idea is that components will be concatenated to other rendered templates until we finish having everything ready.
  33. =cut
  34. sub render ( $class, %options ) {
  35. local $@;
  36. my $renderer;
  37. return _yeet( $renderer, "Renderer requires a valid content type to be passed", %options ) unless $options{contenttype};
  38. my $rendertype = $Trog::Vars::byct{ $options{contenttype} };
  39. return _yeet( $renderer, "Renderer requires a known content type (used $options{contenttype}) to be passed", %options ) unless $rendertype;
  40. $renderer = $renderers{$rendertype};
  41. return _yeet( $renderer, "Renderer for $rendertype is not defined!", %options ) unless $renderer;
  42. return _yeet( $renderer, "Status code not provided", %options ) if !$options{code} && !$options{component};
  43. return _yeet( $renderer, "Template data not provided", %options ) unless $options{data};
  44. return _yeet( $renderer, "Template not provided", %options ) unless $options{template};
  45. #TODO future - save the components too and then compose them?
  46. my $skip_save = !$options{component} || !$options{data}{route} || $options{data}{has_query} || $options{data}{user} || ( $options{code} // 0 ) != 200 || Trog::Log::is_debug();
  47. my $ret;
  48. local $@;
  49. eval {
  50. $ret = $renderer->(%options);
  51. save_render( $options{data}, $ret->[2], %{ $ret->[1] } ) unless $skip_save;
  52. 1;
  53. } or do {
  54. return _yeet( $renderer, $@, %options );
  55. };
  56. return $ret;
  57. }
  58. sub _yeet ( $renderer, $error, %options ) {
  59. WARN($error);
  60. # All-else fails error page
  61. my $ret;
  62. local $@;
  63. eval {
  64. $ret = $renderer->(
  65. code => 500,
  66. template => '500.tx',
  67. contenttype => 'text/html',
  68. data => { %options, content => "<h1>500 Internal Server Error</h1>$error" },
  69. );
  70. 1;
  71. } or do {
  72. my $msg = $error;
  73. $msg .= " and subsequently during render of error template, $@" if $renderer;
  74. INFO("$options{data}{method} 500 $options{data}{route}");
  75. FATAL($msg);
  76. };
  77. return $ret;
  78. }
  79. sub save_render ( $vars, $body, %headers ) {
  80. Path::Tiny::path( "www/statics/" . dirname( $vars->{route} ) )->mkpath;
  81. my $file = "www/statics/$vars->{route}";
  82. my $verb = -f $file ? 'Overwrite' : 'Write';
  83. DEBUG("$verb static for $vars->{route}");
  84. open( my $fh, '>', $file ) or die "Could not open $file for writing";
  85. print $fh "HTTP/1.1 $vars->{code} OK\n";
  86. foreach my $h ( keys(%headers) ) {
  87. print $fh "$h:$headers{$h}\n" if $headers{$h};
  88. }
  89. print $fh "\n";
  90. print $fh $body;
  91. close $fh;
  92. }
  93. 1;