dl10n 3.00 / usr / share / perl5 / Debian / L10n / Utils.pm

=head1 NAME

Debian::L10n::Utils - Utilities for the dl10n tools

=cut

package Debian::L10n::Utils;

use strict;
use utf8;

use Mail::Address;
use Date::Parse;
use Date::Format;
use Encode;

my $VERSION = "1.0";				# External Version Number

our %Status = (
	todo => 0,
	itt  => 1,
	rfr  => 2,
	itr  => 3,
	lcfc => 4,
	bts  => 5,
	fix  => 6,
	done => 7,
	hold => 8,
	maj  => 9,
	);

our %Status_syn = (
	ddr  => 'rfr',
	relu => 'lcfc',
	lfcf => 'lcfc', #this seems to be a current typo
	taf  => 'todo',
	);

our %Type_syn = (
	'debian-installer' => 'podebconf',	# debian-installer is a sub-category
	'debconf-po'       => 'podebconf',	# typo
	'po-debconf'       => 'podebconf',	# That's the way it should be witten in DB
	'po-man'           => 'man',      	# nobody uses po4a so far, but it may come
	);

our %LanguageList = (
	ar    => 'arabic',
	ca    => 'catalan',
	cs    => 'czech',
	de    => 'german',
	en    => 'english',
	es    => 'spanish',
	fr    => 'french',
	gl    => 'galician',
	nl    => 'dutch',
#	pt    => 'portuguese',
	pt_BR => 'portuguese',
	ro    => 'romanian',
	ru    => 'russian',
	sk    => 'slovak',
	sv    => 'swedish',
	tr    => 'turkish',
	);

our %Language = (
	ar    => 'arabic',
	ca    => 'catalan',
	cs    => 'czech',
	de    => 'german',
	en    => 'english',
	es    => 'spanish',
	fr    => 'french',
	gl    => 'galician',
	nl    => 'dutch',
#	pt    => 'portuguese',
	pt_BR => 'brazilian',
	ro    => 'romanian',
	ru    => 'russian',
	sk    => 'slovak',
	sv    => 'swedish',
	tr    => 'turkish',
	);


=head2 parse_subject(SUBJECT)

parse_subject extract valuable informations from a subject line.

It gets a string containing the subject line (SUBJECT).

It returns an array containing the status, type, filename strings and bug
number if provided or 'undef' if no status is found.

=cut

sub parse_subject($) {
	my $subject = shift;
	$subject =~ s/^Subject: //;
	$subject =~ s/ / /;

	$subject =~ m/^\p{IsSpace}*\[([^\]]*)\].*?([^:\p{IsSpace}]*):\/\/(\P{IsSpace}*)(.*)$/;

	return undef unless $1;

	my $status = lc $1;
	my $type   = lc $2;
	my $names  =    $3;
	my $subject_end = $4;

	# Mutt split long subject and can introduce tabulations even if there were no spaces.
	# We remove the tabulations if inside {}, which deals with most of the long subjects.
	while (    defined $subject_end
	       and $names =~ m/\{[^\}]*$/
	       and $subject_end =~ m/^\t+(\S*)(.*)\}(.*)$/) {
		$names .= $1;
		$subject_end = $2."\}".$3;
	}
	if (defined $subject_end) {
		if ($subject_end =~ m/^(\S+)/) {
			$names .= $1;
		}
	}

	$status =~ s/\p{IsSpace}//g;
	$status =~ s/#?\p{IsDigit}*$//;
	$status = $Status_syn{$status} if (defined $Status_syn{$status} && defined $Status{$Status_syn{$status}});
	return undef unless defined $Status{$status};

	$type = $Type_syn{$type} if defined $Type_syn{$type};

	$subject =~ m/#\p{IsSpace}*(\p{IsDigit}+)/;
	my $bug_nb = $1 || undef;

	my @names;
	if ($names =~ m/{/) {
		$names =~ m/^([^{]*){([^}]*)}(.*)$/;
		my $begin = $1 || "";
		my $end   = $3 || "";
		if (defined $2) {
			@names = map { "$begin$_$end" } split(/,/, $2);
		} else {
			warn "Could not parse Subject: '$subject'\n";
		}
	} else {
		@names = ($names);
	}

#	print "Status='$status'; Type='$type'; ". (defined $bug_nb ? "bug_nb='$bug_nb'":"[no bug]")."\n";
	return ($status, $type, $bug_nb, @names);
}


=head2 parse_from(FROM)

parse_from extract the sender name from the 'From:' field.

The name is build from the phrase part of the field, or if none is found, from
the comment part where parentheses are removed, or if none is found, from the
address where all non-alphanumeric characters are turned into spaces.

It gets a string containing the 'From:' field (FROM).

It returns a string containing the name.

=cut

sub parse_from($) {
	$_ = shift;

	return "UNDEF" if not defined $_;

#	No need to recode anything at this point, at least for the BTS
#	# http://lists.debian.org/debian-l10n-english/2009/07/msg00039.html
#	# Do not recode with a broken encoding
#	unless ($_ =~ m/=?unknown-8bit?b?/) {
#		Encode::from_to($_, 'MIME-Header', 'utf8');
#	}

	s/^From: //;
	s/"//g;
	s/;/SEMICOLON/g;

	my @from = Mail::Address -> parse($_);

	$_ = $from[0]->phrase;
	s/SEMICOLON/;/g;
	s/ ; /;/g;

	unless ($_) {
		$_ = $from[0]->comment;
		s/^\p{IsSpace}*\(?//;
		s/\)?\p{IsSpace}*$//;
		s/SEMICOLON/;/g;
		s/ ; /;/g;
	}

	unless ($_) {
		$_ = $from[0]->address;
		s/\P{IsAlnum}/ /g;
	}

	$_ =~ s/^\s*"(.*)"\s*$/$1/g;

	return $_;
}


=head2 parse_date(DATE)

parse_date extract the date from a 'Date:' field.

It gets a string containing the 'Date:' field (DATE).

It returns a string containing the date in ISO format yyyy-mm-dd hh:mm:ss
±hh:mm based on GMT

=cut

sub parse_date($) {
	my $d = shift;

	my $date;

	if ($d =~ m/^Date: (.*)$/) {
		$date = Date::Format::time2str("%Y-%m-%d %T %z", Date::Parse::str2time($1), "GMT");
	} else {
		$date = Date::Format::time2str("%Y-%m-%d %T %z", $d, "GMT");
	}

	return $date;
}

=head1 LICENSE

This program is free software; you can redistribute it and/or modify it under
the terms of the GNU General Public License as published by the Free Software
Foundation; either version 2 of the License, or (at your option) any later
version.

This program is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
PARTICULAR PURPOSE.  See the GNU General Public License for more details.
# You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software Foundation, Inc.,
59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

=head1 COPYRIGHT (C)

 2003,2004 Tim Dijkstra
 2004 Nicolas Bertolissio
 2004 Martin Quinson
 2008 Nicolas François

=cut

1;