<domain name="papp" lang="en">

<description>simple editor for translation strings</description>

<import src="macro/editform"/>
<import pm="PApp::UserObs">access_p</import>

<perl><![CDATA[
   $ppkg->set_database($PApp::Config::Database);

   use Convert::Scalar ':utf8';
   use PApp::I18n qw(scan_file scan_init scan_end scan_field
                     normalize_langid translate_langid
                     export_dpo);

   sub domains { join ",", grep $S{domains}{$_}, keys %{$S{domains}} }
   sub langs   { join ",", "mul", grep $S{langs}{$_} && $S{lang} ne $_, keys %{$S{langs}} }
]]></perl>

<state keys="encoding" preferences="yes"/>

<macro name="encoding"><phtml><![CDATA[
   <?ef_sbegin:>__"Encoding:" <?ef_string \$S{encoding}, 12:><?ef_end:>
   <:$S{encoding} && content_type "text/html", $S{encoding}:>
]]></phtml></macro>

<module name="">
<state keys="domains langs lang appset" preferences="yes"/>
<phtml><![CDATA[
<:
   $S{lang} = normalize_langid($S{lang});
:>

<:my $log = capture {:>
#if $A{scan_apps} && !reload_p
<:
   my %domain;

   sub is_mul($) {
      # should be done inside PApp::I18n
      $_[0] =~ /[ \t\n,]/ ? "*" : $_[0];
   }

   for my $papp (values %PApp::papp) {
      # a) files
      my %files = $papp->files(1);
      while (my($k,$v) = each %files) {
         $domain{$v->{domain}}{file}{$k} = $v->{lang};
      }

      # b) database
      while (my($k,$v) = each %{$papp->{translate}}) {
         my ($database, $domain, $langs, $style) = @$v;
         $database ||= $papp->{database}; # should be properly fixed
         $domain{$domain}{table}{$k} = [$database, $langs, $style];
      }
   }

   while (my ($domain, $v) = each %domain) {
      defined $S{domains}{$domain} or next;
      use PApp::Lock;
      locked {
         echo "scanning domain $domain\n";
         scan_init $domain;
            while (my($path, $langs) = each %{$v->{file}}) {
               scan_file $path, is_mul $langs;
            }
            while (my($field, $v) = each %{$v->{table}}) {
               my ($database, $langs, $style) = @$v;
               scan_field $database, $field, $style, is_mul $langs;
            }
         scan_end;
      } "papp_poedit_scan_$domain", 60, 60*15;
   }
:>
#elsif $A{export_dpo} && !reload_p
<:
   for my $domain (grep $S{domains}{$_}, keys %{$S{domains}}) {
      print "exporting domain $domain to $PApp::i18ndir/$domain\n";
      export_dpo $domain, "$PApp::i18ndir/$domain";
   }
   PApp::Event::broadcast papp_i18n_flush => undef;
:>
#elsif $A{delete_unused} && !reload_p
<:
   sql_exec "delete from msgid where context = '' and find_in_set(domain, ?)",
            domains;
   
   PApp::I18n::reorganize_i18ndb();
:>
#endif
<:}:>

<table cellpadding="0" cellspacing="0" border="0" bgcolor="black"   width="100%"><tr><td>
<table cellpadding='4' cellspacing="1" border="0" bgcolor='#e0e0e0' width='100%'>
<tr><td>
   <h2>__"Translation Editor"</h2>
</td><td>
   <?ef_begin:>
   __"Application Set"&#160;
   <?ef_relation \$S{appset}, ["id, name from appset order by name"],
                  "%" => __"[ALL]", 0 => __"[DISABLED]":>
   <?ef_submit __"Set/Refresh":>
   <?ef_end:>
   <:encoding:>
</td></tr>

   <:
      my %domain;
      my %lang;

      $domain{$_} |= 2 for sql_fetchall "select distinct domain from msgid where domain != ''";
      $lang{$_}   |= 2 for sql_fetchall "select distinct lang from msgid where lang != ''";
      $lang{$_}   |= 2 for sql_fetchall "select distinct lang from msgstr where lang != ''";
      #d##FIXME# source langs and dest langs should not be interminglemixmashed

      my $st = sql_exec \my($id), "select id from app where id like ?", $S{appset};
      while ($st->fetch) {
         my $papp = load_app PApp $id;
         my %files = $papp->files;
         while (my ($k, $v) = each %files) {
            $domain{$v->{domain}} |= 1 if defined $v->{domain};
            $lang  {$v->{lang}}   |= 1 if defined $v->{lang};
         }

         for (values %{$papp->{translate}}) {
            $domain{$_->[1]} |= 1 if defined $_->[1];
            $lang{$_->[0]}   |= 1 if defined $lang{$_->[0]};
         }
      }

      exists $domain{$_} || delete $S{domains}{$_} for keys %{$S{domains}};
      exists $lang  {$_} || delete $S{langs}  {$_} for keys %{$S{langs}};
   :>

<tr><td valign='top'>
   <h3>__"Translation Domains"</h3>
   <:
      my $tdom;
      my $postar = access_p "poedit_*";
      for (sort keys %domain) {
         $domain{$_} & 1 or echo "<em>";
         if (!($postar || access_p "poedit_$_")) {
            #echo "<small>[$_]</small>";
            delete $S{domains}{$_};
         } elsif ($S{domains}{$_}) {
            echo slink "<b>+$_+</b>", SURL_SAVE_PREFS, \$S{domains}{$_} => undef;
            $tdom++;
         } else {
            echo slink "<small>$_</small>", SURL_SAVE_PREFS, \$S{domains}{$_} => 1;
         }
         $domain{$_} & 1 or echo "</em>";
         echo " ";
      }
      $tdom or echo '<br /><font color="red">', __"no translation domain selected", '</font>';
   :>
</td>
<td valign='top'>
   <h3>__"Source Languages"</h3>
   <:
      my $slang;
      for (sort keys %lang) {
         if ($_ eq "*") {
            unless ($S{langs}{"*"}) {
               $S{langs}{"*"} = 1;
               save_prefs;
            }
         } else {
            $lang{$_} & 1 or echo "<em>";
            if ($S{langs}{$_}) {
               echo slink "<b>+$_+</b>", SURL_SAVE_PREFS, \$S{langs}{$_} => undef;
               $slang++;
            } else {
               echo slink "<small>$_</small>", SURL_SAVE_PREFS, \$S{langs}{$_} => 1;
            }
            $lang{$_} & 1 or echo "</em>";
            echo " ";
         }
      }
      $slang or echo '<br /><font color="red">', __"no source languages selected", '</font>';
   :>
</td>
</tr>
<tr><td valign='middle'>
__"<small>
      <b>+selected+</b>: currently selected for editing.<br />
      <small>unselected</small>: editing possible.<br />
      <em>emphasize</em>: not used by any mounted application.<br />
   </small>"
</td>
<td>
   <h3>__"Target Language"</h3>
   <table><tr>
      <:$S{lang} ||= (keys %lang)[0]:>
      <:$lang{$S{lang}} ||= 4:>

      <?ef_sbegin SURL_SAVE_PREFS:>
         <td><?ef_selectbox \$S{lang},
                  map {
                         ($_, "$_ [".translate_langid($_, papp_ppkg_table->lang)."]")
                      } grep $_ ne "*", sort keys %lang
             :></td>
         <td><?ef_submit __"Set":></td>
      <?ef_end:>

      <?ef_sbegin SURL_SAVE_PREFS:>
         <td><?ef_string \$S{lang}, 10:></td>
         <td><?ef_submit __"Set":></td>
      <?ef_end:>

   </tr></table>
</td>
</tr>

<:
   sql_fetch \my($cnt, $unt), "select count(*), sum(~flags & 1)
                               from msgstr, msgid
                               where msgstr.nr = msgid.nr
                                     and msgstr.lang = ?
                                     and find_in_set(domain, ?)
                                     and find_in_set(msgid.lang, ?)
                              ",
                              $S{lang}, domains, langs;
   sql_fetch \my($cnt2, $unu),
                              "select count(case when s.nr is null then 1 end),
                                      count(case when context = '' then 1 end)
                               from msgid i left join msgstr s
                                    on (i.nr = s.nr and s.lang = ?)
                               where find_in_set(domain, ?)
                                     and i.lang != ?
                              ",
                              $S{lang}, domains, $S{lang};
:>

<tr><td valign='top'>
   <h2>__"Domain Management"</h2>
</td><td>
   <?slink __"Scan selected domains", -scan_apps => 1:> __"(can take a long time!)"<br />
   <?slink __"Write selected translation domains", -export_dpo => 1:><br />
   __"Unused messages": <?$unu:><br />
   <?slink __"Delete unused messages and reorganize database", -delete_unused => 1:><br />
</td></tr>

<tr><td valign='top'>
#if $S{lang}
   <h2>__"Selected Target Language ID:" <?$S{lang}:></h2>
   <:
      my $trans = translate_langid $S{lang}, papp_ppkg_table->lang;
      if ($trans) {
         echo __"Target Language", ": $trans";
      } else {
         echo "<font color='red'>";
         printf __"\"<tt>%s</tt>\" is a non-standard language id", $S{lang};
         echo "</font>";
      }
   :>
</td><td>
   <p>
      __"Total number of messages": <?$cnt + $cnt2:><br />
      __"Untranslated or fuzzy messages": <?$unt + $cnt2:><br />
   </p>

   <?slink __"View/Edit all translations", "view", where => "1=1":><br />
   <?slink __"View/Edit non-valid translations", "view", where => "(flags is null or flags & 1 = 0)":><br />
#endif
</td></tr>
#if $log
<tr><td colspan='2'>
<small><pre><?$log:></pre></small>
</td></tr>
#endif
</table>
</td></tr></table>

]]></phtml>
</module>

