package Lire::I18N; use strict; use base qw/ Exporter /; use Carp; use Locale::Messages qw/ bindtextdomain /; use vars qw/ $USE_ENCODING @EXPORT_OK /; BEGIN { @EXPORT_OK = qw/ set_fh_encoding ensure_utf8 local_codeset ensure_local_codeset mark_unicode bindtextdomain dgettext dgettext_para /; eval { use File::Temp qw/tempfile/; my $fh = tempfile(); binmode( $fh, ":utf8" ) or die( "encoding layer unavailable: $!" ); require Encode; require I18N::Langinfo; Encode->import( qw/ encode is_utf8 _utf8_on resolve_alias / ); }; $USE_ENCODING = ! $@; } use Lire::Utils qw/ check_param /; =pod =head1 NAME Lire::I18N =head1 SYNOPSIS FIXME =head1 DESCRIPTION FIXME =head1 FUNCTIONS =cut sub set_fh_encoding { my ( $fh, $encoding ) = @_; check_param( $fh, 'fh' ); check_param( $encoding, 'encoding' ); return unless $USE_ENCODING; return unless resolve_alias( $encoding ) ne local_codeset(); binmode( $fh, ":encoding($encoding)" ) or croak "error setting encoding on FH: $!"; } sub ensure_utf8 { my $string = $_[0]; return undef unless defined $string; return escape_8bits( $_[0] ) unless $USE_ENCODING; if ( is_utf8( $string ) ) { return $string; } elsif( local_codeset() eq 'utf8' ) { _utf8_on( $string ); return $string; } else{ my $rs = encode( 'utf8', $string ); _utf8_on( $rs ); return $rs; } } sub local_codeset { my $string = $_[0]; my $codeset = eval { resolve_alias( I18N::Langinfo::langinfo( I18N::Langinfo::CODESET() ) ) }; return $codeset ? $codeset : 'ISO-8859-1'; } sub ensure_local_codeset { my $string = $_[0]; return undef unless defined $string; return $string unless $USE_ENCODING && is_utf8( $string ); return encode( local_codeset(), $string ); } sub escape_8bits { my $string = $_[0]; return undef unless defined $string; $string =~ tr/[\x80-\xFF]/?/; # String may be UTF-8 encoded and thus # contain pointcodes above 255 # \x{FFFE} and \x{FFFF} are invalid UTF-8 # characters use utf8; # Required for 5.6 $string =~ s/[\x{100}-\x{FFFD}]/?/g; return $string; } sub mark_unicode { my $string = $_[0]; return undef unless defined $string; return $string unless $USE_ENCODING; _utf8_on( $string ) unless is_utf8( $string ); return $string; } sub dgettext { my ( $domain, $msgid ) = @_; check_param( $domain, 'domain' ); return Locale::Messages::dgettext( $domain, ensure_local_codeset( $msgid ) ); } sub dgettext_para { my ( $domain, $msgid ) = @_; check_param( $domain, 'domain' ); return undef unless defined $msgid; my ($para_start) = $msgid =~ m{^(\s*\s*)}; $para_start ||= ''; my ($para_end) = $msgid =~ m{(\s*\s*)$}; $para_end ||= ''; my $end = -length( $para_end ) || length( $msgid ); my $string = substr( $msgid, length( $para_start ), $end ); return $para_start . dgettext( $domain, $string ) . $para_end; } # keep perl happy 1; __END__ =head1 SEE ALSO FIXME =head1 AUTHORS Francis J. Lacoste Wolfgang Sourdeau =head1 VERSION $Id: I18N.pm,v 1.25 2006/07/23 13:16:29 vanbaal Exp $ =head1 COPYRIGHT Copyright (C) 2004 Stichting LogReport Foundation LogReport@LogReport.org This file is part of Lire. Lire is free software; you can redistribute it and/or modify it under the terms of the GNU General Public License as published by the Free Software Foundation; either version 2 of the License, or (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program (see COPYING); if not, check with http://www.gnu.org/copyleft/gpl.html. =cut