File Coverage

blib/lib/Mojolicious/Plugin/PetalTinyRenderer.pm

Criterion	Covered	Total	%
statement	72	91	79.1
branch	21	36	58.3
condition	6	9	66.6
subroutine	14	16	87.5
pod	1	1	100.0
total	114	153	74.5

package Mojolicious::Plugin::PetalTinyRenderer;
$Mojolicious::Plugin::PetalTinyRenderer::VERSION = '0.05';
use Mojo::Base 'Mojolicious::Plugin';
use Try::Tiny;

my $tal_ns = q{xmlns:tal="http://purl.org/petal/1.0/"};

__PACKAGE__->attr('config');

sub register {
    my ($self, $app, $conf) = @_;
    $self->config($conf);

    $app->renderer->add_handler($conf->{name} || 'tal' => sub { $self->_petal(@_) } );
}

sub _petal {
    my ($self, $renderer, $c, $output, $options) = @_;

    my $inline = $options->{inline};
    my $name   = defined $inline ? "inline" : $renderer->template_name($options);
    return undef unless defined $name;

    $$output = '';

    my $log = $c->app->log;

    if (defined $inline) {
        $log->debug(qq{Rendering inline template "$name".});
        $$output = $self->_render_xml($inline, $c, $name);
    }
    else {
        if (defined(my $path = $renderer->template_path($options))) {
            $log->debug(qq{Rendering template "$name".});

            my $encoding = $self->config->{encoding} // ":encoding(UTF-8)";

            if (open my $file, "<$encoding", $path) {
                my $xml = join "", <$file>;
                $$output = $self->_render_xml($xml, $c, $name);
                close $file;
            }
            else {
                $log->debug(qq{Template "$name" ($path) not readable.});
                return undef;
            }
        }
        elsif (my $d = $renderer->get_data_template($options)) {
            $log->debug(qq{Rendering template "$name" from DATA section.});
            $$output = $self->_render_xml($d, $c, $name);
        }
        else {
            $log->debug(qq{Template "$name" not found.});
            return undef;
        }
    }

    return 1;
}

sub _render_xml {
    my ($self, $xml, $c, $name) = @_;

    my $deldiv = 0;
    if ($xml !~ /\bxmlns:/) {
        $xml = "$xml";
        $deldiv = 1;
    }

    my $template = Petal::Tiny::_Mojo->new($xml);

    my $helper = Mojolicious::Plugin::PetalTinyRenderer::Helper->new(ctx => $c);

    my $html;
    try {
        $html = $template->process(%{$c->stash}, c => $c, h => $helper);
    }
    catch {
        my $validator;
        eval "use XML::Validate; \$validator = XML::Validate->new(Type => 'LibXML');";
        if ($validator) {
            $xml =~ s///;
            if ($validator->validate($xml)) {
                die "Petal::Tiny blew up handling '$name', and XML::Validate reports the XML is fine.\n\n$_";
            }
            else {
                my $e       = $validator->last_error;
                my $message = $e->{message} // "";
                die "Petal::Tiny blew up handling '$name', and XML::Validate reports:\n\n$message";
            }
        }
        else {
            die "Petal::Tiny blew up handling '$name'. Install XML::Validate and XML::LibXML for better diagnostics.\n\n$_";
        }
    };

    if ($deldiv) {
        $html =~ s,\A,,;
        $html =~ s,\z,,;
    }

    return $html;
}

1;

package
  Petal::Tiny::_Mojo;

use Mojo::Base 'Petal::Tiny';
use Scalar::Util 'blessed';

sub reftype {
    my ($self, $obj) = @_;
    return 'ARRAY' if blessed $obj and $obj->isa('Mojo::Collection');
    return $self->SUPER::reftype($obj);
}

1;

package
  Mojolicious::Plugin::PetalTinyRenderer::Helper;

use Mojo::Base -base;

our $AUTOLOAD;

__PACKAGE__->attr('ctx');

# stolen from  Mojolicious::Plugin::TtRenderer::Helper
sub AUTOLOAD {
    my $self = shift;

    my $method = $AUTOLOAD;

    return if $method =~ /^[A-Z]+?$/;
    return if $method =~ /^_/;
    return if $method =~ /(?:\:*?)DESTROY$/;

    $method = (split '::' => $method)[-1];

    die qq/Unknown helper: $method/ unless $self->ctx->app->renderer->helpers->{$method};

    return $self->ctx->$method(@_);
}

# lifted from http://www.perlmonks.org/?node_id=44911
sub can {
    my ($self, $method) = @_;
    my $subref = $self->SUPER::can($method);
    return $subref if $subref; # can found it; it's a real method

    # Method doesn't currently exist; should it, though?
    return unless exists $self->ctx->app->renderer->helpers->{$method};

    # Return an anon sub that will work when it's eventually called
    sub {
        my $self = $_[0];

        # The method is being called.  The real method may have been
        # created in the meantime; if so, don't call AUTOLOAD again
        my $subref = $self->SUPER::can($method);
        goto &$subref if $subref;

        $AUTOLOAD=$method;
        goto &AUTOLOAD;
    };
}

1;
__END__