Bug 5236 Followup: items table information being keyed by biblionumber instead!
[wip/koha-chris_n.git] / misc / translator / LangInstaller.pm
1 package LangInstaller;
2
3 # Copyright (C) 2010 Tamil s.a.r.l.
4 #
5 # This file is part of Koha.
6 #
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
10 # version.
11 #
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
19
20 use strict;
21 use warnings;
22
23 use C4::Context;
24 # WARNING: Any other tested YAML library fails to work properly in this
25 # script content
26 use YAML::Syck qw( Dump LoadFile );
27 use Locale::PO;
28 use FindBin qw( $Bin );
29
30 $YAML::Syck::ImplicitTyping = 1;
31
32 sub set_lang {
33     my ($self, $lang) = @_;
34
35     $self->{lang} = $lang;
36     $self->{po_path_lang} = $self->{context}->config('intrahtdocs') .
37                             "/prog/$lang/modules/admin/preferences";
38 }
39
40
41 sub new {
42     my ($class, $lang, $pref_only) = @_;
43
44     my $self                 = { };
45
46     my $context              = C4::Context->new();
47     $self->{context}         = $context;
48     $self->{path_pref_en}    = $context->config('intrahtdocs') .
49                                '/prog/en/modules/admin/preferences';
50     set_lang( $self, $lang ) if $lang;
51     $self->{pref_only}       = $pref_only;
52     $self->{translator_path} = $Bin;
53     $self->{path_po}         = $self->{translator_path} . "/po";
54     $self->{po}              = {};
55
56     # Get all .pref file names
57     opendir my $fh, $self->{path_pref_en};
58     my @pref_files = grep { /.pref/ } readdir($fh);
59     close $fh;
60     $self->{pref_files} = \@pref_files;
61
62     # Get all available language codes
63     opendir $fh, $self->{path_po};
64     my @langs =  map { ($_) =~ /(.*)-i-opac/ } 
65         grep { $_ =~ /.*-opac-/ } readdir($fh);
66     closedir $fh;
67     $self->{langs} = \@langs;
68
69     # Map for both interfaces opac/intranet
70     $self->{interface} = {
71         opac => {
72             dir    => $context->config('opachtdocs') . '/prog',
73             suffix => '-i-opac-t-prog-v-3002000.po',
74         },
75         intranet => {
76             dir    => $context->config('intrahtdocs') . '/prog',
77             suffix => '-i-staff-t-prog-v-3002000.po',
78         }
79     };
80
81     bless $self, $class;
82 }
83
84
85 sub po_filename {
86     my $self = shift;
87
88     my $context    = C4::Context->new;
89     my $trans_path = $Bin . '/po';
90     my $trans_file = "$trans_path/" . $self->{lang} . "-pref.po";
91     return $trans_file;
92 }
93
94
95 sub po_append {
96     my ($self, $id, $comment) = @_;
97     my $po = $self->{po};
98     my $p = $po->{$id};
99     if ( $p ) {
100         $p->comment( $p->comment . "\n" . $comment );
101     }
102     else {
103         $po->{$id} = Locale::PO->new(
104             -comment => $comment,
105             -msgid   => $id,
106             -msgstr  => ''
107         );
108     }
109 }
110
111
112 sub add_prefs {
113     my ($self, $comment, $prefs) = @_;
114
115     for my $pref ( @$prefs ) {
116         my $pref_name = '';
117         for my $element ( @$pref ) {
118             if ( ref( $element) eq 'HASH' ) {
119                 $pref_name = $element->{pref};
120                 last;
121             }
122         }
123         for my $element ( @$pref ) {
124             if ( ref( $element) eq 'HASH' ) {
125                 while ( my ($key, $value) = each(%$element) ) {
126                     next unless $key eq 'choices';
127                     next unless ref($value) eq 'HASH';
128                     for my $ckey ( keys %$value ) {
129                         my $id = $self->{file} . "#$pref_name# " . $value->{$ckey};
130                         $self->po_append( $id, $comment );
131                     }
132                 }
133             }
134             elsif ( $element && $pref_name ) {
135                 $self->po_append( $self->{file} . "#$pref_name# $element", $comment );
136             }
137         }
138     }
139 }
140
141
142 sub get_trans_text {
143     my ($self, $id) = @_;
144
145     my $po = $self->{po}->{$id};
146     return unless $po;
147     return Locale::PO->dequote($po->msgstr);
148 }
149
150
151 sub update_tab_prefs {
152     my ($self, $pref, $prefs) = @_;
153
154     for my $p ( @$prefs ) {
155         my $pref_name = '';
156         next unless $p;
157         for my $element ( @$p ) {
158             if ( ref( $element) eq 'HASH' ) {
159                 $pref_name = $element->{pref};
160                 last;
161             }
162         }
163         for my $i ( 0..@$p-1 ) {
164             my $element = $p->[$i];
165             if ( ref( $element) eq 'HASH' ) {
166                 while ( my ($key, $value) = each(%$element) ) {
167                     next unless $key eq 'choices';
168                     next unless ref($value) eq 'HASH';
169                     for my $ckey ( keys %$value ) {
170                         my $id = $self->{file} . "#$pref_name# " . $value->{$ckey};
171                         my $text = $self->get_trans_text( $id );
172                         $value->{$ckey} = $text if $text;
173                     }
174                 }
175             }
176             elsif ( $element && $pref_name ) {
177                 my $id = $self->{file} . "#$pref_name# $element";
178                 my $text = $self->get_trans_text( $id );
179                 $p->[$i] = $text if $text;
180             }
181         }
182     }
183 }
184
185
186 sub get_po_from_prefs {
187     my $self = shift;
188
189     for my $file ( @{$self->{pref_files}} ) {
190         my $pref = LoadFile( $self->{path_pref_en} . "/$file" );
191         $self->{file} = $file;
192         # Entries for tab titles
193         $self->po_append( $self->{file}, $_ ) for keys %$pref;
194         while ( my ($tab, $tab_content) = each %$pref ) {
195             if ( ref($tab_content) eq 'ARRAY' ) {
196                 $self->add_prefs( $tab, $tab_content );
197                 next;
198             }
199             while ( my ($section, $sysprefs) = each %$tab_content ) {
200                 my $comment = "$tab > $section";
201                 $self->po_append( $self->{file} . " " . $section, $comment );
202                 $self->add_prefs( $comment, $sysprefs );
203             }
204         }
205     }
206 }
207
208
209 sub save_po {
210     my $self = shift;
211     # Write .po entries into a file put in Koha standard po directory
212     Locale::PO->save_file_fromhash( $self->po_filename, $self->{po} );
213     print "Saved in file: ", $self->po_filename, "\n";
214 }
215
216
217 sub get_po_merged_with_en {
218     my $self = shift;
219
220     # Get po from current 'en' .pref files
221     $self->get_po_from_prefs();
222     my $po_current = $self->{po};
223
224     # Get po from previous generation
225     my $po_previous = Locale::PO->load_file_ashash( $self->po_filename );
226
227     for my $id ( keys %$po_current ) {
228         my $po =  $po_previous->{Locale::PO->quote($id)};
229         next unless $po;
230         my $text = Locale::PO->dequote( $po->msgstr );
231         $po_current->{$id}->msgstr( $text );
232     }
233 }
234
235
236 sub update_prefs {
237     my $self = shift;
238     print "Update '", $self->{lang},
239           "' preferences .po file from 'en' .pref files\n";
240     $self->get_po_merged_with_en();
241     $self->save_po();
242 }
243
244
245 sub install_prefs {
246     my $self = shift;
247
248     unless ( -r $self->{po_path_lang} ) {
249         print "Koha directories hierarchy for ", $self->{lang}, " must be created first\n";
250         exit;
251     }
252
253     # Get the language .po file merged with last modified 'en' preferences
254     $self->get_po_merged_with_en();
255
256     for my $file ( @{$self->{pref_files}} ) {
257         my $pref = LoadFile( $self->{path_pref_en} . "/$file" );
258         $self->{file} = $file;
259         # First, keys are replaced (tab titles)
260         $pref = do {
261             my %pref = map { 
262                 $self->get_trans_text( $self->{file} ) || $_ => $pref->{$_}
263             } keys %$pref;
264             \%pref;
265         };
266         while ( my ($tab, $tab_content) = each %$pref ) {
267             if ( ref($tab_content) eq 'ARRAY' ) {
268                 $self->update_tab_prefs( $pref, $tab_content );
269                 next;
270             }
271             while ( my ($section, $sysprefs) = each %$tab_content ) {
272                 $self->update_tab_prefs( $pref, $sysprefs );
273             }
274             my $ntab = {};
275             for my $section ( keys %$tab_content ) {
276                 my $id = $self->{file} . " $section";
277                 my $text = $self->get_trans_text($id);
278                 my $nsection = $text ? $text : $section;
279                 $ntab->{$nsection} = $tab_content->{$section};
280             }
281             $pref->{$tab} = $ntab;
282         }
283         my $file_trans = $self->{po_path_lang} . "/$file";
284         print "Write $file\n";
285         open my $fh, ">", $file_trans;
286         print $fh Dump($pref);
287     }
288 }
289
290
291 sub install_tmpl {
292     my $self = shift;
293
294     print
295         "Install templates\n";
296     while ( my ($interface, $tmpl) = each %{$self->{interface}} ) {
297         print
298             "  Install templates '$interface\n",
299             "    From: $tmpl->{dir}/en/\n",
300             "    To  : $tmpl->{dir}/$self->{lang}\n",
301             "    With: $self->{path_po}/$self->{lang}$tmpl->{suffix}\n";
302         my $lang_dir = "$tmpl->{dir}/$self->{lang}";
303         mkdir $lang_dir unless -d $lang_dir;
304         system
305             "$self->{translator_path}/tmpl_process3.pl install " .
306             "-i $tmpl->{dir}/en/ " .
307             "-o $tmpl->{dir}/$self->{lang} ".
308             "-s $self->{path_po}/$self->{lang}$tmpl->{suffix} -r"
309     }
310 }
311
312
313 sub update_tmpl {
314     my $self = shift;
315
316     print
317         "Update templates\n";
318     while ( my ($interface, $tmpl) = each %{$self->{interface}} ) {
319         print
320             "  Update templates '$interface'\n",
321             "    From: $tmpl->{dir}/en/\n",
322             "    To  : $self->{path_po}/$self->{lang}$tmpl->{suffix}\n";
323         my $lang_dir = "$tmpl->{dir}/$self->{lang}";
324         mkdir $lang_dir unless -d $lang_dir;
325         system
326             "$self->{translator_path}/tmpl_process3.pl update " .
327             "-i $tmpl->{dir}/en/ " .
328             "-s $self->{path_po}/$self->{lang}$tmpl->{suffix} -r"
329     }
330 }
331
332
333 sub create_prefs {
334     my $self = shift;
335
336     $self->get_po_from_prefs();
337     $self->save_po();
338 }
339
340
341 sub create_tmpl {
342     my $self = shift;
343
344     print
345         "Create templates\n";
346     while ( my ($interface, $tmpl) = each %{$self->{interface}} ) {
347         print
348             "  Create templates .po files for '$interface'\n",
349             "    From: $tmpl->{dir}/en/\n",
350             "    To  : $self->{path_po}/$self->{lang}$tmpl->{suffix}\n";
351         system
352             "$self->{translator_path}/tmpl_process3.pl create " .
353             "-i $tmpl->{dir}/en/ " .
354             "-s $self->{path_po}/$self->{lang}$tmpl->{suffix} -r"
355     }
356 }
357
358
359 sub install {
360     my $self = shift;
361     return unless $self->{lang};
362     $self->install_tmpl() unless $self->{pref_only};
363     $self->install_prefs();
364 }
365
366
367 sub get_all_langs {
368     my $self = shift;
369     opendir( my $dh, $self->{path_po} );
370     my @files = grep { $_ =~ /-i-opac-t-prog-v-3002000.po$/ }
371         readdir $dh;
372     @files = map { $_ =~ s/-i-opac-t-prog-v-3002000.po$//; $_ } @files;
373 }
374
375
376 sub update {
377     my $self = shift;
378     my @langs = $self->{lang} ? ($self->{lang}) : $self->get_all_langs();
379     for my $lang ( @langs ) {
380         $self->set_lang( $lang );
381         $self->update_tmpl() unless $self->{pref_only};
382         $self->update_prefs();
383     }
384 }
385
386
387 sub create {
388     my $self = shift;
389     return unless $self->{lang};
390     $self->create_tmpl() unless $self->{pref_only};
391     $self->create_prefs();
392 }
393
394
395
396 1;
397
398
399 =head1 NAME
400
401 LangInstaller.pm - Handle templates and preferences translation
402
403 =head1 SYNOPSYS
404
405   my $installer = LangInstaller->new( 'fr-FR' );
406   $installer->create();
407   $installer->update();
408   $installer->install();
409   for my $lang ( @{$installer->{langs} ) {
410     $installer->set_lang( $lan );
411     $installer->install();
412   }
413
414 =head1 METHODS
415
416 =head2 new
417
418 Create a new instance of the installer object. 
419
420 =head2 create
421
422 For the current language, create .po files for templates and preferences based
423 of the english ('en') version.
424
425 =head2 update
426
427 For the current language, update .po files.
428
429 =head2 install
430
431 For the current langage C<$self->{lang}, use .po files to translate the english
432 version of templates and preferences files and copy those files in the
433 appropriate directory.
434
435 =over
436
437 =item translate create F<lang>
438
439 Create 3 .po files in F<po> subdirectory: (1) from opac pages templates, (2)
440 intranet templates, and (3) from preferences.
441
442 =over
443
444 =item F<lang>-opac.po
445
446 Contains extracted text from english (en) OPAC templates found in
447 <KOHA_ROOT>/koha-tmpl/opac-tmpl/prog/en/ directory.
448
449 =item F<lang>-intranet.po
450
451 Contains extracted text from english (en) intranet templates found in
452 <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/ directory.
453
454 =item F<lang>-pref.po
455
456 Contains extracted text from english (en) preferences. They are found in files
457 located in <KOHA_ROOT>/koha-tmpl/intranet-tmpl/prog/en/admin/preferences
458 directory.
459
460 =back
461
462 =item pref-trans update F<lang>
463
464 Update .po files in F<po> directory, named F<lang>-*.po.
465
466 =item pref-trans install F<lang>
467
468 =back
469
470 =cut
471