package Packages::Template; use strict; use warnings; use Template; use URI (); use HTML::Entities (); use URI::Escape (); use Benchmark ':hireswallclock'; use Packages::CGI; use Packages::Config qw( @LANGUAGES ); use Packages::I18N::Locale; use Packages::I18N::Languages; use Packages::I18N::LanguageNames; our @ISA = qw( Exporter ); #our @EXPORT = qw( head ); use constant COMPILE => 1; sub new { my ($classname, $include, $format, $vars, $options) = @_; $vars ||= {}; $options ||= {}; my $self = {}; bless( $self, $classname ); my @timestamp = gmtime; $vars->{timestamp} = { year => $timestamp[5]+1900, string => scalar gmtime() .' UTC', }; $vars->{make_search_url} = sub { return &Packages::CGI::make_search_url(@_) }; $vars->{make_url} = sub { return &Packages::CGI::make_url(@_) }; $vars->{g} = sub { my ($f, @a) = @_; return sprintf($f, @a); }; if ($vars->{cat}) { $vars->{g} = sub { return Packages::I18N::Locale::g($vars->{cat}, @_) }; } $vars->{extract_host} = sub { my $uri_str = $_[0]; my $uri = URI->new($uri_str); if ($uri->can('host')) { my $host = $uri->host; $host .= ':'.$uri->port if $uri->port != $uri->default_port; return $host; } return $uri_str; }; # needed to work around the limitations of the the FILTER syntax $vars->{html_encode} = sub { return HTML::Entities::encode_entities(@_,'<>&"') }; $vars->{uri_escape} = sub { return URI::Escape::uri_escape(@_) }; $vars->{quotemeta} = sub { return quotemeta($_[0]) }; $vars->{string2id} = sub { return &Packages::CGI::string2id(@_) }; $self->{template} = Template->new( { PRE_PROCESS => [ 'config.tmpl' ], INCLUDE_PATH => $include, VARIABLES => $vars, COMPILE_EXT => '.ttc', %$options, } ) or die sprintf( "Initialization of Template Engine failed: %s", $Template::ERROR ); $self->{format} = $format; $self->{vars} = $vars; return $self; } sub process { my $self = shift; return $self->{template}->process(@_); } sub error { my $self = shift; return $self->{template}->error(@_); } sub page { my ($self, $action, $page_content, $target) = @_; #use Data::Dumper; #die Dumper($self, $action, $page_content); if ($page_content->{cat}) { $page_content->{g} = sub { return Packages::I18N::Locale::g($page_content->{cat}, @_) }; } $page_content->{used_langs} ||= \@LANGUAGES; $page_content->{langs} = languages( $page_content->{po_lang} || $self->{vars}{po_lang} || 'en', $page_content->{ddtp_lang} || $self->{vars}{ddtp_lang} || 'en', @{$page_content->{used_langs}} ); my $txt; if ($target) { $self->process("$self->{format}/$action.tmpl", $page_content, $target) or die sprintf( "template error: %s", $self->error ); # too late for reporting on-line } else { $self->process("$self->{format}/$action.tmpl", $page_content, \$txt) or die sprintf( "template error: %s", $self->error ); } return $txt; } sub error_page { my ($self, $page_content) = @_; # use Data::Dumper; # warn Dumper($page_content); my $txt; $self->process("html/error.tmpl", $page_content, \$txt) or die sprintf( "template error: %s", $self->error ); # too late for reporting on-line return $txt; } sub languages { my ( $po_lang, $ddtp_lang, @used_langs ) = @_; my $cat = Packages::I18N::Locale->get_handle($po_lang, 'en'); my @langs; my $skip_lang = ($po_lang eq $ddtp_lang) ? $po_lang : ''; if (@used_langs) { my @printed_langs = (); foreach (@used_langs) { next if $_ eq $skip_lang; # Don't print the current language unless (get_selfname($_)) { warn "missing language selfname $_"; next } #DEBUG unless (get_language_name($_)) { warn "missing language name $_"; next } #DEBUG push @printed_langs, $_; } return [] unless scalar @printed_langs; # Sort on uppercase to work with languages which use lowercase initial # letters. foreach my $cur_lang (sort langcmp @printed_langs) { my %lang; $lang{lang} = $cur_lang; $lang{tooltip} = $cat->g(get_language_name($cur_lang)); $lang{selfname} = get_selfname($cur_lang); $lang{transliteration} = get_transliteration($cur_lang) if defined get_transliteration($cur_lang); push @langs, \%lang; } } return \@langs; } 1;