# -*- perl -*-
#
# HTML::EP - A Perl based HTML extension.
#
#
# Copyright (C) 1998 Jochen Wiedmann
# Am Eisteich 9
# 72555 Metzingen
# Germany
#
# Phone: +49 7123 14887
# Email: joe@ispsoft.de
#
# All rights reserved.
#
# You may distribute this module under the terms of either
# the GNU General Public License or the Artistic License, as
# specified in the Perl README file.
#
############################################################################
require 5.004;
use strict;
use HTML::EP ();
package HTML::EP::Locale;
@HTML::EP::Locale::ISA = qw(HTML::EP);
sub init ($$) {
my $self = shift; my $attr = shift;
return $self->{'_ep_language'} if $self->{'_ep_language'};
$self->SUPER::init();
# Try to guess a language. First try to guess what languages are
# offered.
my @offered;
if ($attr->{'accept-language'}) {
@offered = split(/,/, $attr->{'accept-language'});
}
@offered = ($self->{'_ep_config'}->{'default_language'}, "en")
unless @offered;
# Next, try to guess what the user wants. First let's see, if there
# is a CGI variable 'language'.
my $get;
if (my $lang = $self->{'cgi'}->param('language')) {
foreach my $l (@offered) {
return ($self->{'_ep_language'} = $l) if $l eq $lang;
}
}
# If there's no such CGI variable, look at the value of
# $ENV{'HTTP_ACCEPT_LANGUAGE'}.
if (exists($ENV{'HTTP_ACCEPT_LANGUAGE'})) {
foreach my $lang (split(/\s*,\s*/,
($ENV{'HTTP_ACCEPT_LANGUAGE'} || ''))) {
foreach my $l (@offered) {
return ($self->{'_ep_language'} = $l) if $l eq $lang;
}
}
}
# If anything else fails, choose a default language
return $self->{'_ep_language'} = $offered[0];
}
sub _ep_language {
my($self, $attr, $tokens) = @_;
my $language = $self->{'_ep_language'};
my $debug = $self->{'debug'};
return exists $attr->{$language} ? $attr->{$language} : ''
unless exists $attr->{'language'};
my $level = 0;
my $state = $attr->{'language'} eq $language;
my $state_done = $state;
my $start = $tokens->First() if $state;
my $last;
while (defined(my $token = $tokens->Token())) {
if ($token->{'type'} eq 'S') {
if ($token->{'tag'} eq 'ep-language') {
if ($state) {
$last = $tokens->First()-1;
$state = 0;
} elsif (!$state_done) {
my $at = $self->ParseAttr($token->{'attr'});
if ($state = ($at->{'language'} eq $language)) {
$start = $tokens->First();
$state_done = 1;
}
}
}
} elsif ($token->{'type'} eq 'E') {
if ($token->{'tag'} eq 'ep-language') {
return '' unless $state_done;
$last = $tokens->First()-1 if $state;
return $self->TokenMarch($tokens->Clone($start, $last));
}
}
}
die "ep-language without /ep-language";
}
sub _format_DM {
my $self = shift; my $str = shift;
$str = sprintf("%.2f DM", $str);
while ($str =~ s/(\d)(\d\d\d[\.\s])/$1 $2/) {
}
$str =~ s/\./,/;
$str;
}
sub _format_Dollar {
my $self = shift; my $str = shift;
$str = sprintf("%.2f \$", $str);
while ($str =~ s/(\d)(\d\d\d[,\s])/$1 $2/) {
}
$str;
}
sub _format_TIME {
my $self = shift; my $date = shift;
if ($self->{'_ep_language'} eq 'de') {
# Sun, 7 Feb 1999 18:17:57 +0100
if ($date =~ m{(\S+),\s+
(\d+)\s+
(\S+)\s+
(\d+)\s+
(\d+\:\d+\:\d+)\s+
(\+\d+)}x) {
my %wdays = ('sun' => 0, 'mon' => 1, 'tue' => 2,
'wed' => 3, 'thu' => 4, 'fri' => 5,
'sat' => 6);
my $wday = (('Sonntag', 'Montag', 'Dienstag', 'Mittwoch',
'Donnerstag', 'Freitag', 'Samstag')[$wdays{lc $1}]);
my %months = ('jan' => 0, 'feb' => 1, 'mar' => 2,
'apr' => 3, 'may' => 4, 'jun' => 5,
'jul' => 6, 'aug' => 7, 'sep' => 8,
'oct' => 9, 'nov' => 10, 'dec' => 12
);
my $mon = (('Januar', 'Februar', 'März', 'April', 'Mai', 'Juni',
'Juli', 'August', 'September', 'Oktober', 'November',
'Dezember')[$months{lc $3}]);
$date = "$wday, den $2. $mon $4, $5 Uhr ($6)";
}
}
$date;
}
1;