package Template::Multilingual::Parser; use strict; use base qw(Template::Parser); our $VERSION = '1.00'; sub new { my ($class, $options) = @_; my $self = $class->SUPER::new($options); $self->{_sections} = []; $self->{_langvar} = $options->{LANGUAGE_VAR} || 'language'; my $style = $self->{ STYLE }->[-1]; @$self{ qw(_start _end) } = @$style{ qw( START_TAG END_TAG ) }; for (qw( _start _end )) { $self->{$_} =~ s/\\([^\\])/$1/g; } return $self; } sub parse { my ($self, $text) = @_; # isolate multilingual sections $self->_tokenize($text); # replace multilingual sections with TT directives my ($S, $E, $LANGVAR) = map $self->{$_}, qw(_start _end _langvar); # if language is a variant (en_US), create a template variable holding the fallback value (en) $text = "$S IF (tm_matches = $LANGVAR.match('^(\\w+)[-_].*\$')); tm_fb = tm_matches.0; END $E"; for my $section (@{$self->{_sections}}) { if ($section->{nolang}) { $text .= $section->{nolang}; } elsif (my $t = $section->{lang}) { my @languages = keys %$t; # first loop through languages: look for exact match $text .= "$S tm_f = 0; SWITCH $LANGVAR $E"; for my $lang (@languages) { $text .= "$S CASE '$lang' $E" . $t->{$lang}; } # add a default case to trigger fallback $text .= "$S CASE; tm_f=1; END; $E"; # second loop: fallback to primary language (en_US matches en) $text .= "$S IF tm_fb AND tm_f; tm_f=0; SWITCH tm_fb; $E"; for my $lang (@languages) { $text .= "$S CASE '$lang' $E" . $t->{$lang}; } # add a default case to trigger last resort fallback # LANG is fr_XX or fr but template has neither # we try to fallback to fr_YY is present my %seen; my @fallbacks = map { /^(\w+)[-_].*$/ && !$seen{$_}++ ? [ $1 => $_] : () } sort @languages; if (@fallbacks) { # third loop: fallback to first available variant $text .= "$S CASE; tm_f=1; END; END; IF tm_f; SWITCH tm_fb || $LANGVAR; $E"; for my $ref (@fallbacks) { my ($lang, $variant) = @$ref; $text .= "$S CASE '$lang' $E" . $t->{$variant}; } } $text .= "$S END; END $E"; } } return $self->SUPER::parse ($text); } sub _tokenize { my ($self, $text) = @_; # extract all sections from the text $self->{_sections} = []; my @tokens = split m!(.*?)!s, $text; my $i = 0; for my $t (@tokens) { if ($i) { # ... multilingual section my %section; while ($t =~ m!<([^<>]+)>(.*?)!gs) { $section{$1} = $2; } push @{$self->{_sections}}, { lang => \%section } if %section; } else { # bare text push @{$self->{_sections}}, { nolang => $t } if $t; } $i = 1 - $i; } } sub sections { $_[0]->{_sections} } =head1 NAME Template::Multilingual::Parser - Multilingual template parser =head1 SYNOPSIS use Template; use Template::Multilingual::Parser; my $parser = Template::Multilingual::Parser->new(); my $template = Template->new(PARSER => $parser); $template->process('example.ttml', { language => 'en'}); =head1 DESCRIPTION This subclass of Template Toolkit's C parses multilingual templates: templates that contain text in several languages. Hello! Bonjour ! Use this module directly if you have subclassed C