home *** CD-ROM | disk | FTP | other *** search
/ PC Welt 2006 November (DVD) / PCWELT_11_2006.ISO / casper / filesystem.squashfs / usr / bin / podebconf-report-po < prev    next >
Encoding:
Text File  |  2006-06-28  |  15.2 KB  |  566 lines
  1. #!/usr/bin/perl -w
  2.  
  3. # podebconf-report-po, Send outdated debconf PO files to the last translator
  4. # Copyright (C) 2004-2006 Fabio Tranchitella <kobold@kobold.it>
  5. #                         Denis Barbier <barbier@debian.org>
  6. #
  7. # This program is free software; you can redistribute it and/or modify
  8. # it under the terms of the GNU General Public License as published by
  9. # the Free Software Foundation; either version 2 of the License, or
  10. # (at your option) any later version.
  11. #
  12. # This program is distributed in the hope that it will be useful,
  13. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15. # GNU Library General Public License for more details.
  16. #
  17. # You should have received a copy of the GNU General Public License
  18. # along with this program; if not, write to the Free Software
  19. # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  20. #
  21.  
  22. ## Release information
  23. my $PROGRAM = "podebconf-report-po";
  24. my $VERSION = "0.10";
  25.  
  26. ## Loaded modules, require libmail-sendmail-perl
  27. use strict;
  28. eval q{use Mail::Sendmail;};
  29. die "$PROGRAM: This program requires the libmail-sendmail-perl package.\n".
  30.     "$PROGRAM: Aborting!\n" if $@;
  31. my $no_zlib = 0;
  32. eval q{use Compress::Zlib;};
  33. if ($@) {
  34.     $no_zlib = 1;
  35.     eval q{ sub Compress::Zlib::memGzip { return shift; } };
  36. }
  37. use MIME::Base64;
  38. use MIME::QuotedPrint;
  39. use Getopt::Long;
  40. use POSIX;
  41.  
  42. ## Global variables
  43. my $HELP_ARG = 0;
  44. my $VERSION_ARG = 0;
  45. my $VERBOSE_ARG = 0;
  46. my $SUBMIT_ARG = 0;
  47. my $FORCE_ARG = 0;
  48. my $LANGUAGETEAM_ARG = 0;
  49. my $SMTP_ARG = "";
  50. my $TEMPLATE_ARG = "";
  51. my $DEFAULT_ARG = 0;
  52. my $PACKAGE_ARG = "";
  53. my $SUMMARY_ARG = 0;
  54. my $FROM_ARG = (exists($ENV{'DEBEMAIL'}) ? $ENV{'DEBEMAIL'} : "");
  55. my $BTS_ARG = "";
  56. my $DEADLINE_ARG = "";
  57. my $PODIR_ARG = "";
  58. my $GZIP_ARG = 0;
  59.  
  60. my @TOPDIRS = qw{../.. .. .};
  61.  
  62. my $PODIR = '';
  63.  
  64. my $EDITOR = '/usr/bin/sensible-editor';
  65.  
  66. ## Default templates
  67. my $comments = "# Lines beginning with a number sign are comments, they are removed when
  68. # sending mails.  If a line is composed of a # followed by a 'Name: Value'
  69. # pair, it is interpreted as a mail header field and is passed to your mail
  70. # transport agent.  You can edit/add/remove those header fields.";
  71.  
  72. my $SUBJECT_TRANSLATOR = "Please update debconf PO translation for the package <package_and_version>";
  73. my $BODY_TRANSLATOR = $comments. "
  74. # 
  75. # From: <from>
  76. # Subject: <subject>
  77. # Reply-To: <reply-to>
  78. #
  79. # This mail will be sent to the following people:
  80. <filelist>
  81.  
  82. Hi,
  83.  
  84. You are noted as the last translator of the debconf translation for
  85. <package>. The English template has been changed, and now some messages
  86. are marked \"fuzzy\" in your translation or are missing.
  87. I would be grateful if you could take the time and update it.
  88. <reply>
  89. <deadline>
  90.  
  91. Thanks,
  92. ";
  93.  
  94. my $SUBJECT_SUBMIT = "debconf PO translations for the package <package> are outdated";
  95. my $BODY_SUBMIT = $comments. "
  96. # 
  97. # From: <from>
  98. # Subject: <subject>
  99.  
  100. Package: <package>
  101. Version: N/A
  102. Severity: wishlist
  103. Tags: l10n
  104.  
  105. The following debconf translations are outdated:
  106.   <filelist>
  107.  
  108. Translators, please send your translations to this bugreport.
  109. <deadline>
  110.  
  111. Thanks,
  112. ";
  113.  
  114. my $SUBJECT = '';
  115. my $BODY = '';
  116. #  Warnings may be deleted from screen when entering editor,
  117. #  so display them when it is closed.
  118. my $warn = '';
  119.  
  120. ## Handle options
  121. GetOptions
  122. (
  123.  "help"            => \$HELP_ARG,
  124.  "version"         => \$VERSION_ARG,
  125.  "v|verbose"       => \$VERBOSE_ARG,
  126.  "f|force"         => \$FORCE_ARG,
  127.  "podir=s"         => \$PODIR_ARG,
  128.  "smtp=s"          => \$SMTP_ARG,
  129.  "template=s"      => \$TEMPLATE_ARG,
  130.  "default"         => \$DEFAULT_ARG,
  131.  "gzip"            => \$GZIP_ARG,
  132.  "languageteam"    => \$LANGUAGETEAM_ARG,
  133.  "package=s"       => \$PACKAGE_ARG,
  134.  "deadline=s"      => \$DEADLINE_ARG,
  135.  "summary"         => \$SUMMARY_ARG,
  136.  "from=s"          => \$FROM_ARG,
  137.  "bts=s"           => \$BTS_ARG,
  138.  "submit"          => \$SUBMIT_ARG
  139.  ) or &Help_InvalidOption;
  140.  
  141. &Help_PrintVersion if $VERSION_ARG;
  142. &Help_PrintHelp    if $HELP_ARG;
  143.  
  144. ## Try to find default editor
  145. $EDITOR = $ENV{'EDITOR'} if exists($ENV{'EDITOR'});
  146. $EDITOR = $ENV{'VISUAL'} if exists($ENV{'VISUAL'});
  147.  
  148. ## Try to locate the PO directory
  149. if ($PODIR_ARG eq "") {
  150.     foreach my $d (@TOPDIRS) {
  151.         $PODIR = "$d/debian/po" if (-d "$d/debian/po");
  152.     }
  153. } else {
  154.     $PODIR = $PODIR_ARG;
  155. }
  156. die "Directory po not found, exiting!\n" if $PODIR eq "";
  157. die "Wrong argument: $PODIR is not a directory!\n" unless -d $PODIR;
  158.  
  159. if ($no_zlib && $GZIP_ARG) {
  160.     $warn .= 
  161.       "Warning: This program requires the libcompress-zlib-perl package in order\n".
  162.       "         to support the --gzip flag, but it is not installed.\n".
  163.       "         PO files will not be compressed!\n\n";
  164.     $GZIP_ARG = 0;
  165. }
  166.  
  167. ## Try to find the maintainer e-mail address and the package name
  168.  
  169. #  Package version
  170. my $PKG_VERSION = "N/A";
  171. #  Expanded into "<package> <version>" if version is found, <package> otherwise
  172. my $PACKAGE_AND_VERSION = "";
  173. if ($PACKAGE_ARG =~ s/_(.*)//) {
  174.     $PKG_VERSION = $1;
  175. }
  176.  
  177. if ($PACKAGE_ARG eq "" or $FROM_ARG eq "") {
  178.     my $CONTROL = '';
  179.     foreach my $d (@TOPDIRS) {
  180.         $CONTROL = "$d/debian/control" if (-f "$d/debian/control");
  181.     }
  182.     if ($CONTROL eq '') {
  183.         foreach my $d (@TOPDIRS) {
  184.             $CONTROL = "$d/debian/control.in" if (-f "$d/debian/control.in");
  185.         }
  186.     }
  187.  
  188.     if (-f $CONTROL) {
  189.         ##  Only read the first stanza
  190.         local $/ = "\n\n";
  191.         open (CNTRL, "< $CONTROL")
  192.             or die "Unable to read $CONTROL: $!\n";
  193.         my $text = <CNTRL>;
  194.         close (CNTRL)
  195.             or die "Unable to close $CONTROL: $!\n";
  196.         if ($PACKAGE_ARG eq "" && $text =~ m/^Source: (.*)/m) {
  197.             $PACKAGE_ARG = $1;
  198.         }
  199.  
  200.         if ($FROM_ARG eq "" && $text =~ m/^Maintainer: (.*)/m) {
  201.             $FROM_ARG = $1;
  202.         }
  203.     }
  204. }
  205. if ($PKG_VERSION eq "N/A") {
  206.     my $CHANGELOG = '';
  207.     foreach my $d (@TOPDIRS) {
  208.         $CHANGELOG = "$d/debian/changelog" if (-f "$d/debian/changelog");
  209.     }
  210.     if (-f $CHANGELOG) {
  211.         #  Version information is not vital, do not abort
  212.         #  if it cannot be retrieved.
  213.         if (open (CHG, "< $CHANGELOG")) {
  214.             while (<CHG>) {
  215.                 if (m/^$PACKAGE_ARG\s+\((.*)\)\s/) {
  216.                     $PKG_VERSION = $1;
  217.                 }
  218.                 last if m/^ --/;
  219.             }
  220.         }
  221.         close (CHG);
  222.     }
  223. }
  224. $PACKAGE_AND_VERSION = $PACKAGE_ARG .
  225.     ($PKG_VERSION ne 'N/A' ? " ".$PKG_VERSION : "");
  226. Verbose("Package: $PACKAGE_ARG");
  227. Verbose("Version: $PKG_VERSION");
  228. Verbose("Maintainer: $FROM_ARG");
  229.  
  230. if ($DEADLINE_ARG ne "") {
  231.     $DEADLINE_ARG = "\nThe deadline for receiving the updated translation is $DEADLINE_ARG.";
  232. }
  233.  
  234. my $REPLY = '';
  235. if ($BTS_ARG =~ m/^\d+$/) {
  236.     $BTS_ARG .= "\@bugs.debian.org";
  237.     $REPLY = "Please respect the Reply-To: field and send your updated translation to\n$BTS_ARG.";
  238. } else {
  239.     $REPLY = "Please send the updated file to me, or submit it as a wishlist bug\nagainst <package>.";
  240. }
  241.  
  242. if ($SUBMIT_ARG) {
  243.     $BODY = $BODY_SUBMIT;
  244.     $SUBJECT = $SUBJECT_SUBMIT;
  245. } else {
  246.     $BODY = $BODY_TRANSLATOR;
  247.     $SUBJECT = $SUBJECT_TRANSLATOR;
  248. }
  249.  
  250. ## Apply the values to the subject and to the body of the message
  251.  
  252. $SUBJECT =~ s/<package>/$PACKAGE_ARG/g;
  253. $SUBJECT =~ s/<version>/$PKG_VERSION/g;
  254. $SUBJECT =~ s/<package_and_version>/$PACKAGE_AND_VERSION/g;
  255. $BODY =~ s/<reply>/$REPLY/g;
  256. $BODY =~ s/<reply-to>/$BTS_ARG/g;
  257. $BODY =~ s/\n# Reply-To: \n/\n/;
  258. $BODY =~ s/<subject>/$SUBJECT/g;
  259. $BODY =~ s/<package>/$PACKAGE_ARG/g;
  260. $BODY =~ s/<version>/$PKG_VERSION/g;
  261. $BODY =~ s/<package_and_version>/$PACKAGE_AND_VERSION/g;
  262. $BODY =~ s/<from>/$FROM_ARG/g;
  263. $BODY =~ s/\n<deadline>/$DEADLINE_ARG/g;
  264.  
  265. ## Check every file with .po extension in $PODIR ...
  266. Verbose("Checking for PO files in $PODIR");
  267. opendir(DIR, $PODIR);
  268. my $poFiles = {};
  269. foreach my $poFile (grep(/\.po$/, readdir(DIR))) {
  270.     local $/ = "\n\n";
  271.     $poFiles->{$poFile} = {};
  272.     my $outdated = 0;
  273.     my $found_header = 0;
  274.     open (PO, "< $PODIR/$poFile")
  275.         or die "Unable to read $PODIR/$poFile: $!\n";
  276.     while (<PO>) {
  277.         if ($found_header == 0 && m/msgid ""\nmsgstr/s) {
  278.             $found_header = 1;
  279.             #  Concatenate lines
  280.             s/"\n"//g;
  281.             if (m/\\nLast-Translator: (.*?)\\n/ && $1 ne 'FULL NAME <EMAIL@ADDRESS>') {
  282.                 $poFiles->{$poFile}->{translator} = $1;
  283.             } else {
  284.                 $warn .= "Warning: $poFile:  Unable to determine last translator.  Skipping file!\n";
  285.                 last;
  286.             }
  287.             if (m/\\nContent-Type: [^;]*; charset=(.*?)\\n/) {
  288.                 $poFiles->{$poFile}->{charset} = $1;
  289.             } else {
  290.                 $warn .= "Warning: $poFile:  Unable to determine charset.  Skipping file!\n";
  291.                 last;
  292.             }
  293.             if ($LANGUAGETEAM_ARG && m/\\nLanguage-Team: (.*?)\\n/) {
  294.                 $poFiles->{$poFile}->{team} = $1
  295.                     if $1 ne 'LANGUAGE <LL@li.org>';
  296.             }
  297.             next;
  298.         }
  299.         #  Ignore outdated msgids
  300.         next unless m/^msgid /m;
  301.         #  Check for fuzzy or missing translations
  302.         s/\n+$//s;
  303.         if (m/^#, .*fuzzy/m or m/\nmsgstr ""$/s) {
  304.             $outdated = 1;
  305.             last;
  306.         }
  307.     }
  308.     close (PO)
  309.         or die "Unable to close $PODIR/$poFile: $!\n";
  310.     delete $poFiles->{$poFile} unless $outdated;
  311. }
  312. closedir(DIR);
  313. if (keys %$poFiles) {
  314.     print "Outdated files: ".join(' ', keys %$poFiles)."\n";
  315. } else {
  316.     print "No outdated files\n";
  317.     exit(0);
  318. }
  319.  
  320. my $filelist = '';
  321. if ($SUBMIT_ARG) {
  322.     $filelist = join(' ', sort keys %$poFiles)."\n";
  323. } else {
  324.     foreach my $poFile (sort keys %$poFiles) {
  325.         $filelist .= '### ' . $poFile . ': ' . $poFiles->{$poFile}->{translator};
  326.         $filelist .= ', ' . $poFiles->{$poFile}->{team} if defined($poFiles->{$poFile}->{team});
  327.         $filelist .= "\n";
  328.     }
  329.     #  Remove non-ASCII characters
  330.     $filelist =~ s/[\x80-\xff]/?/g;
  331. }
  332. $BODY =~ s/<filelist>\n/$filelist/g;
  333.  
  334. my %headers = ();
  335. if ($TEMPLATE_ARG eq "") {
  336.     $BODY = &OpenEditor($EDITOR, $BODY) if not $DEFAULT_ARG;
  337. } else {
  338.     $BODY = &ReadFile($TEMPLATE_ARG);
  339. }
  340. %headers = &ParseHeaders($BODY);
  341. $BODY = &RemoveHeaders($BODY);
  342.  
  343. print STDERR $warn if $warn ne '';
  344.  
  345. my @mails = ();
  346. if ($SUBMIT_ARG) {
  347.     $BODY =~ s/<filelist>/$filelist/g;
  348.     my %mail = (
  349.         From => $FROM_ARG,
  350.         To => "maintonly\@bugs.debian.org",
  351.         Subject => $SUBJECT,
  352.         'X-Mail-Originator' => "$PROGRAM $VERSION"
  353.     );
  354.     $mail{body} = encode_qp($BODY);
  355.     @mails = (\%mail);
  356. } else {
  357.     $BODY = encode_qp($BODY);
  358.     my $ext = ($GZIP_ARG ? '.gz' : '');
  359.     foreach my $file (keys %$poFiles) {
  360.         my $content = &ReadFile($PODIR . "/" . $file);
  361.         $content = Compress::Zlib::memGzip($content) if $GZIP_ARG;
  362.         my $file_encoded = encode_base64($content);
  363.         my $contentType = ($GZIP_ARG ? "application/octet-stream" : "text/x-gettext; name=\"$file\"; charset=\"$poFiles->{$file}->{charset}\"");
  364.         my %mail = (
  365.             From => $FROM_ARG,
  366.             To => $poFiles->{$file}->{translator},
  367.             Subject => $SUBJECT,
  368.             'X-Mail-Originator' => "$PROGRAM $VERSION"
  369.         );
  370.         $mail{To} .= ", ". $poFiles->{$file}->{team}
  371.             if defined $poFiles->{$file}->{team};
  372.  
  373.         my $boundary = "=" . time() . "=";
  374.         $mail{'content-type'} = "multipart/mixed; boundary=\"$boundary\"";
  375.         $mail{body} = <<_EOF_;
  376. --$boundary
  377. Content-Type: text/plain; charset="us-ascii"
  378. Content-Transfer-Encoding: quoted-printable
  379.  
  380. $BODY
  381.  
  382. --$boundary
  383. Content-Type: $contentType
  384. Content-Transfer-Encoding: base64
  385. Content-Disposition: attachment; filename="$file$ext"
  386.  
  387. $file_encoded
  388. --$boundary--
  389. _EOF_
  390.  
  391.         push(@mails, \%mail);
  392.     }
  393. }
  394.  
  395. #  Add mail headers and remove non-ASCII characters
  396. foreach my $refmail (@mails) {
  397.     foreach my $h (keys(%headers)) {
  398.         $refmail->{$h} = &DropNonASCII($headers{$h});
  399.     }
  400.     foreach my $h (qw(From To Subject)) {
  401.         $refmail->{$h} = &DropNonASCII($refmail->{$h});
  402.     }
  403.     $refmail->{smtp} = $SMTP_ARG if ($SMTP_ARG ne '');
  404. }
  405.  
  406. if (!$FORCE_ARG) {
  407.     if ($SUBMIT_ARG) {
  408.         print "Ready to send the bug report against the package $PACKAGE_ARG, are you sure? [y/N] ";
  409.     } else {
  410.         print "Ready to send the emails, are you sure? [y/N] ";
  411.     }
  412.     my $line = <>;
  413.     chop $line;
  414.     exit(0) if ($line ne "Y" and $line ne "y");
  415. }
  416.  
  417. #  Make Perl compiler quiet
  418. print $Mail::Sendmail::error . $Mail::Sendmail::error if 0;
  419. foreach my $mail (@mails) {
  420.     sendmail(%{$mail}) || print "Couldn't send the email: $Mail::Sendmail::error\n";
  421. }
  422. if ($SUMMARY_ARG) {
  423.     my %summary = (
  424.         From => $FROM_ARG,
  425.         To => $FROM_ARG,
  426.         Subject => $SUBJECT,
  427.         'X-Mail-Originator' => "$PROGRAM $VERSION"
  428.     );
  429.     $summary{body} = "List of outdated files:\n";
  430.     foreach my $poFile (sort keys %$poFiles) {
  431.         $summary{body} .= '  ' . $poFile . ': ' . $poFiles->{$poFile}->{translator};
  432.         $summary{body} .= ', ' . $poFiles->{$poFile}->{team} if defined($poFiles->{$poFile}->{team});
  433.         $summary{body} .= "\n";
  434.     }
  435.     $summary{body} .= "Translators received the mail below.\n\n";
  436.     $summary{body} .= encode_qp($BODY);
  437.     sendmail(%summary) || print "Couldn't send the email: $Mail::Sendmail::error\n";
  438. }
  439. exit(0);
  440.  
  441. ###############################################################################
  442.  
  443. sub OpenEditor
  444. {
  445.     my $editor = shift;
  446.     my $body = shift;
  447.     my $opts = "";
  448.     my $tmpnam = tmpnam();
  449.  
  450.     open (OUT, "> $tmpnam")
  451.         or die ("Couldn't write $tmpnam: $!\nExiting!\n");
  452.     print OUT $body;
  453.     close(OUT)
  454.         or die ("Couldn't close $tmpnam: $!\nExiting!\n");
  455.  
  456.     $opts = "-f" if ($editor eq "vim");
  457.     system("$editor $opts $tmpnam");
  458.  
  459.     $body = &ReadFile($tmpnam) if (-f $tmpnam);
  460.     unlink($tmpnam);
  461.  
  462.     return $body;
  463. }
  464.  
  465. sub ParseHeaders
  466. {
  467.     my $body = shift;
  468.     my %headers = ();
  469.  
  470.     while ($body =~ s/^#[ \t]*([^\n]*)\n//s) {
  471.         my $comment = $1;
  472.         if ($comment =~ m/^([a-zA-Z0-9_-]+):\s*([^\n]+)$/) {
  473.             $headers{$1} = $2;
  474.         }
  475.     }
  476.     return %headers;
  477. }
  478.  
  479. sub RemoveHeaders
  480. {
  481.     my $body = shift;
  482.     #  First remove comments
  483.     1 while $body =~ s/^#[^\n]*\n//s;
  484.     #  Optional empty lines
  485.     $body =~ s/^\s+//s;
  486.     return $body;
  487. }
  488.  
  489. sub DropNonASCII {
  490.     my $text = shift;
  491.     $text =~ s/[\x80-\xff]/?/g;
  492.     return $text;
  493. }
  494.  
  495. sub ReadFile
  496. {
  497.     my $file = shift;
  498.     local $/ = undef;
  499.     open(FILE, "< $file")
  500.         or die ("Couldn't read $file: $!\nExiting!\n");
  501.     my $body = <FILE>;
  502.     close(FILE)
  503.         or die ("Couldn't close $file: $!\nExiting!\n");
  504.     return $body;
  505. }
  506.  
  507. ## Handle invalid arguments
  508. sub Help_InvalidOption
  509. {
  510.     print STDERR "Try `${PROGRAM} --help' for more information.\n";
  511.     exit 1;
  512. }
  513.  
  514. ## Print the usage message and exit
  515. sub Help_PrintHelp
  516. {
  517.     print <<_EOF_;
  518.  
  519. Usage: ${PROGRAM} [OPTIONS]
  520. Send outdated debconf PO files to the last translators.
  521.  
  522. Options:
  523.   --help                display this help and exit
  524.   --version             display version information and exit
  525.   -v, --verbose         display additional information
  526.   -f, --force           send the email without confirmation
  527.   --podir=DIRECTORY     specify where are located the PO files
  528.   --smtp=SERVER         specify SMTP server for mailing (default localhost)
  529.   --template=TEMPLATE   specify file to use it as template for the emails
  530.   --default             don't open the editor and use the template as is
  531.   --gzip                compress PO files with gzip
  532.   --package=PACKAGE     specify the name of the package
  533.   --from=MAINTAINER     specify the name and the email address of the sender
  534.   --deadline=DEADLINE   specify the deadline for receiving the updated
  535.                         translations
  536.   --languageteam        send the email also to the Language Team
  537.   --summary             send a status report to the maintainer with the list
  538.                         of emails sent to translators
  539.   --submit              send a bug report against the package with a report
  540.                         of the outdated debconf translations
  541.   --bts=BUGNUMBER       specify the Debian bug number to set as reply-to
  542.  
  543. _EOF_
  544.     exit 0;
  545. }
  546.  
  547. ## Print the version text and exit
  548. sub Help_PrintVersion
  549. {
  550.     print <<_EOF_;
  551. ${PROGRAM} $VERSION
  552. Copyright (C) 2004-2006 Fabio Tranchitella and Denis Barbier.
  553. This is free software; see the source for copying conditions.  There is NO
  554. warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  555. _EOF_
  556.     exit 0;
  557. }
  558.  
  559. sub Verbose
  560. {
  561.     my $msg = shift;
  562.     return unless $VERBOSE_ARG;
  563.     $msg =~ s/^/**${PROGRAM}: /mg;
  564.     print STDERR $msg."\n";
  565. }
  566.