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