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-report-po < prev    next >
Encoding:
Text File  |  2006-12-12  |  23.0 KB  |  886 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. my $no_encode = 0;
  38. eval q{use Encode;};
  39. if ($@) {
  40.     $no_encode = 1;
  41. }
  42. use MIME::Base64;
  43. use MIME::QuotedPrint;
  44. use Getopt::Long;
  45. use POSIX;
  46.  
  47. ## Global variables
  48. my $CONF_ARG;
  49. if (-e $ENV{'HOME'}."/.podebconf-report-po.conf") {
  50.     $CONF_ARG = $ENV{'HOME'}."/.podebconf-report-po.conf";
  51. }
  52. my $NO_CONF;
  53. my $HELP_ARG = 0;
  54. my $VERSION_ARG = 0;
  55. my $VERBOSE_ARG;
  56. my $NO_VERBOSE;
  57. my $SUBMIT_ARG = 0;
  58. my $FORCE_ARG;
  59. my $NO_FORCE;
  60. my $CALL;
  61. my $POTFILE = "";
  62. my $LANGS = "";
  63. my $LANGUAGETEAM_ARG;
  64. my $NO_LANGUAGETEAM;
  65. my $SMTP_ARG;
  66. my $TEMPLATE_ARG;
  67. my $NO_TEMPLATE;
  68. my $DEFAULT_ARG;
  69. my $NO_DEFAULT;
  70. my $PACKAGE_ARG = "";
  71. my $SUMMARY_ARG;
  72. my $NO_SUMMARY;
  73. my $FROM_ARG;
  74. my $BTS_ARG = "";
  75. my $DEADLINE_ARG = "";
  76. my $PODIR_ARG = "";
  77. my $GZIP_ARG;
  78. my $NO_GZIP;
  79. my $UTF8;
  80. my $NO_UTF8;
  81.  
  82. my @TOPDIRS = qw{../.. .. .};
  83.  
  84. my $PODIR = '';
  85.  
  86. my $EDITOR = '/usr/bin/sensible-editor';
  87.  
  88. ## Default templates
  89. my $comments = "# Lines beginning with a number sign are comments, they are removed when
  90. # sending mails.  If a line is composed of a # followed by a 'Name: Value'
  91. # pair, it is interpreted as a mail header field and is passed to your mail
  92. # transport agent.  You can edit/add/remove those header fields.";
  93.  
  94. my $SUBJECT_TRANSLATOR = "Please update debconf PO translation for the package <package_and_version>";
  95. my $BODY_TRANSLATOR = $comments. "
  96. # 
  97. # From: <from>
  98. # Subject: <subject>
  99. # Reply-To: <reply-to>
  100. #
  101. # This mail will be sent to the following people:
  102. # (you can update email addresses, remove a line or add/remove the cross
  103. # between the brackets)
  104. <filelist>
  105.  
  106. Hi,
  107.  
  108. You are noted as the last translator of the debconf translation for
  109. <package>. The English template has been changed, and now some messages
  110. are marked \"fuzzy\" in your translation or are missing.
  111. I would be grateful if you could take the time and update it.
  112. <reply>
  113. <deadline>
  114.  
  115. Thanks,
  116. ";
  117.  
  118. my $SUBJECT_SUBMIT = "debconf PO translations for the package <package> are outdated";
  119. my $BODY_SUBMIT = $comments. "
  120. # 
  121. # From: <from>
  122. # Subject: <subject>
  123.  
  124. Package: <package>
  125. Version: N/A
  126. Severity: wishlist
  127. Tags: l10n
  128.  
  129. The following debconf translations are outdated:
  130.   <filelist>
  131.  
  132. Translators, please send your translations to this bugreport.
  133. <deadline>
  134.  
  135. Thanks,
  136. ";
  137.  
  138. my $SUBJECT_CALL = "debconf PO translations for the package <package>";
  139. my $BODY_CALL = $comments. "
  140. # 
  141. # From: <from>
  142. # Subject: <subject>
  143. # Reply-To: <reply-to>
  144.  
  145. Dear Debian I18N people,
  146.  
  147. I would like to know if some of you would be interested in translating
  148. <package>.
  149.  
  150. <package> already includes <filelist>.
  151. So do not translate it to these languages (the translators will be
  152. contacted separately).
  153.  
  154. <statistics>
  155.  
  156. <reply>
  157. <deadline>
  158.  
  159. If you have read so far, please find the POT file in attachement.
  160.  
  161. Thanks in advance,
  162. ";
  163.  
  164. my $SUBJECT = '';
  165. my $BODY = '';
  166. #  Warnings may be deleted from screen when entering editor,
  167. #  so display them when it is closed.
  168. my $warn = '';
  169.  
  170. ## Handle options
  171. GetOptions
  172. (
  173.  "conf=s"          => \$CONF_ARG,
  174.  "noconf"          => \$NO_CONF,
  175.  "help"            => \$HELP_ARG,
  176.  "version"         => \$VERSION_ARG,
  177.  "v|verbose"       => \$VERBOSE_ARG,
  178.  "noverbose"       => \$NO_VERBOSE,
  179.  "f|force"         => \$FORCE_ARG,
  180.  "noforce"         => \$NO_FORCE,
  181.  "podir=s"         => \$PODIR_ARG,
  182.  "smtp=s"          => \$SMTP_ARG,
  183.  "template=s"      => \$TEMPLATE_ARG,
  184.  "notemplate"      => \$NO_TEMPLATE,
  185.  "default"         => \$DEFAULT_ARG,
  186.  "nodefault"       => \$NO_DEFAULT,
  187.  "gzip"            => \$GZIP_ARG,
  188.  "nogzip"          => \$NO_GZIP,
  189.  "langs=s"         => \$LANGS,
  190.  "languageteam"    => \$LANGUAGETEAM_ARG,
  191.  "nolanguageteam"  => \$NO_LANGUAGETEAM,
  192.  "package=s"       => \$PACKAGE_ARG,
  193.  "deadline=s"      => \$DEADLINE_ARG,
  194.  "call:s"          => \$CALL,
  195.  "potfile=s"       => \$POTFILE,
  196.  "summary"         => \$SUMMARY_ARG,
  197.  "nosummary"       => \$NO_SUMMARY,
  198.  "from=s"          => \$FROM_ARG,
  199.  "bts=s"           => \$BTS_ARG,
  200.  "submit"          => \$SUBMIT_ARG,
  201.  "utf8"            => \$UTF8,
  202.  "noutf8"          => \$NO_UTF8
  203.  ) or &Help_InvalidOption;
  204.  
  205. my $conf = "";
  206.  
  207. unless ($NO_CONF or !defined $CONF_ARG) {
  208.     open (CNF, "< $CONF_ARG")
  209.         or die ("Couldn't read $CONF_ARG: $!\nExiting!\n");
  210.     while (<CNF>) {
  211.         $conf .= $_;
  212.     }
  213.     close(CNF)
  214.         or die ("Couldn't close $CONF_ARG: $!\nExiting!\n");
  215.  
  216.     $conf =~ s/^\s*#.*$//m;
  217.     $conf =~ s/\s*$//m;
  218. }
  219.  
  220. if ($conf =~ m/^smtp\s*(?:\s|=)\s*(.*)$/m) {
  221.     $SMTP_ARG = $1;
  222. } elsif (!defined $SMTP_ARG) {
  223.     $SMTP_ARG = "";
  224. }
  225.  
  226. if ($conf =~ m/^from\s*(?:\s|=)\s*(.*)$/m) {
  227.     $FROM_ARG = $1;
  228. } elsif (!defined $FROM_ARG) {
  229.     $FROM_ARG = (exists($ENV{'DEBEMAIL'}) ? $ENV{'DEBEMAIL'} : "");
  230. }
  231.  
  232. if (defined $NO_VERBOSE) {
  233.     $VERBOSE_ARG = 0;
  234. } elsif ($conf =~ m/^verbose$/m) {
  235.     $VERBOSE_ARG = 1;
  236. } elsif (!defined $VERBOSE_ARG) {
  237.     $VERBOSE_ARG = 0;
  238. }
  239.  
  240. if (defined $NO_FORCE) {
  241.     $FORCE_ARG = 0;
  242. } elsif ($conf =~ m/^force$/m) {
  243.     $FORCE_ARG = 1;
  244. } elsif (!defined $FORCE_ARG) {
  245.     $FORCE_ARG = 0;
  246. }
  247.  
  248. if (defined $NO_TEMPLATE) {
  249.     $TEMPLATE_ARG = "";
  250. } elsif ($conf =~ m/^template\s*(?:\s|=)\s*(.*)$/m) {
  251.     $TEMPLATE_ARG = $1;
  252. } elsif (!defined $TEMPLATE_ARG) {
  253.     $TEMPLATE_ARG = "";
  254. }
  255.  
  256. if (defined $NO_DEFAULT) {
  257.     $DEFAULT_ARG = 0;
  258. } elsif ($conf =~ m/^default$/m) {
  259.     $DEFAULT_ARG = 1;
  260. } elsif (!defined $DEFAULT_ARG) {
  261.     $DEFAULT_ARG = 0;
  262. }
  263.  
  264. if (defined $NO_GZIP) {
  265.     $GZIP_ARG = 0;
  266. } elsif ($conf =~ m/^nogzip$/m) {
  267.     $GZIP_ARG = 1;
  268. } elsif (!defined $GZIP_ARG) {
  269.     $GZIP_ARG = 0;
  270. }
  271.  
  272. if (defined $NO_LANGUAGETEAM) {
  273.     $LANGUAGETEAM_ARG = 0;
  274. } elsif ($conf =~ m/^languageteam$/m) {
  275.     $LANGUAGETEAM_ARG = 1;
  276. } elsif (!defined $LANGUAGETEAM_ARG) {
  277.     $LANGUAGETEAM_ARG = 0;
  278. }
  279.  
  280. if (defined $NO_SUMMARY) {
  281.     $SUMMARY_ARG = 0;
  282. } elsif ($conf =~ m/^summary$/m) {
  283.     $SUMMARY_ARG = 1;
  284. } elsif (!defined $SUMMARY_ARG) {
  285.     $SUMMARY_ARG = 0;
  286. }
  287.  
  288. if (defined $NO_UTF8) {
  289.     $UTF8 = 0;
  290. } elsif ($conf =~ m/^utf8$/m) {
  291.     $UTF8 = 1;
  292. } elsif (!defined $UTF8) {
  293.     $UTF8 = 0;
  294. }
  295.  
  296. &Help_PrintVersion if $VERSION_ARG;
  297. &Help_PrintHelp    if $HELP_ARG;
  298.  
  299. if ($no_encode and $UTF8) {
  300.     $warn .= "--utf8 requires the Encode perl module.  ".
  301.              "Turning this option off.\n";
  302.     $UTF8 = 0;
  303. }
  304.  
  305. ## Try to find default editor
  306. $EDITOR = $ENV{'EDITOR'} if exists($ENV{'EDITOR'});
  307. $EDITOR = $ENV{'VISUAL'} if exists($ENV{'VISUAL'});
  308.  
  309. ## Try to locate the PO directory
  310. if ($PODIR_ARG eq "") {
  311.     foreach my $d (@TOPDIRS) {
  312.         $PODIR = "$d/debian/po" if (-d "$d/debian/po");
  313.     }
  314. } else {
  315.     $PODIR = $PODIR_ARG;
  316. }
  317. die "Directory po not found, exiting!\n" if $PODIR eq "";
  318. die "Wrong argument: $PODIR is not a directory!\n" unless -d $PODIR;
  319.  
  320. if ($no_zlib && $GZIP_ARG) {
  321.     $warn .= 
  322.       "Warning: This program requires the libcompress-zlib-perl package in order\n".
  323.       "         to support the --gzip flag, but it is not installed.\n".
  324.       "         PO files will not be compressed!\n\n";
  325.     $GZIP_ARG = 0;
  326. }
  327.  
  328. ## Try to find the maintainer e-mail address and the package name
  329.  
  330. #  Package version
  331. my $PKG_VERSION = "N/A";
  332. #  Expanded into "<package> <version>" if version is found, <package> otherwise
  333. my $PACKAGE_AND_VERSION = "";
  334. if ($PACKAGE_ARG =~ s/_(.*)//) {
  335.     $PKG_VERSION = $1;
  336. }
  337.  
  338. if ($PACKAGE_ARG eq "" or $FROM_ARG eq "") {
  339.     my $CONTROL = '';
  340.     foreach my $d (@TOPDIRS) {
  341.         $CONTROL = "$d/debian/control" if (-f "$d/debian/control");
  342.     }
  343.     if ($CONTROL eq '') {
  344.         foreach my $d (@TOPDIRS) {
  345.             $CONTROL = "$d/debian/control.in" if (-f "$d/debian/control.in");
  346.         }
  347.     }
  348.  
  349.     if (-f $CONTROL) {
  350.         ##  Only read the first stanza
  351.         local $/ = "\n\n";
  352.         open (CNTRL, "< $CONTROL")
  353.             or die "Unable to read $CONTROL: $!\n";
  354.         my $text = <CNTRL>;
  355.         close (CNTRL)
  356.             or die "Unable to close $CONTROL: $!\n";
  357.         if ($PACKAGE_ARG eq "" && $text =~ m/^Source: (.*)/m) {
  358.             $PACKAGE_ARG = $1;
  359.         }
  360.  
  361.         if ($FROM_ARG eq "" && $text =~ m/^Maintainer: (.*)/m) {
  362.             $FROM_ARG = $1;
  363.         }
  364.     }
  365. }
  366. if ($PKG_VERSION eq "N/A") {
  367.     my $CHANGELOG = '';
  368.     foreach my $d (@TOPDIRS) {
  369.         $CHANGELOG = "$d/debian/changelog" if (-f "$d/debian/changelog");
  370.     }
  371.     if (-f $CHANGELOG) {
  372.         #  Version information is not vital, do not abort
  373.         #  if it cannot be retrieved.
  374.         if (open (CHG, "< $CHANGELOG")) {
  375.             while (<CHG>) {
  376.                 if (m/^$PACKAGE_ARG\s+\((.*)\)\s/) {
  377.                     $PKG_VERSION = $1;
  378.                 }
  379.                 last if m/^ --/;
  380.             }
  381.         }
  382.         close (CHG);
  383.     }
  384. }
  385. $PACKAGE_AND_VERSION = $PACKAGE_ARG .
  386.     ($PKG_VERSION ne 'N/A' ? " ".$PKG_VERSION : "");
  387. Verbose("Package: $PACKAGE_ARG");
  388. Verbose("Version: $PKG_VERSION");
  389. Verbose("Maintainer: $FROM_ARG");
  390.  
  391. if ($DEADLINE_ARG ne "") {
  392.     $DEADLINE_ARG = "\nThe deadline for receiving the updated translation is $DEADLINE_ARG.";
  393. }
  394.  
  395. my $REPLY = '';
  396. if ($BTS_ARG =~ m/^\d+$/) {
  397.     $BTS_ARG .= "\@bugs.debian.org";
  398.     $REPLY = "Please respect the Reply-To: field and send your updated translation to\n$BTS_ARG.";
  399. } else {
  400.     $REPLY = "Please send the updated file to me, or submit it as a wishlist bug\nagainst <package>.";
  401. }
  402.  
  403. if ($SUBMIT_ARG) {
  404.     $BODY = $BODY_SUBMIT;
  405.     $SUBJECT = $SUBJECT_SUBMIT;
  406. } elsif (defined $CALL) {
  407.     $CALL="Debian Internationalization <debian-i18n\@lists.debian.org>"
  408.         unless length $CALL;
  409.     $BODY = $BODY_CALL;
  410.     $SUBJECT = $SUBJECT_CALL;
  411. } else {
  412.     $CALL="";
  413.     $BODY = $BODY_TRANSLATOR;
  414.     $SUBJECT = $SUBJECT_TRANSLATOR;
  415. }
  416.  
  417. ## Apply the values to the subject and to the body of the message
  418.  
  419. $SUBJECT =~ s/<package>/$PACKAGE_ARG/g;
  420. $SUBJECT =~ s/<version>/$PKG_VERSION/g;
  421. $SUBJECT =~ s/<package_and_version>/$PACKAGE_AND_VERSION/g;
  422. $BODY =~ s/<reply>/$REPLY/g;
  423. $BODY =~ s/<reply-to>/$BTS_ARG/g;
  424. $BODY =~ s/\n# Reply-To: \n/\n/;
  425. $BODY =~ s/<subject>/$SUBJECT/g;
  426. $BODY =~ s/<package>/$PACKAGE_ARG/g;
  427. $BODY =~ s/<version>/$PKG_VERSION/g;
  428. $BODY =~ s/<package_and_version>/$PACKAGE_AND_VERSION/g;
  429. $BODY =~ s/<from>/$FROM_ARG/g;
  430. $BODY =~ s/\n<deadline>/$DEADLINE_ARG/g;
  431.  
  432. ## Check every file with .po extension in $PODIR ...
  433. Verbose("Checking for PO files in $PODIR");
  434. opendir(DIR, $PODIR);
  435. my $poFiles = {};
  436. my $statistics = "language        translated     fuzzy     untranslated\n".
  437.                  "-----------------------------------------------------\n";
  438. if (length $CALL and $POTFILE eq "") {
  439.     foreach my $potFile (grep(/\.pot$/, readdir(DIR))) {
  440.         if (length $POTFILE) {
  441.             die "Too many pot file found.\n".
  442.                 "Please specify one with the --potfile option.\n";
  443.         }
  444.         $POTFILE = $potFile;
  445.     }
  446. closedir(DIR);
  447. opendir(DIR, $PODIR);
  448.     if (length $POTFILE) {
  449.         print "Using $POTFILE for the call for translation\n";
  450.     } else {
  451.         warn "No POT file found. You should specify one with the ".
  452.              "--potfile option, or specify in the mail how to ".
  453.              "retrieve it."
  454.     }
  455. }
  456. if (length $CALL) {
  457.     foreach my $poFile (grep(/\.po$/, readdir(DIR))) {
  458.         $poFiles->{$poFile} = {};
  459.         my $cmd = "LC_ALL=C /usr/bin/msgfmt -o /dev/null --stat $PODIR/$poFile 2>&1";
  460.         my $stats = qx/$cmd/;
  461.         chomp $stats;
  462.         my ($t, $f, $u) = ("", "", "");
  463.         my $lang = $poFile;
  464.         $lang =~ s/\.po$//;
  465.         if ($stats =~ s/^([0-9]+) translated message[s ,]*//) {
  466.             $t = $1;
  467.         }
  468.         if ($stats =~ s/^([0-9]+) fuzzy translation[s ,]*//) {
  469.             $f = $1;
  470.         }
  471.         if ($stats =~ s/^([0-9]+) untranslated message[s ,]*//) {
  472.             $u = $1;
  473.         }
  474.         $statistics .= sprintf("  %-10s%10s  %10s    %10s\n", $lang, $t, $f, $u);
  475.     }
  476.     $BODY =~ s/<statistics>\n/$statistics/g;
  477. } else {
  478. foreach my $poFile (grep(/\.po$/, readdir(DIR))) {
  479.     local $/ = "\n\n";
  480.     $poFiles->{$poFile} = {};
  481.     my $outdated = 0;
  482.     my $found_header = 0;
  483.     open (PO, "< $PODIR/$poFile")
  484.         or die "Unable to read $PODIR/$poFile: $!\n";
  485.     while (<PO>) {
  486.         if ($found_header == 0 && m/msgid ""\nmsgstr/s) {
  487.             $found_header = 1;
  488.             #  Concatenate lines
  489.             s/"\n"//g;
  490.             if (m/\\nLast-Translator: (.*?)\\n/ && $1 ne 'FULL NAME <EMAIL@ADDRESS>') {
  491.                 $poFiles->{$poFile}->{translator} = $1;
  492.             } else {
  493.                 $warn .= "Warning: $poFile:  Unable to determine last translator.  Skipping file!\n";
  494.                 last;
  495.             }
  496.             if (m/\\nContent-Type: [^;]*; charset=(.*?)\\n/) {
  497.                 $poFiles->{$poFile}->{charset} = $1;
  498.             } else {
  499.                 $warn .= "Warning: $poFile:  Unable to determine charset.  Skipping file!\n";
  500.                 last;
  501.             }
  502.             if ($LANGUAGETEAM_ARG && m/\\nLanguage-Team: (.*?)\\n/) {
  503.                 $poFiles->{$poFile}->{team} = $1
  504.                     if $1 ne 'LANGUAGE <LL@li.org>';
  505.             }
  506.             next;
  507.         }
  508.         #  Ignore outdated msgids
  509.         next unless m/^msgid /m;
  510.         #  Check for fuzzy or missing translations
  511.         s/\n+$//s;
  512.         if (m/^#, .*fuzzy/m or m/\nmsgstr ""$/s) {
  513.             $outdated = 1;
  514.             last;
  515.         }
  516.     }
  517.     if ($UTF8) {
  518.         Encode::from_to($poFiles->{$poFile}->{translator},
  519.                         $poFiles->{$poFile}->{charset},
  520.                         "UTF-8");
  521.         Encode::from_to($poFiles->{$poFile}->{team},
  522.                         $poFiles->{$poFile}->{charset},
  523.                         "UTF-8");
  524.     }
  525.     close (PO)
  526.         or die "Unable to close $PODIR/$poFile: $!\n";
  527.     delete $poFiles->{$poFile} unless $outdated;
  528. }
  529. closedir(DIR);
  530. if (keys %$poFiles) {
  531.     print "Outdated files: ".join(' ', keys %$poFiles)."\n";
  532. } else {
  533.     print "No outdated files\n";
  534.     exit(0);
  535. }
  536. }
  537.  
  538. my %langs=();
  539. foreach (split(",", $LANGS)) {
  540.     $langs{$_.".po"} = 1;
  541. }
  542.  
  543. my $filelist = '';
  544. if ($SUBMIT_ARG or length $CALL) {
  545.     $filelist = join(' ', sort keys %$poFiles)."\n";
  546. } else {
  547.     foreach my $poFile (sort keys %$poFiles) {
  548.         $filelist .= '### ';
  549.         $filelist .= '[' .((!%langs or $langs{$poFile})?'*':' '). '] ';
  550.         $filelist .= $poFile . ': ' . $poFiles->{$poFile}->{translator};
  551.         $filelist .= ', ' . $poFiles->{$poFile}->{team} if defined($poFiles->{$poFile}->{team});
  552.         $filelist .= "\n";
  553.     }
  554.     #  Remove non-ASCII characters
  555.     $filelist = DropNonASCII($filelist)
  556.         unless ($UTF8);
  557. }
  558. $filelist =~ s/\n$//s;
  559. $BODY =~ s/<filelist>/$filelist/g;
  560.  
  561. my %headers = ();
  562. if ($TEMPLATE_ARG ne "") {
  563.     $BODY = &ReadFile($TEMPLATE_ARG);
  564. }
  565.  
  566. OPEN_EDITOR:
  567. $BODY = &OpenEditor($EDITOR, $BODY) if not $DEFAULT_ARG;
  568.  
  569. %headers = &ParseHeaders($BODY);
  570. my %To = &ParseTo($BODY);
  571.  
  572. print STDERR $warn if $warn ne '';
  573.  
  574. my @mails = ();
  575. if ($SUBMIT_ARG) {
  576.     $BODY =~ s/<filelist>/$filelist/g;
  577.     my %mail = (
  578.         From => $FROM_ARG,
  579.         To => "maintonly\@bugs.debian.org",
  580.         Subject => $SUBJECT,
  581.         'X-Mail-Originator' => "$PROGRAM $VERSION"
  582.     );
  583.     $mail{body} = encode_qp(&RemoveHeaders($BODY));
  584.     @mails = (\%mail);
  585. } elsif (length $CALL) {
  586.     $BODY =~ s/<filelist>/$filelist/g;
  587.     $BODY =~ s/<statistics>/$statistics/g;
  588.     my %mail = (
  589.         From => $FROM_ARG,
  590.         To => $CALL,
  591.         Subject => $SUBJECT,
  592.         'X-Mail-Originator' => "$PROGRAM $VERSION"
  593.     );
  594.     my $ext = ($GZIP_ARG ? '.gz' : '');
  595.         my $file = $POTFILE;
  596.         my $content = &ReadFile($PODIR . "/" . $file);
  597.         $content = Compress::Zlib::memGzip($content) if $GZIP_ARG;
  598.         my $file_encoded = encode_base64($content);
  599.         my $contentType = ($GZIP_ARG ? "application/octet-stream": "text/x-gettext; name=\"$file\"; charset=\"US-ASCII\"");
  600.         my $boundary = "=" . time() . "=";
  601.         $mail{'content-type'} = "multipart/mixed; boundary=\"$boundary\"";
  602.         my $charset = $UTF8?"utf-8":"us-ascii";
  603.         my $body = &RemoveHeaders($BODY);
  604.         $mail{body} = <<_EOF_;
  605. --$boundary
  606. Content-Type: text/plain; charset="$charset"
  607. Content-Transfer-Encoding: quoted-printable
  608.  
  609. $body
  610.  
  611. --$boundary
  612. Content-Type: $contentType
  613. Content-Transfer-Encoding: base64
  614. Content-Disposition: attachment; filename="$file$ext"
  615.  
  616. $file_encoded
  617. --$boundary--
  618. _EOF_
  619.     @mails = (\%mail);
  620. } else {
  621.     my $body = encode_qp(&RemoveHeaders($BODY));
  622.     my $ext = ($GZIP_ARG ? '.gz' : '');
  623.     foreach my $file (keys %$poFiles) {
  624.         if (defined $To{$file}) {
  625.             my $content = &ReadFile($PODIR . "/" . $file);
  626.             $content = Compress::Zlib::memGzip($content) if $GZIP_ARG;
  627.             my $file_encoded = encode_base64($content);
  628.             my $contentType = ($GZIP_ARG ? "application/octet-stream" : "text/x-gettext; name=\"$file\"; charset=\"$poFiles->{$file}->{charset}\"");
  629.             my %mail = (
  630.                 From => $FROM_ARG,
  631.                 To => $To{$file},
  632.                 Subject => $SUBJECT,
  633.                 'X-Mail-Originator' => "$PROGRAM $VERSION"
  634.             );
  635.  
  636.             my $boundary = "=" . time() . "=";
  637.             $mail{'content-type'} = "multipart/mixed; boundary=\"$boundary\"";
  638.             my $charset = $UTF8?"utf-8":"us-ascii";
  639.             $mail{body} = <<_EOF_;
  640. --$boundary
  641. Content-Type: text/plain; charset="$charset"
  642. Content-Transfer-Encoding: quoted-printable
  643.  
  644. $body
  645.  
  646. --$boundary
  647. Content-Type: $contentType
  648. Content-Transfer-Encoding: base64
  649. Content-Disposition: attachment; filename="$file$ext"
  650.  
  651. $file_encoded
  652. --$boundary--
  653. _EOF_
  654.  
  655.             push(@mails, \%mail);
  656.         }
  657.     }
  658. }
  659.  
  660. #  Add mail headers and remove non-ASCII characters
  661. foreach my $refmail (@mails) {
  662.     foreach my $h (keys(%headers)) {
  663.         if ($UTF8) {
  664.             $refmail->{$h} = encode_qp($headers{$h});
  665.             $refmail->{$h} =~ s/=$//m;
  666.             $refmail->{$h} =~ s/(\S*=\S*)/=?utf-8?Q?$1?=/g;
  667.         } else {
  668.             $refmail->{$h} = &DropNonASCII($headers{$h});
  669.         }
  670.     }
  671.     foreach my $h (qw(From To Subject)) {
  672.         if ($UTF8) {
  673.             unless ($refmail->{$h} =~ m/=\?utf-8\?Q\?/) {
  674.                 $refmail->{$h} = encode_qp($refmail->{$h});
  675.                 $refmail->{$h} =~ s/=$//m;
  676.                 $refmail->{$h} =~ s/(\S*=\S*)/=?utf-8?Q?$1?=/g;
  677.             }
  678.         } else {
  679.             $refmail->{$h} = &DropNonASCII($refmail->{$h});
  680.         }
  681.     }
  682.     $refmail->{smtp} = $SMTP_ARG if ($SMTP_ARG ne '');
  683. }
  684.  
  685. if (!$FORCE_ARG) {
  686.     my $answers = ($DEFAULT_ARG)?"[y/N/?]":"[y/N/e/?]";
  687.     QUESTION:
  688.     if ($SUBMIT_ARG) {
  689.         print "Ready to send the bug report against the package $PACKAGE_ARG, are you sure? $answers ";
  690.     } elsif (length $CALL) {
  691.         print "Ready to send the call for translation to $CALL, are you sure? $answers ";
  692.     } else {
  693.         print "Ready to send the emails, are you sure? $answers ";
  694.     }
  695.     my $line = <>;
  696.     chop $line;
  697.     if ($line eq "e" or $line eq "E") {
  698.         goto OPEN_EDITOR unless ($DEFAULT_ARG);
  699.     } elsif ($line eq "?") {
  700.         print "y    send the mail(s).\n".
  701.               "?    display this help message.\n".
  702.               ($DEFAULT_ARG?"":"e    reopen the editor.\n").
  703.               "N    exit, without sending mails.\n";
  704.         goto QUESTION;
  705.     }
  706.     exit(0) if ($line ne "Y" and $line ne "y");
  707. }
  708.  
  709. #  Make Perl compiler quiet
  710. print $Mail::Sendmail::error . $Mail::Sendmail::error if 0;
  711. foreach my $mail (@mails) {
  712.     sendmail(%{$mail}) || print "Couldn't send the email: $Mail::Sendmail::error\n";
  713. }
  714. if ($SUMMARY_ARG) {
  715.     my %summary = (
  716.         From => $FROM_ARG,
  717.         To => $FROM_ARG,
  718.         Subject => $SUBJECT,
  719.         'X-Mail-Originator' => "$PROGRAM $VERSION"
  720.     );
  721.     $summary{body} = "List of outdated files:\n";
  722.     foreach my $poFile (sort keys %$poFiles) {
  723.         $summary{body} .= '  ' . $poFile . ': ' . $poFiles->{$poFile}->{translator};
  724.         $summary{body} .= ', ' . $poFiles->{$poFile}->{team} if defined($poFiles->{$poFile}->{team});
  725.         $summary{body} .= "\n";
  726.     }
  727.     $summary{body} .= "Translators received the mail below.\n\n";
  728.     $summary{body} .= encode_qp(&RemoveHeaders($BODY));
  729.     sendmail(%summary) || print "Couldn't send the email: $Mail::Sendmail::error\n";
  730. }
  731. exit(0);
  732.  
  733. ###############################################################################
  734.  
  735. sub OpenEditor
  736. {
  737.     my $editor = shift;
  738.     my $body = shift;
  739.     my $opts = "";
  740.     my $tmpnam = tmpnam();
  741.  
  742.     open (OUT, "> $tmpnam")
  743.         or die ("Couldn't write $tmpnam: $!\nExiting!\n");
  744.     print OUT $body;
  745.     close(OUT)
  746.         or die ("Couldn't close $tmpnam: $!\nExiting!\n");
  747.  
  748.     $opts = "-f" if ($editor eq "vim");
  749.     system("$editor $opts $tmpnam");
  750.  
  751.     $body = &ReadFile($tmpnam) if (-f $tmpnam);
  752.     unlink($tmpnam);
  753.  
  754.     return $body;
  755. }
  756.  
  757. sub ParseHeaders
  758. {
  759.     my $body = shift;
  760.     my %headers = ();
  761.  
  762.     while ($body =~ s/^#[ \t]*([^\n]*)\n//s) {
  763.         my $comment = $1;
  764.         if ($comment =~ m/^([a-zA-Z0-9_-]+):\s*([^\n]+)$/) {
  765.             $headers{$1} = $2;
  766.         }
  767.     }
  768.     return %headers;
  769. }
  770.  
  771. sub ParseTo
  772. {
  773.     my $body = shift;
  774.     my %To = ();
  775.  
  776.     while ($body =~ s/#[ \t]*([^\n]*)\n//s) {
  777.         my $comment = $1;
  778.         if ($comment =~ s/^##[ \t]*\[(?:\*|x)\][ \t]*([^:]*):[ \t]*([^\n]*)$//s) {
  779.             $To{$1} = $2;
  780.         }
  781.     }
  782.     return %To;
  783. }
  784.  
  785. sub RemoveHeaders
  786. {
  787.     my $body = shift;
  788.     #  First remove comments
  789.     1 while $body =~ s/^#[^\n]*\n//s;
  790.     #  Optional empty lines
  791.     $body =~ s/^\s+//s;
  792.     return $body;
  793. }
  794.  
  795. sub DropNonASCII {
  796.     my $text = shift;
  797.     $text =~ s/[\x80-\xff]/?/g;
  798.     return $text;
  799. }
  800.  
  801. sub ReadFile
  802. {
  803.     my $file = shift;
  804.     local $/ = undef;
  805.     open(FILE, "< $file")
  806.         or die ("Couldn't read $file: $!\nExiting!\n");
  807.     my $body = <FILE>;
  808.     close(FILE)
  809.         or die ("Couldn't close $file: $!\nExiting!\n");
  810.     return $body;
  811. }
  812.  
  813. ## Handle invalid arguments
  814. sub Help_InvalidOption
  815. {
  816.     print STDERR "Try `${PROGRAM} --help' for more information.\n";
  817.     exit 1;
  818. }
  819.  
  820. ## Print the usage message and exit
  821. sub Help_PrintHelp
  822. {
  823.     print <<_EOF_;
  824.  
  825. Usage: ${PROGRAM} [OPTIONS]
  826. Send outdated debconf PO files to the last translators.
  827.  
  828. Options:
  829.   --help                display this help and exit
  830.   --version             display version information and exit
  831.   -v, --verbose         display additional information
  832.   --noverbose
  833.   -f, --force           send the email without confirmation
  834.   --noforce
  835.   --utf8                send the mail in UTF-8
  836.   --noutf8
  837.   --podir=DIRECTORY     specify where are located the PO files
  838.   --smtp=SERVER         specify SMTP server for mailing (default localhost)
  839.   --template=TEMPLATE   specify file to use it as template for the emails
  840.   --notemplate
  841.   --default             don't open the editor and use the template as is
  842.   --nodefault
  843.   --gzip                compress PO files with gzip
  844.   --nogzip
  845.   --package=PACKAGE     specify the name of the package
  846.   --from=MAINTAINER     specify the name and the email address of the sender
  847.   --deadline=DEADLINE   specify the deadline for receiving the updated
  848.                         translations
  849.   --langs=LANGUAGES     restrict sending emails only to these languages
  850.   --languageteam        send the email also to the Language Team
  851.   --nolanguageteam
  852.   --summary             send a status report to the maintainer with the list
  853.                         of emails sent to translators
  854.   --nosummary
  855.   --submit              send a bug report against the package with a report
  856.                         of the outdated debconf translations
  857.   --bts=BUGNUMBER       specify the Debian bug number to set as reply-to
  858.   --call[=LIST]         send a call for translations to the LIST (or to
  859.                         the Debian I18N mailing list by default
  860.   --potfile=FILE        when used with --call, specifies the POT file to
  861.                         attach to the call for translations
  862.  
  863. _EOF_
  864.     exit 0;
  865. }
  866.  
  867. ## Print the version text and exit
  868. sub Help_PrintVersion
  869. {
  870.     print <<_EOF_;
  871. ${PROGRAM} $VERSION
  872. Copyright (C) 2004-2006 Fabio Tranchitella and Denis Barbier.
  873. This is free software; see the source for copying conditions.  There is NO
  874. warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  875. _EOF_
  876.     exit 0;
  877. }
  878.  
  879. sub Verbose
  880. {
  881.     my $msg = shift;
  882.     return unless $VERBOSE_ARG;
  883.     $msg =~ s/^/**${PROGRAM}: /mg;
  884.     print STDERR $msg."\n";
  885. }
  886.