Attachment #61873 for bug #15395

View | Details | Raw Unified | Return to bug 15395
Collapse All | Expand All




        required   => 1,
        min_ver    => '2.125',
    },
    'Locale::Messages' => {
        'usage'    => 'Core',
        'required' => '1',
        'min_ver'  => '1.20',
    },
    'Locale::Maketext::Lexicon' => {
        'usage'    => 'Core',
        'required' => '1',
        'min_ver'  => '0.91',
    },
    'LWP::Protocol::https' => {
        'usage'    => 'OverDrive integration',




# along with Koha; if not, see <http://www.gnu.org/licenses>.

use Modern::Perl;
use base qw(Locale::Maketext Exporter);

use CGI;
use C4::Languages;
use C4::Context;

use Encode;
use Locale::Util qw(set_locale);
use Locale::Messages qw(:locale_h :libintl_h nl_putenv);
        Gettext =>
            C4::Context->config('intranetdir')
            . '/misc/translator/po/*-messages.po'
    ],
    '_AUTO' => 1,
    '_style' => 'gettext',
};

use parent 'Exporter';
our @EXPORT = qw(
    __
    __x
    __n
    __nx
    __xn
    __p
    __px
    __np
    __npx
    N__
    N__n
    N__p
    N__np
);

my $textdomain;

BEGIN {
    $textdomain = 'Koha';
    my $language = C4::Languages::getlanguage;

    my $langtag = C4::Languages::getlanguage;
    my @subtags = split /-/, $langtag;
    my ($language, $region) = @subtags;
    if ($region && length $region == 4) {
        $region = $subtags[2];
    }
    my $locale = set_locale(LC_ALL, $language, $region, 'utf-8');
    unless ($locale) {
        set_locale(LC_MESSAGES, 'C');
        Locale::Messages->select_package('gettext_pp');
        $locale = $language;
        if ($region) {
            $locale .= '_' . $region;
        }
        nl_putenv("LANGUAGE=$locale");
        nl_putenv("LANG=$locale");
        nl_putenv('OUTPUT_CHARSET=utf-8');
    }

    my $directory = C4::Context->config('intranetdir') . '/misc/translator/po';
    textdomain($textdomain);
    bindtextdomain($textdomain, $directory);
}

sub __ {
    my ($msgid) = @_;
    my $text = dgettext($textdomain, $msgid);
    return __decode($text);
}

sub __x {
    my ($msgid, %vars) = @_;
    return __expand(__($msgid), %vars);
}

sub __n {
    my ($msgid, $msgid_plural, $count) = @_;
    my $text = dngettext($textdomain, $msgid, $msgid_plural, $count);
    return __decode($text);
}

sub __nx {
    my ($msgid, $msgid_plural, $count, %vars) = @_;
    return __expand(__n($msgid, $msgid_plural, $count), %vars);
}

sub __xn {
    return __nx(@_);
}

sub __p {
    my ($msgctxt, $msgid) = @_;
    my $text = dpgettext($textdomain, $msgctxt, $msgid);
    return __decode($text);
}

sub __px {
    my ($msgctxt, $msgid, %vars) = @_;
    return __expand(__p($msgctxt, $msgid), %vars);
}

sub __np {
    my ($msgctxt, $msgid, $msgid_plural, $count) = @_;
    my $text = dnpgettext($textdomain, $msgctxt, $msgid, $msgid_plural, $count);
    return __decode($text);
}

sub __npx {
    my ($msgctxt, $msgid, $msgid_plural, $count, %vars) = @_;
    return __expand(__np($msgctxt, $msgid, $msgid_plural, $count), %vars);
}

sub N__ {
    return @_;
}

sub N__n {
    return @_;
}

sub N__p {
    return @_;
}

sub N__np {
    return @_;
}

sub __expand {
    my ($text, %vars) = @_;

    my $re = join '|', map { quotemeta $_ } keys %vars;
    $text =~ s/\{($re)\}/defined $vars{$1} ? $vars{$1} : "{$1}"/ge;

    return $text;
}

sub __decode {
    return Encode::decode_utf8(shift);
    $lh->maketext(@_);
}

