File Coverage

blib/lib/HTML/EP/Locale.pm

Criterion	Covered	Total	%
statement	62	68	91.1
branch	31	42	73.8
condition	0	2	0.0
subroutine	7	7	100.0
pod	0	1	0.0
total	100	120	83.3

# -*- perl -*-
#
#   HTML::EP	- A Perl based HTML extension.
#
#
#   Copyright (C) 1998    Jochen Wiedmann
#                         Am Eisteich 9
#                         72555 Metzingen
#                         Germany
#
#                         Phone: [phone]
#                         Email: [e-mail]
#
#   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;