home *** CD-ROM | disk | FTP | other *** search
/ Personal Computer World 2007 September / PCWSEP07.iso / Software / Linux / Linux Mint 3.0 Light / LinuxMint-3.0-Light.iso / casper / filesystem.squashfs / usr / bin / podebconf-display-po < prev    next >
Encoding:
Text File  |  2006-12-12  |  12.3 KB  |  318 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.                                 if (s/^#\. Type:\s*(\S+)\n//) {
  98.                                         $type = lc($1);
  99.                                 }
  100.                                 #  The error type is a cdebconf extension.
  101.                                 $type = 'note' if $type eq 'error';
  102.                                 if (s/^#\. (\S+)\n//) {
  103.                                         $field = $1;
  104.                                 }
  105.                         }
  106.                         $field = ucfirst($field);
  107.                         $fields->{$file} = {} unless defined($fields->{$file});
  108.                         if (defined $fields->{$file}->{$line}) {
  109.                                 if ($field eq 'Choices') {
  110.                                         $fields->{$file}->{$line}->{msgid} .= ", ".$msgid;
  111.                                         $fields->{$file}->{$line}->{msgstr} .= ", ".$msgstr;
  112.                                 } else {
  113.                                         $fields->{$file}->{$line}->{msgid} .= "\n ".($fields->{$file}->{$line}->{msgid} =~ m/\n/ ? ".\n " : '').$msgid;
  114.                                         $fields->{$file}->{$line}->{msgstr} .= "\n ".($fields->{$file}->{$line}->{msgstr} =~ m/\n/ ? ".\n " : '').$msgstr;
  115.                                 }
  116.                         } else {
  117.                                 $fields->{$file}->{$line} = {
  118.                                         type => $type,
  119.                                         field => $field,
  120.                                         msgid => $msgid,
  121.                                         msgstr => $msgstr,
  122.                                         line => $line,
  123.                                 };
  124.                         }
  125.                         last if $rfc822Format < 3;
  126.                 }
  127.         }
  128.         close(PO);
  129. }
  130.  
  131. #  Translated fields in the generated templates file will be written
  132. #  with an extension which is suitable for current user's environment.
  133. #  Of course, there will be trouble if there is some encoding mismatch.
  134. my $lang = $ENV{LANGUAGE} || $ENV{LC_ALL} || $ENV{LC_MESSAGES} || $ENV{LANG} || $ARGV[0];
  135. #  For LANGUAGE
  136. $lang =~ s/:.*//;
  137. #  For filename
  138. $lang =~ s{.*/}{};
  139. $lang =~ s/\.po$//;
  140. #  For locale variables.  Charset and modifiers have to be stripped.
  141. $lang =~ s/[.@].*//;
  142.  
  143. my $count = 0;
  144. my $new = 1;
  145. my $choices = 0;
  146. my @tempfiles = ();
  147. my ($fh, $template) = File::Temp::tempfile()
  148.         or die "Unable to write temporary files";
  149. push (@tempfiles, $template);
  150. $SIG{INT} = sub { unlink (@tempfiles); exit(1); };
  151.  
  152. my $titles = {};
  153.  
  154. #  TODO: Refactor this code
  155. if ($rfc822Format < 3) {
  156.         for my $file (keys %$fields) {
  157.                 for (sort { $a <=> $b } keys %{$fields->{$file}}) {
  158.                         $titles->{$count} = 1 if ($fields->{$file}->{$_}->{type} =~ m/title/);
  159.                         print $fh "Template: foo/bar$count\n" if $new;
  160.                         if ($fields->{$file}->{$_}->{field} eq 'Description') {
  161.                                 print $fh "Type: ".
  162.                                         (length($fields->{$file}->{$_}->{type}) ?
  163.                                          $fields->{$file}->{$_}->{type} :
  164.                                          ($choices ?  "select" : "string"))."\n";
  165.                         } elsif ($fields->{$file}->{$_}->{field} eq 'Choices') {
  166.                                 $choices = 1;
  167.                         } elsif ($fields->{$file}->{$_}->{field} eq 'DefaultChoice') {
  168.                                 $fields->{$file}->{$_}->{field} = 'Default';
  169.                         }
  170.                         if ($fields->{$file}->{$_}->{field} eq 'Description' && $choices == 0 && $fields->{$file}->{$_}->{type} =~ m/select/)
  171.                         {
  172.                                 #   Dummy Choices field, needed to display the
  173.                                 #   question.
  174.                                 print $fh "Choices: dummy1, dummy2\n";
  175.                         }
  176.                         print $fh "$fields->{$file}->{$_}->{field}: $fields->{$file}->{$_}->{msgid}\n";
  177.                         print $fh "$fields->{$file}->{$_}->{field}-$lang.UTF-8: $fields->{$file}->{$_}->{msgstr}\n";
  178.                         $new = 0;
  179.                         if ($fields->{$file}->{$_}->{field} eq 'Description') {
  180.                                 $count++;
  181.                                 $new = 1;
  182.                                 $choices = 0;
  183.                                 print $fh "\n";
  184.                         }
  185.                 }
  186.         }
  187. }
  188. else
  189. {
  190.         my $text = "";
  191.         my %last = ();
  192.         for my $file (keys %$fields) {
  193.                 my $oldTemplateNr = 0;
  194.                 for (sort { $a <=> $b } keys %{$fields->{$file}}) {
  195.                         $titles->{$count} = 1 if ($fields->{$file}->{$_}->{type} =~ m/title/);
  196.                         my $newTemplateNr = sprintf("%d", $_ / 1000);
  197.                         if ($newTemplateNr != $oldTemplateNr) {
  198.                                 if ($count > 0) {
  199.                                         printf $fh "\nTemplate: foo/bar%d\n", $count - 1;
  200.                                         print $fh "Type: ".
  201.                                                 (length($last{type}) ?  $last{type} :
  202.                                                  ($choices ?  "select" : "string"))."\n";
  203.                                         if ($choices == 0 && $last{type} =~ m/select/)
  204.                                         {
  205.                                                 #   Dummy Choices field, needed to display the
  206.                                                 #   question.
  207.                                                 print $fh "Choices: dummy1, dummy2\n";
  208.                                         }
  209.                                         print $fh "$text\n";
  210.                                 }
  211.                                 $count++;
  212.                                 $choices = 0;
  213.                                 $text = "";
  214.                                 $oldTemplateNr = $newTemplateNr;
  215.                                 %last = %{$fields->{$file}->{$_}};
  216.                         }
  217.                         if ($fields->{$file}->{$_}->{field} eq 'Choices') {
  218.                                 $choices = 1;
  219.                         } elsif ($fields->{$file}->{$_}->{field} eq 'DefaultChoice') {
  220.                                 $fields->{$file}->{$_}->{field} = 'Default';
  221.                         }
  222.                         # debconf is kind enough to not display a Select question if there
  223.                         # is only one choice, so add a dummy item
  224.                         if ($fields->{$file}->{$_}->{field} eq 'Choices' && $fields->{$file}->{$_}->{type} eq 'select' && $fields->{$file}->{$_}->{msgid} !~ /,/) {
  225.                                 $fields->{$file}->{$_}->{msgid} .= ", dummy2";
  226.                                 $fields->{$file}->{$_}->{msgstr} .= ", dummy2";
  227.                         }
  228.                         $text .= "$fields->{$file}->{$_}->{field}: $fields->{$file}->{$_}->{msgid}\n";
  229.                         $text .= "$fields->{$file}->{$_}->{field}-$lang.UTF-8: $fields->{$file}->{$_}->{msgstr}\n";
  230.                 }
  231.         }
  232.         if ($text ne "") {
  233.                 printf $fh "Template: foo/bar%d\n", $count - 1;
  234.                 print $fh "Type: ".
  235.                         (length($last{type}) ?  $last{type} :
  236.                          ($choices ?  "select" : "string"))."\n";
  237.                 if ($choices == 0 && $last{type} =~ m/select/)
  238.                 {
  239.                         #   Dummy Choices field, needed to display the
  240.                         #   question.
  241.                         print $fh "Choices: dummy1, dummy2\n";
  242.                 }
  243.                 print $fh "$text";
  244.         }
  245. }
  246. close($fh);
  247.  
  248. #  2.  Load the templates file in debconf DB
  249.  
  250. use Debconf::Db;
  251. use Debconf::AutoSelect qw(:all);
  252. use Debconf::Config;
  253.  
  254. my ($dbth, $dbt) = File::Temp::tempfile()
  255.         or die "Unable to write temporary files";
  256. my ($dbch, $dbc) = File::Temp::tempfile()
  257.         or die "Unable to write temporary files";
  258. push (@tempfiles, $dbt, $dbc);
  259.  
  260. my %hashconfig = (
  261.         driver => "File",
  262.         mode => '0600',
  263.         name => "config",
  264.         backup => 0,
  265.         filename => $dbc
  266. );
  267. my %hashtemplates = (
  268.         driver => "File",
  269.         mode => '0600',
  270.         name => "templates",
  271.         backup => 0,
  272.         filename => $dbt
  273. );
  274.  
  275. $Debconf::Db::config=Debconf::Db->makedriver(%hashconfig);
  276. $Debconf::Db::templates=Debconf::Db->makedriver(%hashtemplates);
  277. Debconf::Template->load($template, 'display');
  278. Debconf::Db->save;
  279. unlink $template;
  280.  
  281. # 3.  Display questions
  282.  
  283. $Debconf::Db::config=Debconf::Db->makedriver(%hashconfig);
  284. $Debconf::Db::templates=Debconf::Db->makedriver(%hashtemplates);
  285. Debconf::Config->frontend($frontend) if length($frontend);
  286. my $dc_frontend=make_frontend();
  287. my $dc_confmodule=make_confmodule();
  288. my $code=127;
  289.  
  290. my $cnt = 0;
  291. while (1) {
  292.     $_="RESET foo/bar$cnt\n";
  293.     my $ret=$dc_confmodule->process_command($_);
  294.     if ($titles->{$cnt}) {
  295.         $_="SETTITLE foo/bar$cnt\n";
  296.         $ret=$dc_confmodule->process_command($_);
  297.         $cnt++;
  298.         next;
  299.     }
  300.     $_="SUBST foo/bar$cnt dollarsign \$\n";
  301.     $ret=$dc_confmodule->process_command($_);
  302.     $_="INPUT high foo/bar$cnt\n";
  303.     $ret=$dc_confmodule->process_command($_);
  304.     ($code, undef)=split(/ /, $ret, 2);
  305.     last if $code ne 0 && $code ne 30;
  306.     $_="GO\n";
  307.     $ret=$dc_confmodule->process_command($_);
  308.     ($code, undef)=split(/ /, $ret, 2);
  309.     $cnt++;
  310. }
  311.  
  312. $dc_frontend->shutdown;
  313. $dc_confmodule->finish;
  314. Debconf::Db->save;
  315. unlink $dbt, $dbc;
  316.  
  317. 1;
  318.