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