po: Make the po_master_language use a langpair like "en|English", so it can be config...
[ikiwiki.git] / IkiWiki / Plugin / po.pm
1 #!/usr/bin/perl
2 # .po as a wiki page type
3 # Licensed under GPL v2 or greater
4 # Copyright (C) 2008-2009 intrigeri <intrigeri@boum.org>
5 # inspired by the GPL'd po4a-translate,
6 # which is Copyright 2002, 2003, 2004 by Martin Quinson (mquinson#debian.org)
7 package IkiWiki::Plugin::po;
8
9 use warnings;
10 use strict;
11 use IkiWiki 3.00;
12 use Encode;
13 eval q{use Locale::Po4a::Common qw(nowrapi18n !/.*/)};
14 if ($@) {
15         print STDERR gettext("warning: Old po4a detected! Recommend upgrade to 0.35.")."\n";
16         eval q{use Locale::Po4a::Common qw(!/.*/)};
17         die $@ if $@;
18 }
19 use Locale::Po4a::Chooser;
20 use Locale::Po4a::Po;
21 use File::Basename;
22 use File::Copy;
23 use File::Spec;
24 use File::Temp;
25 use Memoize;
26 use UNIVERSAL;
27
28 my ($master_language_code, $master_language_name);
29 my %translations;
30 my @origneedsbuild;
31 my %origsubs;
32 my @slavelanguages; # language codes ordered as in config po_slave_languages
33
34 memoize("istranslatable");
35 memoize("_istranslation");
36 memoize("percenttranslated");
37
38 sub import {
39         hook(type => "getsetup", id => "po", call => \&getsetup);
40         hook(type => "checkconfig", id => "po", call => \&checkconfig);
41         hook(type => "needsbuild", id => "po", call => \&needsbuild);
42         hook(type => "scan", id => "po", call => \&scan, last => 1);
43         hook(type => "filter", id => "po", call => \&filter);
44         hook(type => "htmlize", id => "po", call => \&htmlize);
45         hook(type => "pagetemplate", id => "po", call => \&pagetemplate, last => 1);
46         hook(type => "rename", id => "po", call => \&renamepages, first => 1);
47         hook(type => "delete", id => "po", call => \&mydelete);
48         hook(type => "change", id => "po", call => \&change);
49         hook(type => "checkcontent", id => "po", call => \&checkcontent);
50         hook(type => "canremove", id => "po", call => \&canremove);
51         hook(type => "canrename", id => "po", call => \&canrename);
52         hook(type => "editcontent", id => "po", call => \&editcontent);
53         hook(type => "formbuilder_setup", id => "po", call => \&formbuilder_setup, last => 1);
54         hook(type => "formbuilder", id => "po", call => \&formbuilder);
55
56         if (! %origsubs) {
57                 $origsubs{'bestlink'}=\&IkiWiki::bestlink;
58                 inject(name => "IkiWiki::bestlink", call => \&mybestlink);
59                 $origsubs{'beautify_urlpath'}=\&IkiWiki::beautify_urlpath;
60                 inject(name => "IkiWiki::beautify_urlpath", call => \&mybeautify_urlpath);
61                 $origsubs{'targetpage'}=\&IkiWiki::targetpage;
62                 inject(name => "IkiWiki::targetpage", call => \&mytargetpage);
63                 $origsubs{'urlto'}=\&IkiWiki::urlto;
64                 inject(name => "IkiWiki::urlto", call => \&myurlto);
65                 $origsubs{'cgiurl'}=\&IkiWiki::cgiurl;
66                 inject(name => "IkiWiki::cgiurl", call => \&mycgiurl);
67                 $origsubs{'rootpage'}=\&IkiWiki::rootpage;
68                 inject(name => "IkiWiki::rootpage", call => \&myrootpage);
69                 $origsubs{'isselflink'}=\&IkiWiki::isselflink;
70                 inject(name => "IkiWiki::isselflink", call => \&myisselflink);
71         }
72 }
73
74
75 # ,----
76 # | Table of contents
77 # `----
78
79 # 1. Hooks
80 # 2. Injected functions
81 # 3. Blackboxes for private data
82 # 4. Helper functions
83 # 5. PageSpecs
84
85
86 # ,----
87 # | Hooks
88 # `----
89
90 sub getsetup () {
91         return
92                 plugin => {
93                         safe => 1,
94                         rebuild => 1, # format plugin
95                         section => "format",
96                 },
97                 po_master_language => {
98                         type => "string",
99                         example => "en|English",
100                         description => "master language (non-PO files)",
101                         safe => 1,
102                         rebuild => 1,
103                 },
104                 po_slave_languages => {
105                         type => "string",
106                         example => [
107                                 'fr|Français',
108                                 'es|Español',
109                                 'de|Deutsch'
110                         ],
111                         description => "slave languages (translated via PO files) format: ll|Langname",
112                         safe => 1,
113                         rebuild => 1,
114                 },
115                 po_translatable_pages => {
116                         type => "pagespec",
117                         example => "* and !*/Discussion",
118                         description => "PageSpec controlling which pages are translatable",
119                         link => "ikiwiki/PageSpec",
120                         safe => 1,
121                         rebuild => 1,
122                 },
123                 po_link_to => {
124                         type => "string",
125                         example => "current",
126                         description => "internal linking behavior (default/current/negotiated)",
127                         safe => 1,
128                         rebuild => 1,
129                 },
130 }
131
132 sub checkconfig () {
133         if (exists $config{po_master_language}) {
134                 if (! ref $config{po_master_language}) {
135                         ($master_language_code, $master_language_name)=
136                                 splitlangpair($config{po_master_language});
137                 }
138                 else {
139                         $master_language_code=$config{po_master_language}{code};
140                         $master_language_name=$config{po_master_language}{name};
141                 }
142         }
143         if (! defined $master_language_code) {
144                 $master_language_code='en';
145         }
146         if (! defined $master_language_name) {
147                 $master_language_name='English';
148         }
149
150         if (ref $config{po_slave_languages} eq 'ARRAY') {
151                 my %slaves;
152                 foreach my $pair (@{$config{po_slave_languages}}) {
153                         my ($code, $name)=splitlangpair($pair);
154                         if (defined $code) {
155                                 push @slavelanguages, $code;
156                                 $slaves{$code} = $name;
157                         }
158                 }
159                 $config{po_slave_languages} = \%slaves;
160         }
161         elsif (ref $config{po_slave_languages} eq 'HASH') {
162                 @slavelanguages = sort {
163                         $config{po_slave_languages}->{$a} cmp $config{po_slave_languages}->{$b};
164                 } keys %{$config{po_slave_languages}};
165         }
166
167         delete $config{po_slave_languages}{$master_language_code};
168
169         map {
170                 islanguagecode($_)
171                         or error(sprintf(gettext("%s is not a valid language code"), $_));
172         } ($master_language_code, @slavelanguages);
173
174         if (! exists $config{po_translatable_pages} ||
175             ! defined $config{po_translatable_pages}) {
176                 $config{po_translatable_pages}="";
177         }
178         if (! exists $config{po_link_to} ||
179             ! defined $config{po_link_to}) {
180                 $config{po_link_to}='default';
181         }
182         elsif ($config{po_link_to} !~ /^(default|current|negotiated)$/) {
183                 warn(sprintf(gettext('%s is not a valid value for po_link_to, falling back to po_link_to=default'),
184                              $config{po_link_to}));
185                 $config{po_link_to}='default';
186         }
187         elsif ($config{po_link_to} eq "negotiated" && ! $config{usedirs}) {
188                 warn(gettext('po_link_to=negotiated requires usedirs to be enabled, falling back to po_link_to=default'));
189                 $config{po_link_to}='default';
190         }
191
192         push @{$config{wiki_file_prune_regexps}}, qr/\.pot$/;
193
194         # Translated versions of the underlays are added if available.
195         foreach my $underlay ("basewiki",
196                               map { m/^\Q$config{underlaydirbase}\E\/*(.*)/ }
197                                   reverse @{$config{underlaydirs}}) {
198                 next if $underlay=~/^locale\//;
199
200                 # Underlays containing the po files for slave languages.
201                 foreach my $ll (@slavelanguages) {
202                         add_underlay("po/$ll/$underlay")
203                                 if -d "$config{underlaydirbase}/po/$ll/$underlay";
204                 }
205         
206                 if ($master_language_code ne 'en') {
207                         # Add underlay containing translated source files
208                         # for the master language.
209                         add_underlay("locale/$master_language_code/$underlay")
210                                 if -d "$config{underlaydirbase}/locale/$master_language_code/$underlay";
211                 }
212         }
213 }
214
215 sub needsbuild () {
216         my $needsbuild=shift;
217
218         # backup @needsbuild content so that change() can know whether
219         # a given master page was rendered because its source file was changed
220         @origneedsbuild=(@$needsbuild);
221
222         flushmemoizecache();
223         buildtranslationscache();
224
225         # make existing translations depend on the corresponding master page
226         foreach my $master (keys %translations) {
227                 map add_depends($_, $master), values %{otherlanguages_pages($master)};
228         }
229
230         return $needsbuild;
231 }
232
233 sub scan (@) {
234         my %params=@_;
235         my $page=$params{page};
236         my $content=$params{content};
237         my $run_by_po=$params{run_by_po};
238
239         # Massage the recorded state of internal links so that:
240         # - it matches the actually generated links, rather than the links as
241         #   written in the pages' source
242         # - backlinks are consistent in all cases
243
244         # A second scan pass is made over translation pages, so as an
245         # optimization, we only do so on the second pass in this case,
246         # i.e. when this hook is called by itself.
247         if ($run_by_po && istranslation($page)) {
248                 # replace the occurence of $destpage in $links{$page}
249                 my @orig_links = @{$links{$page}};
250                 $links{$page} = [];
251                 foreach my $destpage (@orig_links) {
252                         if (istranslatedto($destpage, lang($page))) {
253                                 add_link($page, $destpage . '.' . lang($page));
254                         }
255                         else {
256                                 add_link($page, $destpage);
257                         }
258                 }
259         }
260         # No second scan pass is done for a non-translation page, so
261         # links massaging must happen on first pass in this case.
262         elsif (! $run_by_po && ! istranslatable($page) && ! istranslation($page)) {
263                 foreach my $destpage (@{$links{$page}}) {
264                         if (istranslatable($destpage)) {
265                                 # make sure any destpage's translations has
266                                 # $page in its backlinks
267                                 foreach my $link (values %{otherlanguages_pages($destpage)}) {
268                                         add_link($page, $link);
269                                 }
270                         }
271                 }
272         }
273
274         # Re-run the preprocess hooks in scan mode, then the scan hooks,
275         # over the po-to-markup converted content
276         return if $run_by_po; # avoid looping endlessly
277         return unless istranslation($page);
278         $content = po_to_markup($page, $content);
279         require IkiWiki;
280         IkiWiki::preprocess($page, $page, $content, 1);
281         IkiWiki::run_hooks(scan => sub {
282                 shift->(
283                         page => $page,
284                         content => $content,
285                         run_by_po => 1,
286                 );
287         });
288 }
289
290 # We use filter to convert PO to the master page's format,
291 # since the rest of ikiwiki should not work on PO files.
292 sub filter (@) {
293         my %params = @_;
294
295         my $page = $params{page};
296         my $destpage = $params{destpage};
297         my $content = $params{content};
298         if (istranslation($page) && ! alreadyfiltered($page, $destpage)) {
299                 $content = po_to_markup($page, $content);
300                 setalreadyfiltered($page, $destpage);
301         }
302         return $content;
303 }
304
305 sub htmlize (@) {
306         my %params=@_;
307
308         my $page = $params{page};
309         my $content = $params{content};
310
311         # ignore PO files this plugin did not create
312         return $content unless istranslation($page);
313
314         # force content to be htmlize'd as if it was the same type as the master page
315         return IkiWiki::htmlize($page, $page,
316                 pagetype(srcfile($pagesources{masterpage($page)})),
317                 $content);
318 }
319
320 sub pagetemplate (@) {
321         my %params=@_;
322         my $page=$params{page};
323         my $destpage=$params{destpage};
324         my $template=$params{template};
325
326         my ($masterpage, $lang) = istranslation($page);
327
328         if (istranslation($page) && $template->query(name => "percenttranslated")) {
329                 $template->param(percenttranslated => percenttranslated($page));
330         }
331         if ($template->query(name => "istranslation")) {
332                 $template->param(istranslation => scalar istranslation($page));
333         }
334         if ($template->query(name => "istranslatable")) {
335                 $template->param(istranslatable => istranslatable($page));
336         }
337         if ($template->query(name => "HOMEPAGEURL")) {
338                 $template->param(homepageurl => homepageurl($page));
339         }
340         if ($template->query(name => "otherlanguages")) {
341                 $template->param(otherlanguages => [otherlanguagesloop($page)]);
342                 map add_depends($page, $_), (values %{otherlanguages_pages($page)});
343         }
344         if ($config{discussion} && istranslation($page)) {
345                 if ($page !~ /.*\/\Q$config{discussionpage}\E$/i &&
346                    (length $config{cgiurl} ||
347                     exists $links{$masterpage."/".lc($config{discussionpage})})) {
348                         $template->param('discussionlink' => htmllink(
349                                 $page,
350                                 $destpage,
351                                 $masterpage . '/' . $config{discussionpage},
352                                 noimageinline => 1,
353                                 forcesubpage => 0,
354                                 linktext => $config{discussionpage},
355                 ));
356                 }
357         }
358         # Remove broken parentlink to ./index.html on home page's translations.
359         # It works because this hook has the "last" parameter set, to ensure it
360         # runs after parentlinks' own pagetemplate hook.
361         if ($template->param('parentlinks')
362             && istranslation($page)
363             && $masterpage eq "index") {
364                 $template->param('parentlinks' => []);
365         }
366         if (ishomepage($page) && $template->query(name => "title")) {
367                 $template->param(title => $config{wikiname});
368         }
369 }
370
371 # Add the renamed page translations to the list of to-be-renamed pages.
372 sub renamepages (@) {
373         my %params = @_;
374
375         my %torename = %{$params{torename}};
376         my $session = $params{session};
377
378         # Save the page(s) the user asked to rename, so that our
379         # canrename hook can tell the difference between:
380         #  - a translation being renamed as a consequence of its master page
381         #    being renamed
382         #  - a user trying to directly rename a translation
383         # This is why this hook has to be run first, before the list of pages
384         # to rename is modified by other plugins.
385         my @orig_torename;
386         @orig_torename=@{$session->param("po_orig_torename")}
387                 if defined $session->param("po_orig_torename");
388         push @orig_torename, $torename{src};
389         $session->param(po_orig_torename => \@orig_torename);
390         IkiWiki::cgi_savesession($session);
391
392         return () unless istranslatable($torename{src});
393
394         my @ret;
395         my %otherpages=%{otherlanguages_pages($torename{src})};
396         while (my ($lang, $otherpage) = each %otherpages) {
397                 push @ret, {
398                         src => $otherpage,
399                         srcfile => $pagesources{$otherpage},
400                         dest => otherlanguage_page($torename{dest}, $lang),
401                         destfile => $torename{dest}.".".$lang.".po",
402                         required => 0,
403                 };
404         }
405         return @ret;
406 }
407
408 sub mydelete (@) {
409         my @deleted=@_;
410
411         map { deletetranslations($_) } grep istranslatablefile($_), @deleted;
412 }
413
414 sub change (@) {
415         my @rendered=@_;
416
417         my $updated_po_files=0;
418
419         # Refresh/create POT and PO files as needed.
420         foreach my $file (grep {istranslatablefile($_)} @rendered) {
421                 my $masterfile=srcfile($file);
422                 my $page=pagename($file);
423                 my $updated_pot_file=0;
424
425                 # Avoid touching underlay files.
426                 next if $masterfile ne "$config{srcdir}/$file";
427
428                 # Only refresh POT file if it does not exist, or if
429                 # the source was changed: don't if only the HTML was
430                 # refreshed, e.g. because of a dependency.
431                 if ((grep { $_ eq $pagesources{$page} } @origneedsbuild) ||
432                     ! -e potfile($masterfile)) {
433                         refreshpot($masterfile);
434                         $updated_pot_file=1;
435                 }
436                 my @pofiles;
437                 foreach my $po (pofiles($masterfile)) {
438                         next if ! $updated_pot_file && -e $po;
439                         next if grep { $po=~/\Q$_\E/ } @{$config{underlaydirs}};
440                         push @pofiles, $po;
441                 }
442                 if (@pofiles) {
443                         refreshpofiles($masterfile, @pofiles);
444                         map { s/^\Q$config{srcdir}\E\/*//; IkiWiki::rcs_add($_) } @pofiles if $config{rcs};
445                         $updated_po_files=1;
446                 }
447         }
448
449         if ($updated_po_files) {
450                 commit_and_refresh(
451                         gettext("updated PO files"));
452         }
453 }
454
455 sub checkcontent (@) {
456         my %params=@_;
457
458         if (istranslation($params{page})) {
459                 my $res = isvalidpo($params{content});
460                 if ($res) {
461                         return undef;
462                 }
463                 else {
464                         return "$res";
465                 }
466         }
467         return undef;
468 }
469
470 sub canremove (@) {
471         my %params = @_;
472
473         if (istranslation($params{page})) {
474                 return gettext("Can not remove a translation. If the master page is removed, ".
475                                "however, its translations will be removed as well.");
476         }
477         return undef;
478 }
479
480 sub canrename (@) {
481         my %params = @_;
482         my $session = $params{session};
483
484         if (istranslation($params{src})) {
485                 my $masterpage = masterpage($params{src});
486                 # Tell the difference between:
487                 #  - a translation being renamed as a consequence of its master page
488                 #    being renamed, which is allowed
489                 #  - a user trying to directly rename a translation, which is forbidden
490                 # by looking for the master page in the list of to-be-renamed pages we
491                 # saved early in the renaming process.
492                 my $orig_torename = $session->param("po_orig_torename");
493                 unless (grep { $_ eq $masterpage } @{$orig_torename}) {
494                         return gettext("Can not rename a translation. If the master page is renamed, ".
495                                        "however, its translations will be renamed as well.");
496                 }
497         }
498         return undef;
499 }
500
501 # As we're previewing or saving a page, the content may have
502 # changed, so tell the next filter() invocation it must not be lazy.
503 sub editcontent () {
504         my %params=@_;
505
506         unsetalreadyfiltered($params{page}, $params{page});
507         return $params{content};
508 }
509
510 sub formbuilder_setup (@) {
511         my %params=@_;
512         my $form=$params{form};
513         my $q=$params{cgi};
514
515         return unless defined $form->field("do");
516
517         if ($form->field("do") eq "create") {
518                 # Warn the user: new pages must be written in master language.
519                 my $template=template("pocreatepage.tmpl");
520                 $template->param(LANG => $master_language_name);
521                 $form->tmpl_param(message => $template->output);
522         }
523         elsif ($form->field("do") eq "edit") {
524                 # Remove the rename/remove buttons on slave pages.
525                 # This has to be done after the rename/remove plugins have added
526                 # their buttons, which is why this hook must be run last.
527                 # The canrename/canremove hooks already ensure this is forbidden
528                 # at the backend level, so this is only UI sugar.
529                 if (istranslation($form->field("page"))) {
530                         map {
531                                 for (my $i = 0; $i < @{$params{buttons}}; $i++) {
532                                         if (@{$params{buttons}}[$i] eq $_) {
533                                                 delete  @{$params{buttons}}[$i];
534                                                 last;
535                                         }
536                                 }
537                         } qw(Rename Remove);
538                 }
539         }
540 }
541
542 sub formbuilder (@) {
543         my %params=@_;
544         my $form=$params{form};
545         my $q=$params{cgi};
546
547         return unless defined $form->field("do");
548
549         # Do not allow to create pages of type po: they are automatically created.
550         # The main reason to do so is to bypass the "favor the type of linking page
551         # on page creation" logic, which is unsuitable when a broken link is clicked
552         # on a slave (PO) page.
553         # This cannot be done in the formbuilder_setup hook as the list of types is
554         # computed later.
555         if ($form->field("do") eq "create") {
556                 foreach my $field ($form->field) {
557                         next unless "$field" eq "type";
558                         next unless $field->type eq 'select';
559                         my $orig_value = $field->value;
560                         # remove po from the list of types
561                         my @types = grep { $_->[0] ne 'po' } $field->options;
562                         $field->options(\@types) if @types;
563                         # favor the type of linking page's masterpage
564                         if ($orig_value eq 'po') {
565                                 my ($from, $type);
566                                 if (defined $form->field('from')) {
567                                         ($from)=$form->field('from')=~/$config{wiki_file_regexp}/;
568                                         $from = masterpage($from);
569                                 }
570                                 if (defined $from && exists $pagesources{$from}) {
571                                         $type=pagetype($pagesources{$from});
572                                 }
573                                 $type=$config{default_pageext} unless defined $type;
574                                 $field->value($type) ;
575                         }
576                 }
577         }
578 }
579
580 # ,----
581 # | Injected functions
582 # `----
583
584 # Implement po_link_to 'current' and 'negotiated' settings.
585 sub mybestlink ($$) {
586         my $page=shift;
587         my $link=shift;
588
589         return $origsubs{'bestlink'}->($page, $link)
590                 if defined $config{po_link_to} && $config{po_link_to} eq "default";
591
592         my $res=$origsubs{'bestlink'}->(masterpage($page), $link);
593         my @caller = caller(1);
594         if (length $res
595             && istranslatedto($res, lang($page))
596             && istranslation($page)
597             &&  !(exists $caller[3] && defined $caller[3]
598                   && ($caller[3] eq "IkiWiki::PageSpec::match_link"))) {
599                 return $res . "." . lang($page);
600         }
601         return $res;
602 }
603
604 sub mybeautify_urlpath ($) {
605         my $url=shift;
606
607         my $res=$origsubs{'beautify_urlpath'}->($url);
608         if (defined $config{po_link_to} && $config{po_link_to} eq "negotiated") {
609                 $res =~ s!/\Qindex.$master_language_code.$config{htmlext}\E$!/!;
610                 $res =~ s!/\Qindex.$config{htmlext}\E$!/!;
611                 map {
612                         $res =~ s!/\Qindex.$_.$config{htmlext}\E$!/!;
613                 } @slavelanguages;
614         }
615         return $res;
616 }
617
618 sub mytargetpage ($$) {
619         my $page=shift;
620         my $ext=shift;
621
622         if (istranslation($page) || istranslatable($page)) {
623                 my ($masterpage, $lang) = (masterpage($page), lang($page));
624                 if (! $config{usedirs} || $masterpage eq 'index') {
625                         return $masterpage . "." . $lang . "." . $ext;
626                 }
627                 else {
628                         return $masterpage . "/index." . $lang . "." . $ext;
629                 }
630         }
631         return $origsubs{'targetpage'}->($page, $ext);
632 }
633
634 sub myurlto ($$;$) {
635         my $to=shift;
636         my $from=shift;
637         my $absolute=shift;
638
639         # workaround hard-coded /index.$config{htmlext} in IkiWiki::urlto()
640         if (! length $to
641             && $config{po_link_to} eq "current"
642             && istranslatable('index')) {
643                 return IkiWiki::beautify_urlpath(IkiWiki::baseurl($from) . "index." . lang($from) . ".$config{htmlext}");
644         }
645         # avoid using our injected beautify_urlpath if run by cgi_editpage,
646         # so that one is redirected to the just-edited page rather than to the
647         # negociated translation; to prevent unnecessary fiddling with caller/inject,
648         # we only do so when our beautify_urlpath would actually do what we want to
649         # avoid, i.e. when po_link_to = negotiated.
650         # also avoid doing so when run by cgi_goto, so that the links on recentchanges
651         # page actually lead to the exact page they pretend to.
652         if ($config{po_link_to} eq "negotiated") {
653                 my @caller = caller(1);
654                 my $use_orig = 0;
655                 $use_orig = 1 if (exists $caller[3] && defined $caller[3]
656                                  && ($caller[3] eq "IkiWiki::cgi_editpage" ||
657                                      $caller[3] eq "IkiWiki::Plugin::goto::cgi_goto")
658                                  );
659                 inject(name => "IkiWiki::beautify_urlpath", call => $origsubs{'beautify_urlpath'})
660                         if $use_orig;
661                 my $res = $origsubs{'urlto'}->($to,$from,$absolute);
662                 inject(name => "IkiWiki::beautify_urlpath", call => \&mybeautify_urlpath)
663                         if $use_orig;
664                 return $res;
665         }
666         else {
667                 return $origsubs{'urlto'}->($to,$from,$absolute)
668         }
669 }
670
671 sub mycgiurl (@) {
672         my %params=@_;
673
674         # slave pages have no subpages
675         if (istranslation($params{'from'})) {
676                 $params{'from'} = masterpage($params{'from'});
677         }
678         return $origsubs{'cgiurl'}->(%params);
679 }
680
681 sub myrootpage (@) {
682         my %params=@_;
683
684         my $rootpage;
685         if (exists $params{rootpage}) {
686                 $rootpage=$origsubs{'bestlink'}->($params{page}, $params{rootpage});
687                 if (!length $rootpage) {
688                         $rootpage=$params{rootpage};
689                 }
690         }
691         else {
692                 $rootpage=masterpage($params{page});
693         }
694         return $rootpage;
695 }
696
697 sub myisselflink ($$) {
698         my $page=shift;
699         my $link=shift;
700
701         return 1 if $origsubs{'isselflink'}->($page, $link);
702         if (istranslation($page)) {
703                 return $origsubs{'isselflink'}->(masterpage($page), $link);
704         }
705         return;
706 }
707
708 # ,----
709 # | Blackboxes for private data
710 # `----
711
712 {
713         my %filtered;
714
715         sub alreadyfiltered($$) {
716                 my $page=shift;
717                 my $destpage=shift;
718
719                 return exists $filtered{$page}{$destpage}
720                          && $filtered{$page}{$destpage} eq 1;
721         }
722
723         sub setalreadyfiltered($$) {
724                 my $page=shift;
725                 my $destpage=shift;
726
727                 $filtered{$page}{$destpage}=1;
728         }
729
730         sub unsetalreadyfiltered($$) {
731                 my $page=shift;
732                 my $destpage=shift;
733
734                 if (exists $filtered{$page}{$destpage}) {
735                         delete $filtered{$page}{$destpage};
736                 }
737         }
738
739         sub resetalreadyfiltered() {
740                 undef %filtered;
741         }
742 }
743
744 # ,----
745 # | Helper functions
746 # `----
747
748 sub maybe_add_leading_slash ($;$) {
749         my $str=shift;
750         my $add=shift;
751         $add=1 unless defined $add;
752         return '/' . $str if $add;
753         return $str;
754 }
755
756 sub istranslatablefile ($) {
757         my $file=shift;
758
759         return 0 unless defined $file;
760         my $type=pagetype($file);
761         return 0 if ! defined $type || $type eq 'po';
762         return 0 if $file =~ /\.pot$/;
763         return 0 if ! defined $config{po_translatable_pages};
764         return 1 if pagespec_match(pagename($file), $config{po_translatable_pages});
765         return;
766 }
767
768 sub istranslatable ($) {
769         my $page=shift;
770
771         $page=~s#^/##;
772         return 1 if istranslatablefile($pagesources{$page});
773         return;
774 }
775
776 sub istranslatedto ($$) {
777         my $page=shift;
778         my $destlang = shift;
779
780         $page=~s#^/##;
781         return 0 unless istranslatable($page);
782         exists $pagesources{otherlanguage_page($page, $destlang)};
783 }
784
785 sub _istranslation ($) {
786         my $page=shift;
787
788         $page='' unless defined $page && length $page;
789         my $hasleadingslash = ($page=~s#^/##);
790         my $file=$pagesources{$page};
791         return 0 unless defined $file
792                          && defined pagetype($file)
793                          && pagetype($file) eq 'po';
794         return 0 if $file =~ /\.pot$/;
795
796         my ($masterpage, $lang) = ($page =~ /(.*)[.]([a-z]{2})$/);
797         return 0 unless defined $masterpage && defined $lang
798                          && length $masterpage && length $lang
799                          && defined $pagesources{$masterpage}
800                          && defined $config{po_slave_languages}{$lang};
801
802         return (maybe_add_leading_slash($masterpage, $hasleadingslash), $lang)
803                 if istranslatable($masterpage);
804 }
805
806 sub istranslation ($) {
807         my $page=shift;
808
809         if (1 < (my ($masterpage, $lang) = _istranslation($page))) {
810                 my $hasleadingslash = ($masterpage=~s#^/##);
811                 $translations{$masterpage}{$lang}=$page unless exists $translations{$masterpage}{$lang};
812                 return (maybe_add_leading_slash($masterpage, $hasleadingslash), $lang);
813         }
814         return "";
815 }
816
817 sub masterpage ($) {
818         my $page=shift;
819
820         if ( 1 < (my ($masterpage, $lang) = _istranslation($page))) {
821                 return $masterpage;
822         }
823         return $page;
824 }
825
826 sub lang ($) {
827         my $page=shift;
828
829         if (1 < (my ($masterpage, $lang) = _istranslation($page))) {
830                 return $lang;
831         }
832         return $master_language_code;
833 }
834
835 sub islanguagecode ($) {
836         my $code=shift;
837
838         return $code =~ /^[a-z]{2}$/;
839 }
840
841 sub otherlanguage_page ($$) {
842         my $page=shift;
843         my $code=shift;
844
845         return masterpage($page) if $code eq $master_language_code;
846         return masterpage($page) . '.' . $code;
847 }
848
849 # Returns the list of other languages codes: the master language comes first,
850 # then the codes are ordered the same way as in po_slave_languages, if it is
851 # an array, or in the language name lexical order, if it is a hash.
852 sub otherlanguages_codes ($) {
853         my $page=shift;
854
855         my @ret;
856         return \@ret unless istranslation($page) || istranslatable($page);
857         my $curlang=lang($page);
858         foreach my $lang
859                 ($master_language_code, @slavelanguages) {
860                 next if $lang eq $curlang;
861                 if ($lang eq $master_language_code ||
862                     istranslatedto(masterpage($page), $lang)) {
863                         push @ret, $lang;
864                 }
865         }
866         return \@ret;
867 }
868
869 sub otherlanguages_pages ($) {
870         my $page=shift;
871
872         my %ret;
873         map {
874                 $ret{$_} = otherlanguage_page($page, $_)
875         } @{otherlanguages_codes($page)};
876
877         return \%ret;
878 }
879
880 sub potfile ($) {
881         my $masterfile=shift;
882
883         (my $name, my $dir, my $suffix) = fileparse($masterfile, qr/\.[^.]*/);
884         $dir='' if $dir eq './';
885         return File::Spec->catpath('', $dir, $name . ".pot");
886 }
887
888 sub pofile ($$) {
889         my $masterfile=shift;
890         my $lang=shift;
891
892         (my $name, my $dir, my $suffix) = fileparse($masterfile, qr/\.[^.]*/);
893         $dir='' if $dir eq './';
894         return File::Spec->catpath('', $dir, $name . "." . $lang . ".po");
895 }
896
897 sub pofiles ($) {
898         my $masterfile=shift;
899
900         return map pofile($masterfile, $_), @slavelanguages;
901 }
902
903 sub refreshpot ($) {
904         my $masterfile=shift;
905
906         my $potfile=potfile($masterfile);
907         my $doc=Locale::Po4a::Chooser::new(po4a_type($masterfile),
908                                            po4a_options($masterfile));
909         $doc->{TT}{utf_mode} = 1;
910         $doc->{TT}{file_in_charset} = 'UTF-8';
911         $doc->{TT}{file_out_charset} = 'UTF-8';
912         $doc->read($masterfile);
913         # let's cheat a bit to force porefs option to be passed to
914         # Locale::Po4a::Po; this is undocument use of internal
915         # Locale::Po4a::TransTractor's data, compulsory since this module
916         # prevents us from using the porefs option.
917         $doc->{TT}{po_out}=Locale::Po4a::Po->new({ 'porefs' => 'none' });
918         $doc->{TT}{po_out}->set_charset('UTF-8');
919         # do the actual work
920         $doc->parse;
921         IkiWiki::prep_writefile(basename($potfile),dirname($potfile));
922         $doc->writepo($potfile);
923 }
924
925 sub refreshpofiles ($@) {
926         my $masterfile=shift;
927         my @pofiles=@_;
928
929         my $potfile=potfile($masterfile);
930         if (! -e $potfile) {
931                 error("po(refreshpofiles) ".sprintf(gettext("POT file (%s) does not exist"), $potfile));
932         }
933
934         foreach my $pofile (@pofiles) {
935                 IkiWiki::prep_writefile(basename($pofile),dirname($pofile));
936
937                 if (! -e $pofile) {
938                         # If the po file exists in an underlay, copy it
939                         # from there.
940                         my ($pobase)=$pofile=~/^\Q$config{srcdir}\E\/?(.*)$/;
941                         foreach my $dir (@{$config{underlaydirs}}) {
942                                 if (-e "$dir/$pobase") {
943                                         File::Copy::syscopy("$dir/$pobase",$pofile)
944                                                 or error("po(refreshpofiles) ".
945                                                          sprintf(gettext("failed to copy underlay PO file to %s"),
946                                                                  $pofile));
947                                 }
948                         }
949                 }
950
951                 if (-e $pofile) {
952                         system("msgmerge", "--previous", "-q", "-U", "--backup=none", $pofile, $potfile) == 0
953                                 or error("po(refreshpofiles) ".
954                                          sprintf(gettext("failed to update %s"),
955                                                  $pofile));
956                 }
957                 else {
958                         File::Copy::syscopy($potfile,$pofile)
959                                 or error("po(refreshpofiles) ".
960                                          sprintf(gettext("failed to copy the POT file to %s"),
961                                                  $pofile));
962                 }
963         }
964 }
965
966 sub buildtranslationscache() {
967         # use istranslation's side-effect
968         map istranslation($_), (keys %pagesources);
969 }
970
971 sub resettranslationscache() {
972         undef %translations;
973 }
974
975 sub flushmemoizecache() {
976         Memoize::flush_cache("istranslatable");
977         Memoize::flush_cache("_istranslation");
978         Memoize::flush_cache("percenttranslated");
979 }
980
981 sub urlto_with_orig_beautiful_urlpath($$) {
982         my $to=shift;
983         my $from=shift;
984
985         inject(name => "IkiWiki::beautify_urlpath", call => $origsubs{'beautify_urlpath'});
986         my $res=urlto($to, $from);
987         inject(name => "IkiWiki::beautify_urlpath", call => \&mybeautify_urlpath);
988
989         return $res;
990 }
991
992 sub percenttranslated ($) {
993         my $page=shift;
994
995         $page=~s/^\///;
996         return gettext("N/A") unless istranslation($page);
997         my $file=srcfile($pagesources{$page});
998         my $masterfile = srcfile($pagesources{masterpage($page)});
999         my $doc=Locale::Po4a::Chooser::new(po4a_type($masterfile),
1000                                            po4a_options($masterfile));
1001         $doc->process(
1002                 'po_in_name'    => [ $file ],
1003                 'file_in_name'  => [ $masterfile ],
1004                 'file_in_charset'  => 'UTF-8',
1005                 'file_out_charset' => 'UTF-8',
1006         ) or error("po(percenttranslated) ".
1007                    sprintf(gettext("failed to translate %s"), $page));
1008         my ($percent,$hit,$queries) = $doc->stats();
1009         $percent =~ s/\.[0-9]+$//;
1010         return $percent;
1011 }
1012
1013 sub languagename ($) {
1014         my $code=shift;
1015
1016         return $master_language_name
1017                 if $code eq $master_language_code;
1018         return $config{po_slave_languages}{$code}
1019                 if defined $config{po_slave_languages}{$code};
1020         return;
1021 }
1022
1023 sub otherlanguagesloop ($) {
1024         my $page=shift;
1025
1026         my @ret;
1027         if (istranslation($page)) {
1028                 push @ret, {
1029                         url => urlto_with_orig_beautiful_urlpath(masterpage($page), $page),
1030                         code => $master_language_code,
1031                         language => $master_language_name,
1032                         master => 1,
1033                 };
1034         }
1035         foreach my $lang (@{otherlanguages_codes($page)}) {
1036                 next if $lang eq $master_language_code;
1037                 my $otherpage = otherlanguage_page($page, $lang);
1038                 push @ret, {
1039                         url => urlto_with_orig_beautiful_urlpath($otherpage, $page),
1040                         code => $lang,
1041                         language => languagename($lang),
1042                         percent => percenttranslated($otherpage),
1043                 }
1044         }
1045         return @ret;
1046 }
1047
1048 sub homepageurl (;$) {
1049         my $page=shift;
1050
1051         return urlto('', $page);
1052 }
1053
1054 sub ishomepage ($) {
1055         my $page = shift;
1056
1057         return 1 if $page eq 'index';
1058         map { return 1 if $page eq 'index.'.$_ } @slavelanguages;
1059         return undef;
1060 }
1061
1062 sub deletetranslations ($) {
1063         my $deletedmasterfile=shift;
1064
1065         my $deletedmasterpage=pagename($deletedmasterfile);
1066         my @todelete;
1067         map {
1068                 my $file = newpagefile($deletedmasterpage.'.'.$_, 'po');
1069                 my $absfile = "$config{srcdir}/$file";
1070                 if (-e $absfile && ! -l $absfile && ! -d $absfile) {
1071                         push @todelete, $file;
1072                 }
1073         } @slavelanguages;
1074
1075         map {
1076                 if ($config{rcs}) {
1077                         IkiWiki::rcs_remove($_);
1078                 }
1079                 else {
1080                         IkiWiki::prune("$config{srcdir}/$_");
1081                 }
1082         } @todelete;
1083
1084         if (@todelete) {
1085                 commit_and_refresh(
1086                         gettext("removed obsolete PO files"));
1087         }
1088 }
1089
1090 sub commit_and_refresh ($) {
1091         my $msg = shift;
1092
1093         if ($config{rcs}) {
1094                 IkiWiki::disable_commit_hook();
1095                 IkiWiki::rcs_commit_staged(
1096                         message => $msg,
1097                 );
1098                 IkiWiki::enable_commit_hook();
1099                 IkiWiki::rcs_update();
1100         }
1101         # Reinitialize module's private variables.
1102         resetalreadyfiltered();
1103         resettranslationscache();
1104         flushmemoizecache();
1105         # Trigger a wiki refresh.
1106         require IkiWiki::Render;
1107         # without preliminary saveindex/loadindex, refresh()
1108         # complains about a lot of uninitialized variables
1109         IkiWiki::saveindex();
1110         IkiWiki::loadindex();
1111         IkiWiki::refresh();
1112         IkiWiki::saveindex();
1113 }
1114
1115 sub po_to_markup ($$) {
1116         my ($page, $content) = (shift, shift);
1117
1118         $content = '' unless defined $content;
1119         $content = decode_utf8(encode_utf8($content));
1120         # CRLF line terminators make poor Locale::Po4a feel bad
1121         $content=~s/\r\n/\n/g;
1122
1123         # There are incompatibilities between some File::Temp versions
1124         # (including 0.18, bundled with Lenny's perl-modules package)
1125         # and others (e.g. 0.20, previously present in the archive as
1126         # a standalone package): under certain circumstances, some
1127         # return a relative filename, whereas others return an absolute one;
1128         # we here use this module in a way that is at least compatible
1129         # with 0.18 and 0.20. Beware, hit'n'run refactorers!
1130         my $infile = new File::Temp(TEMPLATE => "ikiwiki-po-filter-in.XXXXXXXXXX",
1131                                     DIR => File::Spec->tmpdir,
1132                                     UNLINK => 1)->filename;
1133         my $outfile = new File::Temp(TEMPLATE => "ikiwiki-po-filter-out.XXXXXXXXXX",
1134                                      DIR => File::Spec->tmpdir,
1135                                      UNLINK => 1)->filename;
1136
1137         my $fail = sub ($) {
1138                 my $msg = "po(po_to_markup) - $page : " . shift;
1139                 error($msg, sub { unlink $infile, $outfile});
1140         };
1141
1142         writefile(basename($infile), File::Spec->tmpdir, $content)
1143                 or return $fail->(sprintf(gettext("failed to write %s"), $infile));
1144
1145         my $masterfile = srcfile($pagesources{masterpage($page)});
1146         my $doc=Locale::Po4a::Chooser::new(po4a_type($masterfile),
1147                                            po4a_options($masterfile));
1148         $doc->process(
1149                 'po_in_name'    => [ $infile ],
1150                 'file_in_name'  => [ $masterfile ],
1151                 'file_in_charset'  => 'UTF-8',
1152                 'file_out_charset' => 'UTF-8',
1153         ) or return $fail->(gettext("failed to translate"));
1154         $doc->write($outfile)
1155                 or return $fail->(sprintf(gettext("failed to write %s"), $outfile));
1156
1157         $content = readfile($outfile);
1158
1159         # Unlinking should happen automatically, thanks to File::Temp,
1160         # but it does not work here, probably because of the way writefile()
1161         # and Locale::Po4a::write() work.
1162         unlink $infile, $outfile;
1163
1164         return $content;
1165 }
1166
1167 # returns a SuccessReason or FailReason object
1168 sub isvalidpo ($) {
1169         my $content = shift;
1170
1171         # NB: we don't use po_to_markup here, since Po4a parser does
1172         # not mind invalid PO content
1173         $content = '' unless defined $content;
1174         $content = decode_utf8(encode_utf8($content));
1175
1176         # There are incompatibilities between some File::Temp versions
1177         # (including 0.18, bundled with Lenny's perl-modules package)
1178         # and others (e.g. 0.20, previously present in the archive as
1179         # a standalone package): under certain circumstances, some
1180         # return a relative filename, whereas others return an absolute one;
1181         # we here use this module in a way that is at least compatible
1182         # with 0.18 and 0.20. Beware, hit'n'run refactorers!
1183         my $infile = new File::Temp(TEMPLATE => "ikiwiki-po-isvalidpo.XXXXXXXXXX",
1184                                     DIR => File::Spec->tmpdir,
1185                                     UNLINK => 1)->filename;
1186
1187         my $fail = sub ($) {
1188                 my $msg = '[po/isvalidpo] ' . shift;
1189                 unlink $infile;
1190                 return IkiWiki::FailReason->new("$msg");
1191         };
1192
1193         writefile(basename($infile), File::Spec->tmpdir, $content)
1194                 or return $fail->(sprintf(gettext("failed to write %s"), $infile));
1195
1196         my $res = (system("msgfmt", "--check", $infile, "-o", "/dev/null") == 0);
1197
1198         # Unlinking should happen automatically, thanks to File::Temp,
1199         # but it does not work here, probably because of the way writefile()
1200         # and Locale::Po4a::write() work.
1201         unlink $infile;
1202
1203         if ($res) {
1204                 return IkiWiki::SuccessReason->new("valid gettext data");
1205         }
1206         return IkiWiki::FailReason->new(gettext("invalid gettext data, go back ".
1207                                         "to previous page to continue edit"));
1208 }
1209
1210 sub po4a_type ($) {
1211         my $file = shift;
1212
1213         my $pagetype = pagetype($file);
1214         if ($pagetype eq 'html') {
1215                 return 'xhtml';
1216         }
1217         return 'text';
1218 }
1219
1220 sub po4a_options($) {
1221         my $file = shift;
1222
1223         my %options;
1224         my $pagetype = pagetype($file);
1225
1226         if ($pagetype eq 'html') {
1227                 # how to disable options is not consistent across po4a modules
1228                 $options{includessi} = '';
1229                 $options{includeexternal} = 0;
1230         }
1231         elsif ($pagetype eq 'mdwn') {
1232                 $options{markdown} = 1;
1233         }
1234         else {
1235                 $options{markdown} = 0;
1236         }
1237
1238         return %options;
1239 }
1240
1241 sub splitlangpair ($) {
1242         my $pair=shift;
1243
1244         my ($code, $name) = ( $pair =~ /^([a-z]{2})\|(.+)$/ );
1245         if (! defined $code || ! defined $name ||
1246             ! length $code || ! length $name) {
1247                 # not a fatal error to avoid breaking if used with web setup
1248                 print STDERR sprintf(gettext("%s has invalid syntax: must use CODE|NAME"),
1249                         $pair)."\n";
1250         }
1251
1252         return $code, $name;
1253 }
1254
1255 # ,----
1256 # | PageSpecs
1257 # `----
1258
1259 package IkiWiki::PageSpec;
1260
1261 sub match_istranslation ($;@) {
1262         my $page=shift;
1263
1264         if (IkiWiki::Plugin::po::istranslation($page)) {
1265                 return IkiWiki::SuccessReason->new("is a translation page");
1266         }
1267         else {
1268                 return IkiWiki::FailReason->new("is not a translation page");
1269         }
1270 }
1271
1272 sub match_istranslatable ($;@) {
1273         my $page=shift;
1274
1275         if (IkiWiki::Plugin::po::istranslatable($page)) {
1276                 return IkiWiki::SuccessReason->new("is set as translatable in po_translatable_pages");
1277         }
1278         else {
1279                 return IkiWiki::FailReason->new("is not set as translatable in po_translatable_pages");
1280         }
1281 }
1282
1283 sub match_lang ($$;@) {
1284         my $page=shift;
1285         my $wanted=shift;
1286
1287         my $regexp=IkiWiki::glob2re($wanted);
1288         my $lang=IkiWiki::Plugin::po::lang($page);
1289         if ($lang !~ /^$regexp$/i) {
1290                 return IkiWiki::FailReason->new("file language is $lang, not $wanted");
1291         }
1292         else {
1293                 return IkiWiki::SuccessReason->new("file language is $wanted");
1294         }
1295 }
1296
1297 sub match_currentlang ($$;@) {
1298         my $page=shift;
1299         shift;
1300         my %params=@_;
1301
1302         return IkiWiki::FailReason->new("no location provided") unless exists $params{location};
1303
1304         my $currentlang=IkiWiki::Plugin::po::lang($params{location});
1305         my $lang=IkiWiki::Plugin::po::lang($page);
1306
1307         if ($lang eq $currentlang) {
1308                 return IkiWiki::SuccessReason->new("file language is the same as current one, i.e. $currentlang");
1309         }
1310         else {
1311                 return IkiWiki::FailReason->new("file language is $lang, whereas current language is $currentlang");
1312         }
1313 }
1314
1315 sub match_needstranslation ($$;@) {
1316         my $page=shift;
1317         my $wanted=shift;
1318
1319         if (defined $wanted && $wanted ne "") {
1320                 if ($wanted !~ /^\d+$/) {
1321                         return IkiWiki::FailReason->new("parameter is not an integer");
1322                 }
1323                 elsif ($wanted > 100) {
1324                         return IkiWiki::FailReason->new("parameter is greater than 100");
1325                 }
1326         }
1327         else {
1328                 $wanted=100;
1329         }
1330
1331         my $percenttranslated=IkiWiki::Plugin::po::percenttranslated($page);
1332         if ($percenttranslated eq 'N/A') {
1333                 return IkiWiki::FailReason->new("file is not a translatable page");
1334         }
1335         elsif ($percenttranslated < $wanted) {
1336                 return IkiWiki::SuccessReason->new("file has $percenttranslated translated");
1337         }
1338         else {
1339                 return IkiWiki::FailReason->new("file is translated enough");
1340         }
1341 }
1342
1343 1