File Coverage

blib/lib/Plack/Middleware/WOVN.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             package Plack::Middleware::WOVN;
2 2     2   51193 use strict;
  2         4  
  2         59  
3 2     2   8 use warnings;
  2         3  
  2         57  
4 2     2   8 use utf8;
  2         6  
  2         10  
5 2     2   998 use parent 'Plack::Middleware';
  2         562  
  2         10  
6              
7             our $VERSION = '0.09';
8              
9             require bytes;
10              
11 2     2   25072 use HTML::HTML5::Parser;
  0            
  0            
12             use HTML::HTML5::Writer;
13             use Mojo::URL;
14             use Plack::Util;
15             use Plack::Util::Accessor qw( settings );
16             use URI::Escape;
17             use XML::LibXML;
18              
19             use Plack::Middleware::WOVN::Headers;
20             use Plack::Middleware::WOVN::Lang;
21             use Plack::Middleware::WOVN::Store;
22              
23             our $STORE;
24              
25             sub prepare_app {
26             my $self = shift;
27             $STORE = Plack::Middleware::WOVN::Store->new(
28             { settings => $self->settings } );
29             }
30              
31             sub call {
32             my ( $self, $env ) = @_;
33              
34             unless ( $STORE->is_valid_settings ) {
35             return $self->app->($env);
36             }
37              
38             my $headers
39             = Plack::Middleware::WOVN::Headers->new( $env, $STORE->settings );
40             if ( $STORE->settings->{test_mode}
41             && $STORE->settings->{test_url} ne $headers->url )
42             {
43             return $self->app->($env);
44             }
45              
46             if ( $headers->path_lang eq $STORE->settings->{default_lang} ) {
47             my $redirect_headers
48             = $headers->redirect( $STORE->settings->{default_lang} );
49             return [ 307, [%$redirect_headers], [''] ];
50             }
51             my $lang = $headers->lang_code;
52              
53             my $res = $self->app->( $headers->request_out );
54             Plack::Util::response_cb(
55             $res,
56             sub {
57             my $res = shift;
58              
59             sub {
60             my $body_chunk = shift or return;
61             my $status = $res->[0];
62             my $res_headers = $res->[1];
63              
64             if (( Plack::Util::header_get( $res_headers,
65             'Content-Type' )
66             || ''
67             ) =~ /html/
68             )
69             {
70             my $values = $STORE->get_values( $headers->redis_url );
71             my $url = {
72             protocol => $headers->protocol,
73             host => $headers->host,
74             pathname => $headers->pathname,
75             };
76             $body_chunk
77             = switch_lang( $body_chunk, $values, $url, $lang,
78             $headers )
79             unless $status =~ /^1|302/;
80             }
81              
82             Plack::Util::header_set( $res_headers, 'Content-Length',
83             bytes::length $body_chunk );
84              
85             $body_chunk;
86             };
87             }
88             );
89             }
90              
91             sub add_lang_code {
92             my ( $href, $pattern, $lang, $headers ) = @_;
93             return $href if $href =~ /^(#.*)?$/;
94              
95             my $new_href = $href;
96             my $lc_lang = lc $lang;
97              
98             if ( $href && lc($href) =~ /^(https?:)?\/\// ) {
99             my $uri = eval { Mojo::URL->new($href) } or return $new_href;
100              
101             if ( lc $uri->host eq lc $headers->host ) {
102             if ( $pattern eq 'subdomain' ) {
103             my $sub_d = $href =~ /\/\/([^\.]*)\./ ? $1 : '';
104             my $sub_code
105             = Plack::Middleware::WOVN::Lang->get_code($sub_d);
106             if ( $sub_code && lc $sub_code eq $lc_lang ) {
107             $new_href =~ s/$lang/$lc_lang/i;
108             }
109             else {
110             $new_href =~ s/(\/\/)([^\.]*)/$1$lc_lang\.$2/;
111             }
112             }
113             elsif ( $pattern eq 'query' ) {
114             if ( $href =~ /\?/ ) {
115             $new_href = "$href&wovn=$lang";
116             }
117             else {
118             $new_href = "$href?wovn=$lang";
119             }
120             }
121             else {
122             $new_href =~ s/([^\.]*\.[^\/]*)(\/|$)/$1$lang/;
123             }
124             }
125             }
126             elsif ($href) {
127             if ( $pattern eq 'subdomain' ) {
128             my $lang_url
129             = $headers->protocol . '://'
130             . $lc_lang . '.'
131             . $headers->host;
132             my $current_dir = $headers->pathname;
133             $current_dir =~ s/[^\/]*\.[^\.]{2,6}$//;
134             if ( $href =~ /^\.\..*$/ ) {
135             $new_href =~ s/^(\.\.\/)+//;
136             $new_href = $lang_url . '/' . $new_href;
137             }
138             elsif ( $href =~ /^\..*$/ ) {
139             $new_href =~ s/^(\.\/)+//;
140             $new_href = $lang_url . $current_dir . '/' . $new_href;
141             }
142             elsif ( $href =~ /^\/.*$/ ) {
143             $new_href = $lang_url . $href;
144             }
145             else {
146             $new_href = $lang_url . $current_dir . '/' . $href;
147             }
148             }
149             elsif ( $pattern eq 'query' ) {
150             if ( $href =~ /\?/ ) {
151             $new_href = "$href&wovn=$lang";
152             }
153             else {
154             $new_href = "$href?wovn=$lang";
155             }
156             }
157             else {
158             if ( $href =~ /^\// ) {
159             $new_href = '/' . $lang . $href;
160             }
161             else {
162             my $current_dir = $headers->pathname;
163             $current_dir =~ s/[^\/]*\.[^\.]{2,6}$//;
164             $new_href = '/' . $lang . $current_dir . $href;
165             }
166             }
167             }
168              
169             $new_href;
170             }
171              
172             sub check_wovn_ignore {
173             my $node = shift;
174             if ( !$node->isa('XML::LibXML::Text') ) {
175             if ( defined $node->getAttribute('wovn-ignore') ) {
176             $node->setAttribute( 'wovn-ignore', '' )
177             if $node->getAttribute('wovn-ignore') eq 'wovn-ignore';
178             return 1;
179             }
180             elsif ( $node->nodeName eq 'html' ) {
181             return 0;
182             }
183             }
184             if ( !$node->getParentNode ) {
185             return 0;
186             }
187             check_wovn_ignore( $node->getParentNode );
188             }
189              
190             sub switch_lang {
191             my ( $body, $values, $url, $lang, $headers ) = @_;
192             $lang ||= $STORE->settings->{'default_lang'};
193             $lang = Plack::Middleware::WOVN::Lang->get_code($lang);
194             my $text_index = $values->{text_vals} || {};
195             my $src_index = $values->{img_vals} || {};
196             my $img_src_prefix = $values->{img_src_prefix} || '';
197             my $string_index = {};
198              
199             my $tree = HTML::HTML5::Parser->load_html( string => $body );
200             $tree->setEncoding('UTF-8');
201              
202             my $writer = HTML::HTML5::Writer->new(
203             quote_attributes => 1,
204             voids => 1,
205             start_tags => 1,
206             end_tags => 1
207             );
208              
209             if ( $tree->documentElement->hasAttribute('wovn-ignore') ) {
210             $body =~ s/href="([^"]*)"/"href=\"".uri_unescape($1)."\""/eg;
211             return $body;
212             }
213              
214             if ( $lang ne $STORE->settings->{default_lang} ) {
215             for my $node ( $tree->findnodes("//*[local-name()='a']") ) {
216             next if check_wovn_ignore($node);
217             my $href = $node->getAttribute('href');
218             my $new_href
219             = add_lang_code( $href, $STORE->settings->{url_pattern},
220             $lang, $headers );
221             $node->setAttribute( 'href', $new_href );
222             }
223             }
224              
225             for my $node ( $tree->findnodes('//text()') ) {
226             next if check_wovn_ignore($node);
227             my $node_text = $node->getValue;
228             $node_text =~ s/^\s+|\s+$//g;
229             if ( $text_index->{$node_text}
230             && $text_index->{$node_text}{$lang}
231             && @{ $text_index->{$node_text}{$lang} } )
232             {
233             my $data = $text_index->{$node_text}{$lang}[0]{data};
234             my $content = $node->getValue;
235             $content =~ s/^(\s*)[\S\s]*(\s*)$/$1$data$2/g;
236             $node->setData($content);
237             }
238             }
239              
240             for my $node ( $tree->findnodes("//*[local-name()='meta']") ) {
241             next if check_wovn_ignore($node);
242             next
243             if ( $node->getAttribute('name')
244             || $node->getAttribute('property')
245             || '' )
246             !~ /^(description|title|og:title|og:description|twitter:title|twitter:description)$/;
247              
248             my $node_content = $node->getAttribute('content');
249             $node_content =~ s/^\s+\|\s+$//g;
250             if ( $text_index->{$node_content}
251             && $text_index->{$node_content}{$lang}
252             && @{ $text_index->{$node_content}{$lang} } )
253             {
254             my $data = $text_index->{$node_content}{$lang}[0]{data};
255             my $content = $node->getAttribute('content');
256             $content =~ s/^(\s*)[\S\s]*(\s*)$/$1$data$2/g;
257             $node->setAttribute( 'content', $content );
258             }
259             }
260              
261             for my $node ( $tree->findnodes("//*[local-name()='img']") ) {
262             next if check_wovn_ignore($node);
263             if ( lc( $writer->element($node) ) =~ /src=['"]([^'"]*)['"]/ ) {
264             my $src = $1;
265             if ( $src !~ /:\/\// ) {
266             if ( $src =~ /^\// ) {
267             $src = $url->{protocol} . '://' . $url->{host} . $src;
268             }
269             else {
270             $src
271             = $url->{protocol} . '://'
272             . $url->{host}
273             . $url->{path}
274             . $src;
275             }
276             }
277              
278             if ( $src_index->{$src}
279             && $src_index->{$src}{$lang}
280             && @{ $src_index->{$src}{$lang} } )
281             {
282             $node->setAttribute( 'src',
283             $img_src_prefix . $src_index->{$src}{$lang}[0]{data} );
284             }
285             }
286             if ( my $alt = $node->getAttribute('alt') ) {
287             $alt =~ s/^\s+|\s+$//g;
288             if ( $text_index->{$alt}
289             && $text_index->{$alt}{$lang}
290             && @{ $text_index->{$alt}{$lang} } )
291             {
292             my $data = $text_index->{$alt}{$lang}[0]{data};
293             $alt =~ s/^(\s*)[\S\s]*(\s*)$/$1$data$2/g;
294             $node->setAttribute( 'alt', $alt );
295             }
296             }
297             }
298              
299             for my $node ( $tree->findnodes("//*[local-name()='script']") ) {
300             if ( $node->getAttribute('src')
301             && $node->getAttribute('src')
302             =~ /\/\/j.(dev-)?wovn.io(:3000)?\// )
303             {
304             $node->getParentNode->removeChild($node);
305             }
306             }
307              
308             my ($parent_node) = $tree->getElementsByTagName('head');
309             ($parent_node) = $tree->getElementByTagName('body') unless $parent_node;
310             $parent_node = $tree->doucmentElement unless $parent_node;
311              
312             {
313             my $insert_node = XML::LibXML::Element->new('script');
314             $insert_node->setAttribute( 'src', '//j.wovn.io/1' );
315             $insert_node->setAttribute( 'async', 'true' );
316             my $data_wovnio
317             = 'key='
318             . $STORE->settings->{user_token}
319             . '&backend=true¤tLang='
320             . $lang
321             . '&defaultLang='
322             . $STORE->settings->{default_lang}
323             . '&urlPattern='
324             . $STORE->settings->{url_pattern}
325             . '&version='
326             . $VERSION;
327             $insert_node->setAttribute( 'data-wovnio', $data_wovnio );
328             $insert_node->appendText(' ');
329             $parent_node->insertBefore( $insert_node, $parent_node->firstChild );
330             }
331              
332             for my $l ( get_langs($values) ) {
333             my $insert_node = XML::LibXML::Element->new('link');
334             $insert_node->setAttribute( 'rel', 'alternate' );
335             $insert_node->setAttribute( 'hreflang', $l );
336             $insert_node->setAttribute( 'href', $headers->redirect_location($l) );
337             $parent_node->appendChild($insert_node);
338             }
339              
340             my $html = $tree->documentElement;
341             $html->setAttribute( 'lang', $lang ) if $html;
342              
343             my $new_body = $writer->document($tree);
344             $new_body =~ s/href="([^"]*)"/'href="'.uri_unescape($1).'"'/eg;
345              
346             $new_body;
347             }
348              
349             sub get_langs {
350             my $values = shift;
351             my %langs;
352             my %merged
353             = ( %{ $values->{text_vals} || {} }, %{ $values->{img_vals} || {} } );
354             for my $index ( values %merged ) {
355             for my $key ( keys %{ $index || {} } ) {
356             $langs{$key} = 1;
357             }
358             }
359             keys %langs;
360             }
361              
362             1;
363              
364             __END__