tCMS/lib/Trog/Renderer.pm

package Trog::Renderer;

use 5.040;
use re '/aasx';
use warnings FATAL => 'all';

use Carp::Always;

use Trog::Vars;
use Trog::Log qw{:all};

use Trog::Renderer::text;
use Trog::Renderer::html;
use Trog::Renderer::json;
use Trog::Renderer::blob;
use Trog::Renderer::css;
use Trog::Renderer::email;

=head1 Trog::Renderer

Idea here is to have a renderer per known/supported content-type we need to output that is also theme-aware.

We have an abstraction here, render() which you feed everything to.

=cut;

our %renderers = (
    text  => \&Trog::Renderer::text::render,
    html  => \&Trog::Renderer::html::render,
    json  => \&Trog::Renderer::json::render,
    blob  => \&Trog::Renderer::blob::render,
    xsl   => \&Trog::Renderer::text::render,
    xml   => \&Trog::Renderer::text::render,
    rss   => \&Trog::Renderer::html::render,
    css   => \&Trog::Renderer::css::render,
    email => \&Trog::Renderer::email::render,
);

my sub yeet ( $renderer, $error, %options ) {
    WARN($error);

    # All-else fails error page
    my $ret;
    local $@;
    eval {
        $ret = $renderer->(
            code        => 500,
            template    => '500.tx',
            contenttype => 'text/html',
            data        => { %options, content => "<h1>500 Internal Server Error</h1>$error" },
        );
        1;
    } or do {
        my $msg = $error;
        $msg .= " and subsequently during render of error template, $@" if $renderer;

        #XXX bytes is probably not correct here
        INFO( "$options{data}{method} 500 " . length($msg) . " $options{data}{route}" );
        FATAL($msg);
    };
    return $ret;
}

=head2 Trog::Renderer->render(%options)

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.
The idea is that components will be concatenated to other rendered templates until we finish having everything ready.

=cut

sub render ( $, %options ) {
    local $@;
    my $renderer;
    return yeet( $renderer, "Renderer requires a valid content type to be passed", %options ) unless $options{contenttype};
    my $rendertype = $Trog::Vars::byct{ $options{contenttype} };
    return yeet( $renderer, "Renderer requires a known content type (used $options{contenttype}) to be passed", %options ) unless $rendertype;
    $renderer = $renderers{$rendertype};
    return yeet( $renderer, "Renderer for $rendertype is not defined!", %options ) unless $renderer;
    return yeet( $renderer, "Status code not provided",                 %options ) if !$options{code} && !$options{component};
    return yeet( $renderer, "Template data not provided",               %options ) unless $options{data};
    return yeet( $renderer, "Template not provided",                    %options ) unless $options{template};

    #TODO future - save the components too and then compose them?
    my $data = $options{data};

    # $data->{nocache} as well as $options{nocache}: TCMS::build_routes puts a
    # route's nocache flag on the query, and exactly one caller (login) has ever
    # forwarded it here as an option.  Every other nocache route was relying on
    # being auth-gated, so that the $data->{user} test below caught it -- which
    # says nothing about a route that is nocache and public, and there is now
    # one: a datasource whose posts go stale asks for it this way.
    my $skip_save =
         $options{component}
      || $options{nocache}
      || $data->{nocache}
      || !$data->{route}
      || $data->{has_query}
      || $data->{user}
      || ( $options{code} // 0 ) != 200
      || Trog::Log::is_debug();

    my $ret;
    local $@;
    eval {
        $ret = $renderer->(%options);
        if ( exists $data->{tpsgi} && !$skip_save ) {
            $data->{tpsgi}->add_post_close_callback(
                sub {
                    # We invalidate these in the individual routes themselves.
                    $data->{tpsgi}->save_render( $data->{route}, $rendertype, $ret->[2][0] );
                }
            );
        }
        1;
    } or do {
        return yeet( $renderer, $@, %options );
    };
    return $ret;
}

1;