<module name="view" nosession="">
<state keys="where begin" local="yes"/>
<state keys="window" preferences="yes"/>
<phtml><![CDATA[

<table cellpadding="0" cellspacing="0" border="0" bgcolor="black"   width="100%"><tr><td>
<table cellpadding='4' cellspacing="1" border="0" bgcolor='#e0e0e0' width='100%'>
   <tr><td>
      <table width="100%"><tr><td>
         <h2>__"Translation Entries"</h2>
      </td><td align="right">
         <:encoding:>
      </td></tr>
      </table>
   </td></tr>
   <tr><td><?slink __"Back to the translation menu", "":></td></tr>
</table>
</td></tr></table>
<br />
<?ef_sbegin:>
<table cellpadding="0" cellspacing="0" border="0" bgcolor="black"   width="100%"><tr><td>
<table cellpadding='4' cellspacing="1" border="0" bgcolor='#e0e0e0' width='100%'>
<tr><td>__"Limit view to entries containing"&#160;<?ef_string \$S{search}:></td></tr>
<tr><td>

   <: $S{begin}  ||=  0 :>
   <: $S{window} ||= 20 :>

   <?slink __"&lt;&lt;&lt;PREV&lt;&lt;&lt;", begin => $S{begin} > $S{window} ? $S{begin} - $S{window} : 0:> ===
   <?slink __"&gt;&gt;&gt;NEXT&gt;&gt;&gt;", begin => $S{begin} + $S{window}:>
   <table cellspacing="0" cellpadding="2" border="0" width="100%">
   <tr>
      <th align="left" width="10%">__"domain"</th>
      <th align="left" width="5%">__"flags"</th>
      <th align="left" width="5%">__"lang"</th>
      <th align="left" width="40%">__"message"</th>
      <th align="left" width="40%">__"translation"</th>
   </tr>
   <:
      my $where = $S{where};

      $where .= " and (id like '%$S{search}%' or msg like '%$S{search}%')" if $S{search};

      my $st = sql_exec \my($nr, $msgid, $idlang, $domain, $msgstr, $ok),
                        "select i.nr, id, i.lang, i.domain, msg, flags
                                from msgid i left join msgstr s on (i.nr = s.nr and s.lang = ?)
                                where find_in_set(domain, ?)
                                      and find_in_set(i.lang, ?)
                                      and $where
                                order by i.nr, i.domain
                                limit ?,?",
                        $S{lang}, domains, langs,
                        $S{begin}||0, $S{window}||20;

      my $count = 0;
      while($st->fetch) {
         printf "<tr bgcolor='#%s'>", $count++ & 1 ? "e0e0e0" : "f0f0f0";
         $msgstr = __"<not set>" unless defined $msgstr;
         for ($msgid, $msgstr) {
            utf8_on $_;
            $_ = (substr $_, 0, 38)."..." if length($_) > 40;
            #s/([\x00-\x1f])/"\\c{".ord($1)."}"/ge;
         }
         :><td><?$domain:></td><:
         echo "<td>", (slink escape_html($_) || "&#160;", "edit", nr => $nr), "</td>\n" for ($ok, $idlang, $msgid, $msgstr);
         echo "</tr>";
      }
   :>
   </table>
   <?slink __"&lt;&lt;&lt;PREV&lt;&lt;&lt;", begin => $S{begin} > $S{window} ? $S{begin} - $S{window} : 0:> ===
   <?slink __"&gt;&gt;&gt;NEXT&gt;&gt;&gt;", begin => $S{begin} + $S{window}:>
</td></tr>
</table>
</td></tr></table>
<?ef_end:>

]]></phtml></module>

