home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / bin / podebconf-display-po < prev    next >
Encoding:
Text File  |  2006-06-28  |  12.2 KB  |  316 lines
  1. #!/usr/bin/perl -w
  2.  
  3. use strict;
  4. use File::Temp;
  5. use Getopt::Long;
  6.  
  7. sub usage {
  8.         my $rc = shift;
  9.         print "Usage: podebconf-display-po [-h] [-f frontend] file.po\n";
  10.         exit($rc);
  11. }
  12.  
  13. my $help = 0;
  14. my $frontend = '';
  15. Getopt::Long::Configure('bundling');
  16. Getopt::Long::GetOptions(
  17.         "h|help" => \$help,
  18.         "f|frontend=s" => \$frontend,
  19. ) || usage(1);
  20. usage(0) if $help;
  21. usage(1) if $#ARGV != 0;
  22.  
  23. sub unescapechar {
  24.         my $char = shift;
  25.         if ($char eq 'n') {
  26.                 # Add a space to conform to debconf templates format
  27.                 return "\n ";
  28.         } elsif ($char eq 't') {
  29.                 return "\t";
  30.         } elsif ($char eq 'r') {
  31.                 return "\r";
  32.         } else {
  33.                 #  Fallback also works for \\ and \"
  34.                 return $char;
  35.         }
  36. }
  37. sub unescapestr {
  38.         my $text = shift;
  39.         my $out = '';
  40.         my $last = 0;
  41.         while ($text =~ m/\G([^\\]*)\\([ntr"\\])/g) {
  42.                 $last = pos($text);
  43.                 $out .= $1 . unescapechar($2);
  44.         }
  45.         $out .= substr($text, $last);
  46.         return $out;
  47. }
  48. #  Format 1: No "Type:" in comments
  49. #  Format 2: Only one reference per string and file, line numbers
  50. #            match the ones in templates files
  51. #  Format 3: All references are written into PO files; first template
  52. #            is numbered from 1001, 2nd from 2001 etc.
  53. sub guessFormat {
  54.         my $text = shift;
  55.         return 1 unless $text =~ m/^#\. Type:/;
  56.         while ($text =~ s/#:\s*([^:\s]+):(\d+)/#:/) {
  57.                 my ($file,$line) = ($1, $2);
  58.                 return 2 if $line < 1000;
  59.         }
  60.         return 3;
  61. }
  62.  
  63. #  1.  Read the PO file and write a fake templates file
  64.  
  65. my $fields = {};
  66. my $rfc822Format = 0;
  67.  
  68. #  Recode PO files into UTF-8 to avoid stateful encodings
  69. {
  70.         open(PO, "msgconv -t UTF-8 $ARGV[0] |")
  71.                 or die "'msgconv -t UTF-8 $ARGV[0]' failed: $!\n";
  72.         local $/ = "\n\n";
  73.         while (<PO>) {
  74.                 next unless m/^msgid/m;
  75.                 s/"\n"//g;
  76.                 #  Skip header entry
  77.                 next if m/^msgid ""$/m;
  78.  
  79.                 my $type = '';
  80.                 my $field = '';
  81.                 m/^msgid "(.*)"/m;
  82.                 my $msgid = unescapestr($1);
  83.                 m/^msgstr "(.*)"/m;
  84.                 my $msgstr = unescapestr($1);
  85.                 #  Escape dollar signs to prevent variable substitutions
  86.                 $msgid =~ s/\$/\${dollarsign}/g;
  87.                 $msgstr =~ s/\$/\${dollarsign}/g;
  88.                 $rfc822Format = guessFormat($_) if $rfc822Format == 0;
  89.                 while (s/#:\s*([^:\s]+):(\d+)/#:/) {
  90.                         my ($file,$line) = ($1, $2);
  91.                         if ($rfc822Format == 1) {
  92.                                 #  Old format
  93.                                 1 while (s/^#\.\s+(.*)//m);
  94.                                 $field = $1;
  95.                         } else {
  96.                                 #  New format
  97.                                 s/^#\. Type:\s*(\S+)\n//;
  98.                                 $type = lc($1);
  99.                                 #  The error type is a cdebconf extension.
  100.                                 $type = 'note' if $type eq 'error';
  101.                                 s/^#\. (\S+)\n//;
  102.                                 $field = $1;
  103.                         }
  104.                         $field = ucfirst($field);
  105.                         $fields->{$file} = {} unless defined($fields->{$file});
  106.                         if (defined $fields->{$file}->{$line}) {
  107.                                 if ($field eq 'Choices') {
  108.                                         $fields->{$file}->{$line}->{msgid} .= ", ".$msgid;
  109.                                         $fields->{$file}->{$line}->{msgstr} .= ", ".$msgstr;
  110.                                 } else {
  111.                                         $fields->{$file}->{$line}->{msgid} .= "\n ".($fields->{$file}->{$line}->{msgid} =~ m/\n/ ? ".\n " : '').$msgid;
  112.                                         $fields->{$file}->{$line}->{msgstr} .= "\n ".($fields->{$file}->{$line}->{msgstr} =~ m/\n/ ? ".\n " : '').$msgstr;
  113.                                 }
  114.                         } else {
  115.                                 $fields->{$file}->{$line} = {
  116.                                         type => $type,
  117.                                         field => $field,
  118.                                         msgid => $msgid,
  119.                                         msgstr => $msgstr,
  120.                                         line => $line,
  121.                                 };
  122.                         }
  123.                         last if $rfc822Format < 3;
  124.                 }
  125.         }
  126.         close(PO);
  127. }
  128.  
  129. #  Translated fields in the generated templates file will be written
  130. #  with an extension which is suitable for current user's environment.
  131. #  Of course, there will be trouble if there is some encoding mismatch.
  132. my $lang = $ENV{LANGUAGE} || $ENV{LC_ALL} || $ENV{LC_MESSAGES} || $ENV{LANG} || $ARGV[0];
  133. #  For LANGUAGE
  134. $lang =~ s/:.*//;
  135. #  For filename
  136. $lang =~ s{.*/}{};
  137. $lang =~ s/\.po$//;
  138. #  For locale variables.  Charset and modifiers have to be stripped.
  139. $lang =~ s/[.@].*//;
  140.  
  141. my $count = 0;
  142. my $new = 1;
  143. my $choices = 0;
  144. my @tempfiles = ();
  145. my ($fh, $template) = File::Temp::tempfile()
  146.         or die "Unable to write temporary files";
  147. push (@tempfiles, $template);
  148. $SIG{INT} = sub { unlink (@tempfiles); exit(1); };
  149.  
  150. my $titles = {};
  151.  
  152. #  TODO: Refactor this code
  153. if ($rfc822Format < 3) {
  154.         for my $file (keys %$fields) {
  155.                 for (sort { $a <=> $b } keys %{$fields->{$file}}) {
  156.                         $titles->{$count} = 1 if ($fields->{$file}->{$_}->{type} =~ m/title/);
  157.                         print $fh "Template: foo/bar$count\n" if $new;
  158.                         if ($fields->{$file}->{$_}->{field} eq 'Description') {
  159.                                 print $fh "Type: ".
  160.                                         (length($fields->{$file}->{$_}->{type}) ?
  161.                                          $fields->{$file}->{$_}->{type} :
  162.                                          ($choices ?  "select" : "string"))."\n";
  163.                         } elsif ($fields->{$file}->{$_}->{field} eq 'Choices') {
  164.                                 $choices = 1;
  165.                         } elsif ($fields->{$file}->{$_}->{field} eq 'DefaultChoice') {
  166.                                 $fields->{$file}->{$_}->{field} = 'Default';
  167.                         }
  168.                         if ($fields->{$file}->{$_}->{field} eq 'Description' && $choices == 0 && $fields->{$file}->{$_}->{type} =~ m/select/)
  169.                         {
  170.                                 #   Dummy Choices field, needed to display the
  171.                                 #   question.
  172.                                 print $fh "Choices: dummy1, dummy2\n";
  173.                         }
  174.                         print $fh "$fields->{$file}->{$_}->{field}: $fields->{$file}->{$_}->{msgid}\n";
  175.                         print $fh "$fields->{$file}->{$_}->{field}-$lang.UTF-8: $fields->{$file}->{$_}->{msgstr}\n";
  176.                         $new = 0;
  177.                         if ($fields->{$file}->{$_}->{field} eq 'Description') {
  178.                                 $count++;
  179.                                 $new = 1;
  180.                                 $choices = 0;
  181.                                 print $fh "\n";
  182.                         }
  183.                 }
  184.         }
  185. }
  186. else
  187. {
  188.         my $text = "";
  189.         my %last = ();
  190.         for my $file (keys %$fields) {
  191.                 my $oldTemplateNr = 0;
  192.                 for (sort { $a <=> $b } keys %{$fields->{$file}}) {
  193.                         $titles->{$count} = 1 if ($fields->{$file}->{$_}->{type} =~ m/title/);
  194.                         my $newTemplateNr = sprintf("%d", $_ / 1000);
  195.                         if ($newTemplateNr != $oldTemplateNr) {
  196.                                 if ($count > 0) {
  197.                                         printf $fh "\nTemplate: foo/bar%d\n", $count - 1;
  198.                                         print $fh "Type: ".
  199.                                                 (length($last{type}) ?  $last{type} :
  200.                                                  ($choices ?  "select" : "string"))."\n";
  201.                                         if ($choices == 0 && $last{type} =~ m/select/)
  202.                                         {
  203.                                                 #   Dummy Choices field, needed to display the
  204.                                                 #   question.
  205.                                                 print $fh "Choices: dummy1, dummy2\n";
  206.                                         }
  207.                                         print $fh "$text\n";
  208.                                 }
  209.                                 $count++;
  210.                                 $choices = 0;
  211.                                 $text = "";
  212.                                 $oldTemplateNr = $newTemplateNr;
  213.                                 %last = %{$fields->{$file}->{$_}};
  214.                         }
  215.                         if ($fields->{$file}->{$_}->{field} eq 'Choices') {
  216.                                 $choices = 1;
  217.                         } elsif ($fields->{$file}->{$_}->{field} eq 'DefaultChoice') {
  218.                                 $fields->{$file}->{$_}->{field} = 'Default';
  219.                         }
  220.                         # debconf is kind enough to not display a Select question if there
  221.                         # is only one choice, so add a dummy item
  222.                         if ($fields->{$file}->{$_}->{field} eq 'Choices' && $fields->{$file}->{$_}->{type} eq 'select' && $fields->{$file}->{$_}->{msgid} !~ /,/) {
  223.                                 $fields->{$file}->{$_}->{msgid} .= ", dummy2";
  224.                                 $fields->{$file}->{$_}->{msgstr} .= ", dummy2";
  225.                         }
  226.                         $text .= "$fields->{$file}->{$_}->{field}: $fields->{$file}->{$_}->{msgid}\n";
  227.                         $text .= "$fields->{$file}->{$_}->{field}-$lang.UTF-8: $fields->{$file}->{$_}->{msgstr}\n";
  228.                 }
  229.         }
  230.         if ($text ne "") {
  231.                 printf $fh "Template: foo/bar%d\n", $count - 1;
  232.                 print $fh "Type: ".
  233.                         (length($last{type}) ?  $last{type} :
  234.                          ($choices ?  "select" : "string"))."\n";
  235.                 if ($choices == 0 && $last{type} =~ m/select/)
  236.                 {
  237.                         #   Dummy Choices field, needed to display the
  238.                         #   question.
  239.                         print $fh "Choices: dummy1, dummy2\n";
  240.                 }
  241.                 print $fh "$text";
  242.         }
  243. }
  244. close($fh);
  245.  
  246. #  2.  Load the templates file in debconf DB
  247.  
  248. use Debconf::Db;
  249. use Debconf::AutoSelect qw(:all);
  250. use Debconf::Config;
  251.  
  252. my ($dbth, $dbt) = File::Temp::tempfile()
  253.         or die "Unable to write temporary files";
  254. my ($dbch, $dbc) = File::Temp::tempfile()
  255.         or die "Unable to write temporary files";
  256. push (@tempfiles, $dbt, $dbc);
  257.  
  258. my %hashconfig = (
  259.         driver => "File",
  260.         mode => '0600',
  261.         name => "config",
  262.         backup => 0,
  263.         filename => $dbc
  264. );
  265. my %hashtemplates = (
  266.         driver => "File",
  267.         mode => '0600',
  268.         name => "templates",
  269.         backup => 0,
  270.         filename => $dbt
  271. );
  272.  
  273. $Debconf::Db::config=Debconf::Db->makedriver(%hashconfig);
  274. $Debconf::Db::templates=Debconf::Db->makedriver(%hashtemplates);
  275. Debconf::Template->load($template, 'display');
  276. Debconf::Db->save;
  277. unlink $template;
  278.  
  279. # 3.  Display questions
  280.  
  281. $Debconf::Db::config=Debconf::Db->makedriver(%hashconfig);
  282. $Debconf::Db::templates=Debconf::Db->makedriver(%hashtemplates);
  283. Debconf::Config->frontend($frontend) if length($frontend);
  284. my $dc_frontend=make_frontend();
  285. my $dc_confmodule=make_confmodule();
  286. my $code=127;
  287.  
  288. my $cnt = 0;
  289. while (1) {
  290.     $_="RESET foo/bar$cnt\n";
  291.     my $ret=$dc_confmodule->process_command($_);
  292.     if ($titles->{$cnt}) {
  293.         $_="SETTITLE foo/bar$cnt\n";
  294.         $ret=$dc_confmodule->process_command($_);
  295.         $cnt++;
  296.         next;
  297.     }
  298.     $_="SUBST foo/bar$cnt dollarsign \$\n";
  299.     $ret=$dc_confmodule->process_command($_);
  300.     $_="INPUT high foo/bar$cnt\n";
  301.     $ret=$dc_confmodule->process_command($_);
  302.     ($code, undef)=split(/ /, $ret, 2);
  303.     last if $code ne 0 && $code ne 30;
  304.     $_="GO\n";
  305.     $ret=$dc_confmodule->process_command($_);
  306.     ($code, undef)=split(/ /, $ret, 2);
  307.     $cnt++;
  308. }
  309.  
  310. $dc_frontend->shutdown;
  311. $dc_confmodule->finish;
  312. Debconf::Db->save;
  313. unlink $dbt, $dbc;
  314.  
  315. 1;
  316.