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 |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | package Mojolicious::Plugin::PetalTinyRenderer; | ||||||
2 | $Mojolicious::Plugin::PetalTinyRenderer::VERSION = '0.04'; | ||||||
3 | 2 | 2 | 2693 | use Mojo::Base 'Mojolicious::Plugin'; | |||
2 | 6 | ||||||
2 | 19 | ||||||
4 | 2 | 2 | 2340 | use Try::Tiny; | |||
2 | 3741 | ||||||
2 | 2455 | ||||||
5 | |||||||
6 | my $tal_ns = q{xmlns:tal="http://purl.org/petal/1.0/"}; | ||||||
7 | |||||||
8 | __PACKAGE__->attr('config'); | ||||||
9 | |||||||
10 | sub register { | ||||||
11 | 2 | 2 | 1 | 139 | my ($self, $app, $conf) = @_; | ||
12 | 2 | 51 | $self->config($conf); | ||||
13 | |||||||
14 | 2 | 100 | 8 | 83 | $app->renderer->add_handler($conf->{name} || 'tal' => sub { $self->_petal(@_) } ); | ||
8 | 213297 | ||||||
15 | } | ||||||
16 | |||||||
17 | sub _petal { | ||||||
18 | 8 | 8 | 24 | my ($self, $renderer, $c, $output, $options) = @_; | |||
19 | |||||||
20 | 8 | 23 | my $inline = $options->{inline}; | ||||
21 | 8 | 100 | 57 | my $name = defined $inline ? "inline" : $renderer->template_name($options); | |||
22 | 8 | 50 | 110 | return undef unless defined $name; | |||
23 | |||||||
24 | 8 | 16 | $$output = ''; | ||||
25 | |||||||
26 | 8 | 180 | my $log = $c->app->log; | ||||
27 | |||||||
28 | 8 | 100 | 274 | if (defined $inline) { | |||
29 | 1 | 6 | $log->debug(qq{Rendering inline template "$name".}); | ||||
30 | 1 | 22 | $$output = $self->_render_xml($inline, $c, $name); | ||||
31 | } | ||||||
32 | else { | ||||||
33 | 7 | 100 | 31 | if (defined(my $path = $renderer->template_path($options))) { | |||
50 | |||||||
34 | 1 | 138 | $log->debug(qq{Rendering template "$name".}); | ||||
35 | |||||||
36 | 1 | 50 | 59 | my $encoding = $self->config->{encoding} // ":encoding(UTF-8)"; | |||
37 | |||||||
38 | 1 | 50 | 1 | 13 | if (open my $file, "<$encoding", $path) { | ||
1 | 4 | ||||||
1 | 9 | ||||||
1 | 86 | ||||||
39 | 1 | 1930 | my $xml = join "", <$file>; | ||||
40 | 1 | 23 | $$output = $self->_render_xml($xml, $c, $name); | ||||
41 | 1 | 20 | close $file; | ||||
42 | } | ||||||
43 | else { | ||||||
44 | 0 | 0 | $log->debug(qq{Template "$name" ($path) not readable.}); | ||||
45 | 0 | 0 | return undef; | ||||
46 | } | ||||||
47 | } | ||||||
48 | elsif (my $d = $renderer->get_data_template($options)) { | ||||||
49 | 6 | 782 | $log->debug(qq{Rendering template "$name" from DATA section.}); | ||||
50 | 6 | 222 | $$output = $self->_render_xml($d, $c, $name); | ||||
51 | } | ||||||
52 | else { | ||||||
53 | 0 | 0 | $log->debug(qq{Template "$name" not found.}); | ||||
54 | 0 | 0 | return undef; | ||||
55 | } | ||||||
56 | } | ||||||
57 | |||||||
58 | 8 | 32 | return 1; | ||||
59 | } | ||||||
60 | |||||||
61 | sub _render_xml { | ||||||
62 | 8 | 8 | 52 | my ($self, $xml, $c, $name) = @_; | |||
63 | |||||||
64 | 8 | 17 | my $deldiv = 0; | ||||
65 | 8 | 100 | 63 | if ($xml !~ /\bxmlns:/) { | |||
66 | 7 | 31 | $xml = " $xml "; |
||||
67 | 7 | 16 | $deldiv = 1; | ||||
68 | } | ||||||
69 | |||||||
70 | 8 | 77 | my $template = Petal::Tiny::_Mojo->new($xml); | ||||
71 | |||||||
72 | 8 | 272 | my $helper = Mojolicious::Plugin::PetalTinyRenderer::Helper->new(ctx => $c); | ||||
73 | |||||||
74 | 8 | 92 | my $html; | ||||
75 | try { | ||||||
76 | 8 | 8 | 328 | $html = $template->process(%{$c->stash}, c => $c, h => $helper); | |||
8 | 33 | ||||||
77 | } | ||||||
78 | catch { | ||||||
79 | 0 | 0 | 0 | my $validator; | |||
80 | 0 | 0 | eval "use XML::Validate; \$validator = XML::Validate->new(Type => 'LibXML');"; | ||||
81 | 0 | 0 | 0 | if ($validator) { | |||
82 | 0 | 0 | $xml =~ s///; | ||||
83 | 0 | 0 | 0 | if ($validator->validate($xml)) { | |||
84 | 0 | 0 | die "Petal::Tiny didn't like the xml in $name, but weirdly XML::Validate did.\n\n$_"; | ||||
85 | } | ||||||
86 | else { | ||||||
87 | 0 | 0 | my $e = $validator->last_error; | ||||
88 | 0 | 0 | 0 | my $message = $e->{message} // ""; | |||
89 | 0 | 0 | die "Petal::Tiny didn't like the xml in $name. XML::Validate reports:\n\n$message"; | ||||
90 | } | ||||||
91 | } | ||||||
92 | else { | ||||||
93 | 0 | 0 | die "Petal::Tiny didn't like the xml in $name. Install XML::Validate and XML::LibXML for better diagnostics.\n\n$_"; | ||||
94 | } | ||||||
95 | 8 | 128 | }; | ||||
96 | |||||||
97 | 8 | 100 | 1751 | if ($deldiv) { | |||
98 | 7 | 36 | $html =~ s,\A ,,; |
||||
99 | 7 | 36 | $html =~ s,\z,,; | ||||
100 | } | ||||||
101 | |||||||
102 | 8 | 56 | return $html; | ||||
103 | } | ||||||
104 | |||||||
105 | 1; | ||||||
106 | |||||||
107 | package | ||||||
108 | Petal::Tiny::_Mojo; | ||||||
109 | |||||||
110 | 2 | 2 | 36 | use Mojo::Base 'Petal::Tiny'; | |||
2 | 4 | ||||||
2 | 19 | ||||||
111 | 2 | 2 | 15604 | use Scalar::Util 'blessed'; | |||
2 | 6 | ||||||
2 | 318 | ||||||
112 | |||||||
113 | sub reftype { | ||||||
114 | 26 | 26 | 5309 | my ($self, $obj) = @_; | |||
115 | 26 | 100 | 100 | 170 | return 'ARRAY' if blessed $obj and $obj->isa('Mojo::Collection'); | ||
116 | 25 | 74 | return $self->SUPER::reftype($obj); | ||||
117 | } | ||||||
118 | |||||||
119 | 1; | ||||||
120 | |||||||
121 | package | ||||||
122 | Mojolicious::Plugin::PetalTinyRenderer::Helper; | ||||||
123 | |||||||
124 | 2 | 2 | 14 | use Mojo::Base -base; | |||
2 | 4 | ||||||
2 | 21 | ||||||
125 | |||||||
126 | our $AUTOLOAD; | ||||||
127 | |||||||
128 | __PACKAGE__->attr('ctx'); | ||||||
129 | |||||||
130 | # stolen from Mojolicious::Plugin::TtRenderer::Helper | ||||||
131 | sub AUTOLOAD { | ||||||
132 | 1 | 1 | 34 | my $self = shift; | |||
133 | |||||||
134 | 1 | 3 | my $method = $AUTOLOAD; | ||||
135 | |||||||
136 | 1 | 50 | 8 | return if $method =~ /^[A-Z]+?$/; | |||
137 | 1 | 50 | 6 | return if $method =~ /^_/; | |||
138 | 1 | 50 | 12 | return if $method =~ /(?:\:*?)DESTROY$/; | |||
139 | |||||||
140 | 1 | 6 | $method = (split '::' => $method)[-1]; | ||||
141 | |||||||
142 | 1 | 50 | 23 | die qq/Unknown helper: $method/ unless $self->ctx->app->renderer->helpers->{$method}; | |||
143 | |||||||
144 | 1 | 76 | return $self->ctx->$method(@_); | ||||
145 | } | ||||||
146 | |||||||
147 | # lifted from http://www.perlmonks.org/?node_id=44911 | ||||||
148 | sub can { | ||||||
149 | 1 | 1 | 9 | my ($self, $method) = @_; | |||
150 | 1 | 11 | my $subref = $self->SUPER::can($method); | ||||
151 | 1 | 50 | 6 | return $subref if $subref; # can found it; it's a real method | |||
152 | |||||||
153 | # Method doesn't currently exist; should it, though? | ||||||
154 | 1 | 50 | 30 | return unless exists $self->ctx->app->renderer->helpers->{$method}; | |||
155 | |||||||
156 | # Return an anon sub that will work when it's eventually called | ||||||
157 | sub { | ||||||
158 | 0 | 0 | my $self = $_[0]; | ||||
159 | |||||||
160 | # The method is being called. The real method may have been | ||||||
161 | # created in the meantime; if so, don't call AUTOLOAD again | ||||||
162 | 0 | my $subref = $self->SUPER::can($method); | |||||
163 | 0 | 0 | goto &$subref if $subref; | ||||
164 | |||||||
165 | 0 | $AUTOLOAD=$method; | |||||
166 | 0 | goto &AUTOLOAD; | |||||
167 | 1 | 119 | }; | ||||
168 | } | ||||||
169 | |||||||
170 | 1; | ||||||
171 | __END__ |