Renderer.pm 4.1 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121
  1. package Trog::Renderer;
  2. use 5.040;
  3. use re '/aasx';
  4. use warnings FATAL => 'all';
  5. use Carp::Always;
  6. use Trog::Vars;
  7. use Trog::Log qw{:all};
  8. use Trog::Renderer::text;
  9. use Trog::Renderer::html;
  10. use Trog::Renderer::json;
  11. use Trog::Renderer::blob;
  12. use Trog::Renderer::css;
  13. use Trog::Renderer::email;
  14. =head1 Trog::Renderer
  15. Idea here is to have a renderer per known/supported content-type we need to output that is also theme-aware.
  16. We have an abstraction here, render() which you feed everything to.
  17. =cut;
  18. our %renderers = (
  19. text => \&Trog::Renderer::text::render,
  20. html => \&Trog::Renderer::html::render,
  21. json => \&Trog::Renderer::json::render,
  22. blob => \&Trog::Renderer::blob::render,
  23. xsl => \&Trog::Renderer::text::render,
  24. xml => \&Trog::Renderer::text::render,
  25. rss => \&Trog::Renderer::html::render,
  26. css => \&Trog::Renderer::css::render,
  27. email => \&Trog::Renderer::email::render,
  28. );
  29. =head2 Trog::Renderer->render(%options)
  30. 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.
  31. The idea is that components will be concatenated to other rendered templates until we finish having everything ready.
  32. =cut
  33. sub render ( $, %options ) {
  34. local $@;
  35. my $renderer;
  36. return _yeet( $renderer, "Renderer requires a valid content type to be passed", %options ) unless $options{contenttype};
  37. my $rendertype = $Trog::Vars::byct{ $options{contenttype} };
  38. return _yeet( $renderer, "Renderer requires a known content type (used $options{contenttype}) to be passed", %options ) unless $rendertype;
  39. $renderer = $renderers{$rendertype};
  40. return _yeet( $renderer, "Renderer for $rendertype is not defined!", %options ) unless $renderer;
  41. return _yeet( $renderer, "Status code not provided", %options ) if !$options{code} && !$options{component};
  42. return _yeet( $renderer, "Template data not provided", %options ) unless $options{data};
  43. return _yeet( $renderer, "Template not provided", %options ) unless $options{template};
  44. #TODO future - save the components too and then compose them?
  45. my $data = $options{data};
  46. # $data->{nocache} as well as $options{nocache}: TCMS::build_routes puts a
  47. # route's nocache flag on the query, and exactly one caller (login) has ever
  48. # forwarded it here as an option. Every other nocache route was relying on
  49. # being auth-gated, so that the $data->{user} test below caught it -- which
  50. # says nothing about a route that is nocache and public, and there is now
  51. # one: a datasource whose posts go stale asks for it this way.
  52. my $skip_save =
  53. $options{component}
  54. || $options{nocache}
  55. || $data->{nocache}
  56. || !$data->{route}
  57. || $data->{has_query}
  58. || $data->{user}
  59. || ( $options{code} // 0 ) != 200
  60. || Trog::Log::is_debug();
  61. my $ret;
  62. local $@;
  63. eval {
  64. $ret = $renderer->(%options);
  65. if ( exists $data->{tpsgi} && !$skip_save ) {
  66. $data->{tpsgi}->add_post_close_callback(
  67. sub {
  68. # We invalidate these in the individual routes themselves.
  69. $data->{tpsgi}->save_render( $data->{route}, $rendertype, $ret->[2][0] );
  70. }
  71. );
  72. }
  73. 1;
  74. } or do {
  75. return _yeet( $renderer, $@, %options );
  76. };
  77. return $ret;
  78. }
  79. sub _yeet ( $renderer, $error, %options ) {
  80. WARN($error);
  81. # All-else fails error page
  82. my $ret;
  83. local $@;
  84. eval {
  85. $ret = $renderer->(
  86. code => 500,
  87. template => '500.tx',
  88. contenttype => 'text/html',
  89. data => { %options, content => "<h1>500 Internal Server Error</h1>$error" },
  90. );
  91. 1;
  92. } or do {
  93. my $msg = $error;
  94. $msg .= " and subsequently during render of error template, $@" if $renderer;
  95. #XXX bytes is probably not correct here
  96. INFO( "$options{data}{method} 500 " . length($msg) . " $options{data}{route}" );
  97. FATAL($msg);
  98. };
  99. return $ret;
  100. }
  101. 1;