1;




use YAML::Syck qw( Dump LoadFile );
use Locale::PO;
use FindBin qw( $Bin );
use File::Path qw( make_path );

$YAML::Syck::ImplicitTyping = 1;


    $self->{process}         = "$Bin/tmpl_process3.pl " . ($verbose ? '' : '-q');
    $self->{path_po}         = "$Bin/po";
    $self->{po}              = { '' => $default_pref_po_header };
    $self->{domain}          = 'Koha';
    $self->{cp}              = `which cp`;
    $self->{msgmerge}        = `which msgmerge`;
    $self->{msgfmt}          = `which msgfmt`;
    $self->{xgettext}        = `which xgettext`;
    $self->{sed}             = `which sed`;
    chomp $self->{cp};
    chomp $self->{msgmerge};
    chomp $self->{msgfmt};
    chomp $self->{xgettext};
    chomp $self->{sed};


sub create_messages {
    my $self = shift;

    my ($language, $country) = split /-/, $self->{lang};
    my $locale = $language;
    if ($country) {
        $locale .= '_' . $country;
    }
    my $podir = "$self->{path_po}/$locale/LC_MESSAGES";

    make_path($podir);
    say "Create messages ($locale)" if $self->{verbose};
    system
        "$self->{cp} $self->{domain}.pot " .
        "$podir/$self->{domain}.po";
}

sub update_messages {
    my $self = shift;

    my ($language, $country) = split /-/, $self->{lang};
    my $locale = $language;
    if ($country) {
        $locale .= '_' . $country;
    }
    my $podir = "$self->{path_po}/$locale/LC_MESSAGES";
    my $pofile = "$podir/$self->{domain}.po";

    say "Update messages ($locale)" if $self->{verbose};
    if ( not -f $pofile ) {
        say "File $pofile does not exist" if $self->{verbose};
        $self->create_messages();
    }
    system "$self->{msgmerge} -U $pofile $self->{domain}.pot";

        }
    }

    my $xgettext_cmd = "$self->{xgettext} -L Perl --from-code=UTF-8 "
        . "-k -k__ -k__x -k__n:1,2 -k__nx:1,2 -k__xn:1,2 -k__p:1c,2 "
        . "-k__px:1c,2 -k__np:1c,2,3 -k__npx:1c,2,3 -kN__ -kN__n:1,2 "
        . "-kN__p:1c,2 -kN__np:1c,2,3 "
        . "-o $Bin/$self->{domain}.pot -D $intranetdir";
    $xgettext_cmd .= " $_" foreach (@files_to_scan);

    if (system($xgettext_cmd) != 0) {

            die "system call failed: $replace_charset_cmd";
        }
    } else {
        say "No messages found" if $self->{verbose};
        return;
    }
    return 1;
}

sub install_messages {
    my ($self) = @_;

    my ($language, $country) = split /-/, $self->{lang};
    my $locale = $language;
    if ($country) {
        $locale .= '_' . $country;
    }
    my $podir = "$self->{path_po}/$locale/LC_MESSAGES";
    my $pofile = "$podir/$self->{domain}.po";
    my $mofile = "$podir/$self->{domain}.mo";

    say "Install messages ($locale)" if $self->{verbose};
    if ( not -f $pofile ) {
        say "File $pofile does not exist" if $self->{verbose};
        $self->create_messages();
    }
    system "$self->{msgfmt} -o $mofile $pofile";
}

sub remove_pot {
    my $self = shift;


    return unless $self->{lang};
    $self->install_tmpl($files) unless $self->{pref_only};
    $self->install_prefs();
    $self->install_messages();
}


- 

Return to bug 15395