<module name="edit" nosession="">
<state keys="where begin nr" local="yes"/>
<state keys="msgstr msgid" local="yes"/>
<state keys="width" preferences="yes"/>
<phtml><![CDATA[
<table cellpadding="0" cellspacing="0" border="0" bgcolor="black"   width="100%"><tr><td>
<table cellpadding='4' cellspacing="1" border="0" bgcolor='#e0e0e0' width='100%'>
   <tr><td colspan="2">
      <table width="100%"><tr><td>
         <h2>__"Edit a translation entry"</h2>
      </td><td align="right">
         <:encoding:>
      </td></tr>
      </table>
   </td></tr>
   <tr><td colspan="2"><?slink __"Back to the translation menu", "":></td></tr>
   <tr><td colspan="2"><?slink __"Return to the directory view", "view":></td></tr>
</table>
</td></tr></table>
<br />
<?cform:>
<table cellpadding="0" cellspacing="0" border="0" bgcolor="black"   width="100%"><tr><td>
<table cellpadding='4' cellspacing="1" border="0" bgcolor='#e0e0e0' width='100%'>
   <:
      #$P{msgstr} =~ s/\s*\n\s*/ /g if defined $P{msgstr};
      #$P{msgstr} = $S{msgid} if $P{msgstr} eq "";

      if ($P{already}) {
         $P{msgstr} = "";
         $P{savenext} = 1;
      }

      if ($P{save} || $P{savenext}) {
         if ($S{msgid} =~ /\\n$/) {
            $P{msgstr} =~ s/\n*$/\n/;
         } else {
            $P{msgstr} =~ s/\n+$//;
         }
         utf8_upgrade $P{msgstr};
         sql_exec "update msgstr set msg = ?, flags = ? where nr = ? and lang = ?",
                  $P{msgstr}, defined $P{ok} ? "valid" : "",
                  $S{nr}, $S{lang};
      }

      if ($P{savenext} || $P{next}) {
         delete $P{msgstr};

         my $onr = $S{nr};

         retry:
         # save next etc.. doesn't work - always displays congrats #FIXME#d#

         my $where = $S{where};
         $where .= " and (id like '%$S{search}%' or msg like '%$S{search}%')" if $S{search};

         $S{nr} = sql_fetch \my($nr, $msgid, $idlang, $domain, $msgstr, $ok),
                           "select i.nr, id, i.lang, i.domain, msg, flags
                                   from msgid i left join msgstr s on (i.nr = s.nr and s.lang = ?)
                                   where i.nr > ?
                                         and find_in_set(domain, ?)
                                         and find_in_set(i.lang, ?)
                                         and $where
                                   order by i.nr, i.domain
                                   limit 1",
                           $S{lang}, $onr, domains, langs;

         if (!$S{nr} && $onr) { # wrap-around
            $onr = 0;
            goto retry;
         }
         if (!$S{nr}) {
            $S{nr} = sql_fetch "select min(nr) from msgid";
            :>
              <tr><td bgcolor='#f08080' colspan="2"><font size="+3">
              __"Congrats, there are no more untranslated entries"
              </font></td></tr>
            <:
         }
      }

      sql_fetch \my($msgid, $msgstr, $context, $idlang, $domain),
                "select id, msg, context, i.lang, i.domain
                 from msgid i left join msgstr s on (i.nr = s.nr and s.lang = ?)
                 where i.nr = ?",
                $S{lang}, $S{nr};

      utf8_on $msgid;
      utf8_on $msgstr;

      unless (defined $msgstr) {
         my $trans = PApp::I18n::fuzzy_translation $msgid;
         $msgstr = $trans->{$S{lang}};
         sql_exec "insert into msgstr (nr, lang, flags, msg) values (?, ?, 'fuzzy', ?)",
                  $S{nr}, $S{lang}, $msgstr || "";
      }

      if (!$P{reset} && defined $P{msgstr}) {
         $msgstr = $P{msgstr};
      }

      $S{msgid} = $msgid;

      for ($msgid, $msgstr, $context) {
         $_ = PApp::HTML::escape_html $_;
      }
      $msgid =~ s/\r?\n/\n<br \/>/g;
      $context =~ s/\n/<br \/>/g;

      $S{width} ||= 70;

      $S{width} += 3 if $P{incwidth};
      $S{width} -= 3 if $P{decwidth};

      PApp::save_prefs;

      my $lines = int (length($msgid) / $S{width}) + 15;
   :>

   <:
      my $menu = capture {:>
          <?submit "refresh", __"Refresh":>
          <?submit "reset", __"Reset":>
          <?submit "save", __"Save":>
          <?submit "savenext", __"Save & Next":>
          <?submit "next", __"Next":>
          <br />
      <:}
   :>

   <tr><th width="48%"><?
                         Convert::Scalar::utf8_on #d# DEVEL7952, DEVEL9021
                         sprintf __"Message (in language '%s')", $idlang:></th><th width="48%">
          <?submit "decwidth", "<<<<<":>
          <?
            Convert::Scalar::utf8_on #d# DEVEL7952, DEVEL9021, DEVEL9916
            sprintf __"Translation (to language '%s')", $S{lang}:>
          <?submit "incwidth", ">>>>>":>
       </th></tr>
   <tr><td>
          <font size="+1">
          __"domain" <?$domain:><br />
          </font>
       </td><td>
          <?$menu:>
          <?checkbox "ok", "ok", 1:> __"Valid?"
          <?submit "already", __"Skip message (already in the correct language)":>
       </td></tr>
   <tr><td valign="top">
          <table cellpadding="6"><tr><td><tt><?$msgid:></tt></td></tr></table>
       </td><td valign="top" cellpadding="0" cellspacing="0">
          <textarea name="msgstr" rows="<?$lines:>" cols="<?$S{width}:>" wrap="wrap"><?$msgstr:></textarea>
       </td></tr>
   <tr><td>&#160;</td>
          <td><?$menu:></td></tr>
   <tr><td valign="top" colspan="2">
          <tt><?$context:></tt>
       </td>
   </tr>
</table>
<?endform:>
</td></tr></table>

]]></phtml></module>

</domain>

