/usr/share/perl5/Debian/L10n/Mail.pm is in dl10n 3.00.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 | package Mail;
use strict;
use utf8;
=head1 NAME
dl10n-mail -- crawl translator mails (and BTS) for status updates
=head1 SYNOPSIS
dl10n-mail [options] mailbox lang+
=head1 DESCRIPTION
=cut
use Debian::L10n::Db;
use Debian::L10n::BTS;
use Debian::L10n::Utils;
use Mail::Box::Mbox;
use Data::Dumper;
my $VERSION = "1.0"; # External Version Number
my $Status_file='./data/status.$lang';
my $DEFAULT_MSGID;
sub process($$$$$) {
my $mboxfolder = shift;
my $lang = shift;
my $check_bts = shift;
my $init_msgId = shift;
$Status_file = shift || $Status_file;
print STDERR "mboxfolder: $mboxfolder\n";
my $db = Debian::L10n::Db->new();
my $dbName = $Status_file;
$dbName =~ s/\$lang/$lang/g;
my $msgId;
if (-e $dbName) {
$db->read($dbName, 0);
$msgId = defined($init_msgId) ? $init_msgId : ($db->get_header('Message-ID') || $DEFAULT_MSGID );
print "Spider.pm Continue $lang from message $msgId\n";
} else {
print "Spider.pm Creating a new DB for $lang\n";
# $year = $init_year;
# $month = $init_month;
# $message = $init_message;
# $page = 1;
# die "Cannot guess the begin year. Please use the --year options\n" unless defined($year);
# die "Cannot guess the begin month. Please use the --month options\n" unless defined($month);
# die "Cannot guess the begin message. Please use the --message options\n" unless defined($message);
}
if (not defined $mboxfolder) {
# TODO: use tmpfile
open TMP, ">", "/tmp/tata"
or die "Cannot open ...: $!";
while (<STDIN>) {
print TMP $_;
}
close TMP;
$mboxfolder = "/tmp/tata";
}
my $f = Mail::Box::Mbox->new(folder => $mboxfolder, lock_type => undef)
or die "Cannot open mailbox $mboxfolder.\n";
my $url = ""; # not used.
# Try to see if this Message-ID is in the mailbox
my $found = 0;
if (defined $msgId) {
foreach my $m ($f->messages) {
if ($m->messageId eq $msgId) {
$found = 1;
last;
}
}
}
my ($status, $type, $bug_nb, @names);
foreach my $m ($f->messages) {
if ($found) {
if ($m->messageId eq $msgId) {
$found = 0;
}
last;
}
($status, $type, $bug_nb, @names) = Debian::L10n::Utils::parse_subject($m->subject);
print "Mail.pm: ".$m->subject."\n";
next unless $status; # unparsable mail
my $translator;
my $sender = $m->sender;
if (defined $sender) {
# May need to take care of the following that has been ejected from Debian/L10n/Utils.pm
# unless ($_ =~ m/=?unknown-8bit?b?/) {
# Encode::from_to($_, 'MIME-Header', 'utf8');
# }
$translator = Debian::L10n::Utils::parse_from($sender->format());
} else {
$translator = "UNDEF";
}
my $date = Debian::L10n::Utils::parse_date("Date: ".$m->head->get('Date'));
# We keep this Message-ID to reference this message
my $list = $m->messageId;
$msgId = $m->messageId;
foreach my $pkg (@names) {
my $file = $pkg;
if (($type eq 'webwml') or ($type eq 'wml')) {
$type = "wml";
$pkg =~ s|/.*||;
if (($pkg=~/\./) && not($pkg =~ /\.wml$/)) {
$file =~ s|.*?/||;
} else { # www.debian.org
$pkg = 'www.debian.org';
}
} else {
$pkg =~ s|/.*||;
$file =~ s|.*?/||;
}
if ($db->has_package($pkg)) {
# If a cycle was already finished.
# Clear the status of this file
# before we add status for the
# new cycle.
foreach my $statusline (@{$db->status($pkg)}) {
my ($type_from_db, $file_from_db, $date_from_db, $status_from_db, $translator_from_db, $list_from_db, $url_from_db, $bug_nb_from_db) = @{$statusline};
if ( $type eq $type_from_db
and $file eq $file_from_db
and $status_from_db eq 'done'
and $status ne 'done') {
$db->del_status($pkg, $type, $file, $statusline);
}
}
}
unless ($db->has_package($pkg)) {
$db->package($pkg);
$db->add_package($pkg,$pkg);
}
$db->add_status($pkg, $type, $file, $date, $status, $translator, $list, $url, ($bug_nb || ""));
}
} continue {
$db->set_header('Message-ID', $msgId );
$db->write($dbName);
}
Debian::L10n::BTS::check_bts($db, $dbName) if $check_bts;
$db->write($dbName);
Debian::L10n::Db::clean_db($db);
$db->write($dbName);
}
1;
|