lire 2:2.1.1-2.1 / usr / share / perl5 / Lire / I18N.pm

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 - Lire internationalisation class

=head1 SYNOPSIS

 use Lire::I18N

=head1 DESCRIPTION

FIXME

=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*<para>\s*)};
    $para_start ||= '';
    my ($para_end) = $msgid =~ m{(\s*</para>\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 AUTHORS

  Francis J. Lacoste <flacoste@logreport.org>
  Wolfgang Sourdeau <wsourdeau@logreport.org>

=head1 VERSION

$Id: I18N.pm,v 1.26 2008/03/09 19:27:31 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