Lines 717-731 our $PERL_DEPS = { Link Here

(-)a/C4/Installer/PerlDependencies.pm (-7 / +2 lines)
717	required => 1,	717	required => 1,
718	min_ver => '2.125',	718	min_ver => '2.125',
719	},	719	},
720	'Locale::Maketext' => {	720	'Locale::Messages' => {
721	'usage' => 'Core',	721	'usage' => 'Core',
722	'required' => '1',	722	'required' => '1',
723	'min_ver' => '1.19',	723	'min_ver' => '1.20',
724	},
725	'Locale::Maketext::Lexicon' => {
726	'usage' => 'Core',
727	'required' => '1',
728	'min_ver' => '0.91',
729	},	724	},
730	'LWP::Protocol::https' => {	725	'LWP::Protocol::https' => {
731	'usage' => 'OverDrive integration',	726	'usage' => 'OverDrive integration',

Lines 18-58 package Koha::I18N; Link Here

(-)a/Koha/I18N.pm (-23 / +118 lines)
18	# along with Koha; if not, see <http://www.gnu.org/licenses>.	18	# along with Koha; if not, see <http://www.gnu.org/licenses>.
19		19
20	use Modern::Perl;	20	use Modern::Perl;
21	use base qw(Locale::Maketext Exporter);
22		21
23	use CGI;	22	use CGI;
24	use C4::Languages;	23	use C4::Languages;
		24	use C4::Context;
25		25
26	use Locale::Maketext::Lexicon {	26	use Encode;
27	'en' => ['Auto'],	27	use Locale::Util qw(set_locale);
28	'*' => [	28	use Locale::Messages qw(:locale_h :libintl_h nl_putenv);
29	Gettext =>
30	C4::Context->config('intranetdir')
31	. '/misc/translator/po/*-messages.po'
32	],
33	'_AUTO' => 1,
34	'_style' => 'gettext',
35	};
36		29
37	our @EXPORT = qw( gettext );	30	use parent 'Exporter';
		31	our @EXPORT = qw(
		32	__
		33	__x
		34	__n
		35	__nx
		36	__xn
		37	__p
		38	__px
		39	__np
		40	__npx
		41	N__
		42	N__n
		43	N__p
		44	N__np
		45	);
38		46
39	my %language_handles;	47	my $textdomain;
40		48
41	sub get_language_handle {	49	BEGIN {
42	my $cgi = new CGI;	50	$textdomain = 'Koha';
43	my $language = C4::Languages::getlanguage;
44		51
45	if (not exists $language_handles{$language}) {	52	my $langtag = C4::Languages::getlanguage;
46	$language_handles{$language} = __PACKAGE__->get_handle($language)	53	my @subtags = split /-/, $langtag;
47	or die "No language handle for '$language'";	54	my ($language, $region) = @subtags;
		55	if ($region && length $region == 4) {
		56	$region = $subtags[2];
48	}	57	}
		58	my $locale = set_locale(LC_ALL, $language, $region, 'utf-8');
		59	unless ($locale) {
		60	set_locale(LC_MESSAGES, 'C');
		61	Locale::Messages->select_package('gettext_pp');
		62	$locale = $language;
		63	if ($region) {
		64	$locale .= '_' . $region;
		65	}
		66	nl_putenv("LANGUAGE=$locale");
		67	nl_putenv("LANG=$locale");
		68	nl_putenv('OUTPUT_CHARSET=utf-8');
		69	}
		70
		71	my $directory = C4::Context->config('intranetdir') . '/misc/translator/po';
		72	textdomain($textdomain);
		73	bindtextdomain($textdomain, $directory);
		74	}
		75
		76	sub __ {
		77	my ($msgid) = @_;
		78	my $text = dgettext($textdomain, $msgid);
		79	return __decode($text);
		80	}
		81
		82	sub __x {
		83	my ($msgid, %vars) = @_;
		84	return __expand(__($msgid), %vars);
		85	}
		86
		87	sub __n {
		88	my ($msgid, $msgid_plural, $count) = @_;
		89	my $text = dngettext($textdomain, $msgid, $msgid_plural, $count);
		90	return __decode($text);
		91	}
		92
		93	sub __nx {
		94	my ($msgid, $msgid_plural, $count, %vars) = @_;
		95	return __expand(__n($msgid, $msgid_plural, $count), %vars);
		96	}
		97
		98	sub __xn {
		99	return __nx(@_);
		100	}
		101
		102	sub __p {
		103	my ($msgctxt, $msgid) = @_;
		104	my $text = dpgettext($textdomain, $msgctxt, $msgid);
		105	return __decode($text);
		106	}
		107
		108	sub __px {
		109	my ($msgctxt, $msgid, %vars) = @_;
		110	return __expand(__p($msgctxt, $msgid), %vars);
		111	}
		112
		113	sub __np {
		114	my ($msgctxt, $msgid, $msgid_plural, $count) = @_;
		115	my $text = dnpgettext($textdomain, $msgctxt, $msgid, $msgid_plural, $count);
		116	return __decode($text);
		117	}
		118
		119	sub __npx {
		120	my ($msgctxt, $msgid, $msgid_plural, $count, %vars) = @_;
		121	return __expand(__np($msgctxt, $msgid, $msgid_plural, $count), %vars);
122	}
123
124	sub N__ {
125	return @_;
126	}
127
128	sub N__n {
129	return @_;
130	}
131
132	sub N__p {
133	return @_;
134	}
135
136	sub N__np {
137	return @_;
138	}
139
140	sub __expand {
141	my ($text, %vars) = @_;
142
143	my $re = join '\|', map { quotemeta $_ } keys %vars;
144	$text =~ s/\{($re)\}/defined $vars{$1} ? $vars{$1} : "{$1}"/ge;
49		145
50	return $language_handles{$language};	146	return $text;
51	}	147	}
52		148
53	sub gettext {	149	sub __decode {
54	my $lh = get_language_handle;	150	return Encode::decode_utf8(shift);
55	$lh->maketext(@_);
56	}	151	}
57		152
58	1;	153	1;

Lines 25-30 use C4::Context; Link Here

(-)a/misc/translator/LangInstaller.pm (-10 / +51 lines)
25	use YAML::Syck qw( Dump LoadFile );	25	use YAML::Syck qw( Dump LoadFile );
26	use Locale::PO;	26	use Locale::PO;
27	use FindBin qw( $Bin );	27	use FindBin qw( $Bin );
		28	use File::Path qw( make_path );
28		29
29	$YAML::Syck::ImplicitTyping = 1;	30	$YAML::Syck::ImplicitTyping = 1;
30		31
Lines 66-78 sub new { Link Here
66	$self->{process} = "$Bin/tmpl_process3.pl " . ($verbose ? '' : '-q');	67	$self->{process} = "$Bin/tmpl_process3.pl " . ($verbose ? '' : '-q');
67	$self->{path_po} = "$Bin/po";	68	$self->{path_po} = "$Bin/po";
68	$self->{po} = { '' => $default_pref_po_header };	69	$self->{po} = { '' => $default_pref_po_header };
69	$self->{domain} = 'messages';	70	$self->{domain} = 'Koha';
70	$self->{cp} = `which cp`;	71	$self->{cp} = `which cp`;
71	$self->{msgmerge} = `which msgmerge`;	72	$self->{msgmerge} = `which msgmerge`;
		73	$self->{msgfmt} = `which msgfmt`;
72	$self->{xgettext} = `which xgettext`;	74	$self->{xgettext} = `which xgettext`;
73	$self->{sed} = `which sed`;	75	$self->{sed} = `which sed`;
74	chomp $self->{cp};	76	chomp $self->{cp};
75	chomp $self->{msgmerge};	77	chomp $self->{msgmerge};
		78	chomp $self->{msgfmt};
76	chomp $self->{xgettext};	79	chomp $self->{xgettext};
77	chomp $self->{sed};	80	chomp $self->{sed};
78		81
Lines 466-484 sub create_tmpl { Link Here
466	sub create_messages {	469	sub create_messages {
467	my $self = shift;	470	my $self = shift;
468		471
469	print "Create messages ($self->{lang})\n" if $self->{verbose};	472	my ($language, $country) = split /-/, $self->{lang};
		473	my $locale = $language;
		474	if ($country) {
		475	$locale .= '_' . $country;
		476	}
		477	my $podir = "$self->{path_po}/$locale/LC_MESSAGES";
		478
		479	make_path($podir);
		480	say "Create messages ($locale)" if $self->{verbose};
470	system	481	system
471	"$self->{cp} $self->{domain}.pot " .	482	"$self->{cp} $self->{domain}.pot " .
472	"$self->{path_po}/$self->{lang}-$self->{domain}.po";	483	"$podir/$self->{domain}.po";
473	}	484	}
474		485
475	sub update_messages {	486	sub update_messages {
476	my $self = shift;	487	my $self = shift;
477		488
478	my $pofile = "$self->{path_po}/$self->{lang}-$self->{domain}.po";	489	my ($language, $country) = split /-/, $self->{lang};
479	print "Update messages ($self->{lang})\n" if $self->{verbose};	490	my $locale = $language;
		491	if ($country) {
		492	$locale .= '_' . $country;
		493	}
		494	my $podir = "$self->{path_po}/$locale/LC_MESSAGES";
		495	my $pofile = "$podir/$self->{domain}.po";
		496
		497	say "Update messages ($locale)" if $self->{verbose};
480	if ( not -f $pofile ) {	498	if ( not -f $pofile ) {
481	print "File $pofile does not exist\n" if $self->{verbose};	499	say "File $pofile does not exist" if $self->{verbose};
482	$self->create_messages();	500	$self->create_messages();
483	}	501	}
484	system "$self->{msgmerge} -U $pofile $self->{domain}.pot";	502	system "$self->{msgmerge} -U $pofile $self->{domain}.pot";
Lines 506-513 sub extract_messages { Link Here
506	}	524	}
507	}	525	}
508		526
509	my $xgettext_cmd = "$self->{xgettext} -L Perl --from-code=UTF-8 " .	527	my $xgettext_cmd = "$self->{xgettext} -L Perl --from-code=UTF-8 "
510	"-o $Bin/$self->{domain}.pot -D $intranetdir";	528	. "-k -k__ -k__x -k__n:1,2 -k__nx:1,2 -k__xn:1,2 -k__p:1c,2 "
		529	. "-k__px:1c,2 -k__np:1c,2,3 -k__npx:1c,2,3 -kN__ -kN__n:1,2 "
		530	. "-kN__p:1c,2 -kN__np:1c,2,3 "
		531	. "-o $Bin/$self->{domain}.pot -D $intranetdir";
511	$xgettext_cmd .= " $_" foreach (@files_to_scan);	532	$xgettext_cmd .= " $_" foreach (@files_to_scan);
512		533
513	if (system($xgettext_cmd) != 0) {	534	if (system($xgettext_cmd) != 0) {
Lines 522-533 sub extract_messages { Link Here
522	die "system call failed: $replace_charset_cmd";	543	die "system call failed: $replace_charset_cmd";
523	}	544	}
524	} else {	545	} else {
525	print "No messages found\n" if $self->{verbose};	546	say "No messages found" if $self->{verbose};
526	return;	547	return;
527	}	548	}
528	return 1;	549	return 1;
529	}	550	}
530		551
		552	sub install_messages {
		553	my ($self) = @_;
		554
		555	my ($language, $country) = split /-/, $self->{lang};
		556	my $locale = $language;
		557	if ($country) {
		558	$locale .= '_' . $country;
		559	}
		560	my $podir = "$self->{path_po}/$locale/LC_MESSAGES";
		561	my $pofile = "$podir/$self->{domain}.po";
		562	my $mofile = "$podir/$self->{domain}.mo";
		563
		564	say "Install messages ($locale)" if $self->{verbose};
		565	if ( not -f $pofile ) {
		566	say "File $pofile does not exist" if $self->{verbose};
		567	$self->create_messages();
		568	}
		569	system "$self->{msgfmt} -o $mofile $pofile";
		570	}
		571
531	sub remove_pot {	572	sub remove_pot {
532	my $self = shift;	573	my $self = shift;
533		574
Lines 539-544 sub install { Link Here
539	return unless $self->{lang};	580	return unless $self->{lang};
540	$self->install_tmpl($files) unless $self->{pref_only};	581	$self->install_tmpl($files) unless $self->{pref_only};
541	$self->install_prefs();	582	$self->install_prefs();
		583	$self->install_messages();
542	}	584	}
543		585
544		586
545	-