#!/usr/bin/perl -w
#
#  emlocale -- virtual language tool for cross compiling
#  Copyright (C) 2006, 2007  Neil Williams <codehelp@debian.org>
#
#  This package 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 3 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, see <http://www.gnu.org/licenses/>.
#

# emlocale is intended to separate out the individual translation files from
# a single Debian package into an emdebian package without any translation files
# and a series of emdebian locale packages, one per translation.
# e.g. libqof1 contains 6 translations. In Debian, all six are contained in the
# main library package, libqof1. emlocale automatically generates the control data
# for a foo-locale-$LANG_$version_all.deb package for each translation.
# Users then only need to install the single translation file for their
# own locale. A userspace tool, langupdate, is designed to assist in keeping these
# locale packages updated.

# Run emlocale when first creating an emdebian package from a Debian
# package and again at each upstream release to update the emdebian
# patch system with new translations.

use File::HomeDir;
use Debian::Debhelper::Dh_Lib;
use Debian::DpkgCross;
use Cache::Apt::Package;
use Cache::Apt::Lookup;
use Cache::Apt::Config;
use Emdebian::Tools;
use Term::ANSIColor qw(:constants);
use Cwd;
use strict;
use vars qw( $dpkg_cross_dir $suite $result $version $package $arch
$source $depends $section $priority $control $locale $emlocale
%package_list $print $maintainer $homepage $file %lang_codes $lang
$name $fullname @control_data @emdebian_lines $lang @new_locales
$ourversion $progname @packages $mainpackage %lang_equiv $verbose
$keepdebs );

$ourversion = &tools_version();
$dpkg_cross_dir = &get_aptcross_dir;
$progname = basename($0);

# read in dpkg-cross default arch
&read_config();
$arch = &get_architecture();
# emlocale needs a default arch even if none is set in dpkg-cross.
# this default is used to retrieve typical cache data and a
# typical .deb that may contain translation files. The architecture chosen
# has no effect on the actual translation calculation. This is needed because
# translation files are distributed across both 'Architecture: any' and
# 'Architecture: all' packages in Debian.
$arch = "arm" if ((!$arch) || ($arch eq ""));

# Pseudo-code:
# Retrieve package specific data from the dpkg-cross/apt-cross cache.
# 	Package: (forms the root of the new package names), Version: (includes emN)
# 	Source: used in generated description, Section:, Priority:, Maintainer:,
# 	Architecture: arm, Homepage:,
# Scan the contents of the Debian package for LC_MESSAGES/$source.mo files.
# Convert locale name to an appropriate form for the package
#	(en_GB becomes en-gb, sr@Latn becomes sr+ltn)
# Check emdebian patched debian/control for existing support for this locale
# Append control data to debian/control to form the basis of the emdebian patch

sub usageversion {
	print(STDERR <<END)
$progname version $ourversion

Usage:
 emlocale [-v|--verbose] [-q|--quiet] [-k|--keep]
 emlocale -c|--clean
 emlocale -?|-h|--help|--version

Options:
 -k|--keep:        Retain downloaded Debian packages for later
                   processing.
 -c|--clean:       Remove previously downloaded packages and exit.
 -v|--verbose:     Increase verbosity (max: 3)
 -q|--quiet:       Reduce verbosity.
 -?|-h|--help:     print this usage message and exit
 --version:        print this usage message and exit

emlocale is intended to separate out the individual translation files from
a single Debian package into an emdebian package without any translation files
and a series of emdebian locale packages, one per translation.
Generated packages use the syntax:
\$package-locale-\$language_code_\$emdebianversion_all.deb

Certain language codes need to be modified to make acceptable components
of a debian / emdebian package name. Underscores are converted to hyphens,
'\@' is converted to '+' and all codes are made lowercase. These changes only
apply to the package name, the installation location is unchanged.

Default operation checks the specified package for translation files and
prints the additional control data required to define the individual
translation packages.

Update mode requires that emlocale is run in a Debian source tree and
will check the Debian package for existing locale packages before appending
locale package data to debian/control.

END
		|| die "$progname: failed to write usage: $!\n";
}

$verbose = 1;
$keepdebs = 0;
my $seen = "";

while( @ARGV ) {
	$_= shift( @ARGV );
	last if m/^--$/;
	if (!/^-/) {
		unshift(@ARGV,$_);
		last;
	}
	elsif (/^(-\?|-h|--help|--version)$/) {
		&usageversion();
		exit( 0 );
	}
	elsif (/^(-k|--keep)$/) {
		$keepdebs = 1;
	}
	elsif (/^(-c|--clean)$/) {
		&cleandebs();
		exit (0);
	}
	elsif (/^(-v|--verbose)$/) {
		$verbose++;
	}
	elsif (/^(-q|--quiet)$/) {
		$verbose--;
	}
	else {
		die RED, "$progname: Unknown option $_.", RESET, "\n";
	}
}

$maintainer = $source = $section = $priority = "";
&init;
@packages = getpackages();
$mainpackage = $dh{MAINPACKAGE};
&parse_control;
exit 0;

sub print_control()
{
	my $clog = `parsechangelog --format dpkg`;
	$clog =~ /Version: (.*)\n/;
	my $cversion = $1;
	push @emdebian_lines, "\n";
	foreach $lang (@_)
	{
		# $mainpackage is the root for all locale packages.
		$mainpackage =~ s/-$//;
		$fullname = $mainpackage . "-locale-" . $lang;
		print GREEN, "locale package name = $fullname\n", RESET if ($verbose >= 2);
		my $newdeb = "Package: $fullname\n";
		$newdeb .= "Priority: extra\n";
		$section = "misc" if (not defined ($section));
		$newdeb .= "Section: $section\n";
		# languages should be all.
		$newdeb .= "Architecture: all\n";
		$newdeb .= "Description: $lang translation for $mainpackage\n";
		$newdeb .= "XC-Package-Type: tdeb\n";
		$newdeb .= "\n";
		push @emdebian_lines, $newdeb;
	}
}

sub print_files()
{
	foreach $lang (@_)
	{
		my $langname = $lang_equiv{$lang};
		$fullname = $mainpackage . "-locale-" . $lang;
		# now create the .files content, updating anything there already
		print CYAN, "Writing debian/$fullname for $langname support\n", RESET if ($verbose >=3);
		open (FILES, ">debian/$fullname.files") or
			die (RED, "Cannot create new .files files in debian/: $!", RESET);
		print FILES "usr/share/locale/$langname/*\n";
		close (FILES);
		open (INSTALLS, ">debian/$fullname.install") or
			die (RED, "Cannot create new .install files in debian/: $!", RESET);
		print INSTALLS "debian/tmp/usr/share/locale/$langname/LC_MESSAGES/*\n";
		close (INSTALLS);
	}
}

# reads the *Debian* package data to ensure the emdebian data is
# up to date.
sub cache_control()
{
	$suite = &get_targetsuite();
	print CYAN, "Reading cached package data\n", RESET if ($verbose >= 1);
	my $emp = AptCrossPackage->new();
	$emp->Package($_[0]);
	&get_cachedir;
	my $config = &init_host_cache($verbose);
	$emp = &lookup_pkg($emp);
	$version = $$emp->Version;
	$name = $$emp->Package;
	# remove SONAME if present
	if ($name =~ /^lib/)
	{
		$name =~ s/[0-9]$//;
	}
	$source = $$emp->Source;
	$section = $$emp->Section;
	# locale packages have no dependencies and no reverse dependencies so priority is a no-op.
	$priority = "extra";
	$maintainer = $$emp->Maintainer;
	print GREEN, "Source: $source Section: $section Priority: $priority Maintainer: $maintainer\n", RESET
		if (($verbose >= 2) and ($maintainer));
}

sub find_messages()
{
	my $code;
	my $v = "";
	my $location = cwd();
	# skip our own packages
	return if ($_[0] =~ /\Q-locale-\E/);
	print GREEN, "Using apt-cross to download Debian package $_[0] to /tmp.\n", RESET if ($verbose >= 1);
	my $emp = AptCrossPackage->new;
	$emp->Package($_[0]);
	$emp = &lookup_pkg($emp);
	my $version = $$emp->Version;
	if (defined $$emp->Version)
	{
		# strip the epoch from the version for this test.
		$version =~ s/[0-9]://;
		my $a = (defined ($$emp->Architecture)) ? $$emp->Architecture : $arch;
		chdir ("/tmp");
		$v = "-v" if ($verbose >= 1);
		$v .= " -v" if ($verbose > 3);
		system "apt-cross $v -a $arch -f --get $_[0] 2> /dev/null";
		my $name = $_[0] . "_" . $version . "_" . $a . ".deb";
		print CYAN, "Calling dpkg to locate translations within the $name package.\n", RESET
			if ($verbose >= 1);
		$result = "";
		if ( -f $name)
		{
			$result = `dpkg -c $name`;
		}
		else
		{
			$name = $_[0] . "_" . $version . "_all.deb";
			$result = `dpkg -c $name` if (( -f $name) && ($seen ne $name));
			$seen = $name;
		}
		my @list = split (/\n/, $result);
		foreach $file (@list)
		{
			$code = '';
			if ($file =~ /locale\/(.*)\/LC_MESSAGES\/.*\.mo/)
			{
				my $a = $code = $1;
				$code =~ s/[_]/-/;
				$code =~ s/[@]/+/;
				$code = lc ($code);
				$code =~ s/\/.*//;
				$a =~ s/\/.*//;
				# tidy up the reported filename
				$file =~ s/.*(locale\/.*)/$1/;
				print CYAN, "found $file\n", RESET if ($verbose >= 2);
				# if a package has more than one translation, only set one lang_code
				$lang_codes{$code} = 1;
				$lang_equiv{$code} = $a;
			}
		}
		if ($keepdebs > 0)
		{
			my $file = "$dpkg_cross_dir/emlocale.cache";
			open (KP, ">>$file") or
				warn (RED, "Cannot create list of downloaded packages in $file: $!", RESET);
			print (KP "$name\n");
			close (KP);
		}
		else
		{
			unlink ($name);
		}
	}
	# last try, check for a po[-*]?/ directory
	print "Checking package files...\n" if ($verbose >= 2);
	chdir $location;
	opendir (PO, ".") or die (RED, "$progname: Failed to open current directory.\n", RESET);
	my @podirs=grep(!/^\.\.?$/, readdir PO);
	closedir(PO);
	foreach my $podir (@podirs)
	{
		next unless $podir =~ /^po[-]?.*/;
		next unless (-d $podir);
		opendir (PO, "$podir") or die (RED, "$progname: Failed to read po/ directory.\n", RESET);
		my @pofiles=grep(/.*\.po$/, readdir PO);
		closedir (PO);
		foreach my $pofile (@pofiles)
		{
			$pofile =~ /(.*)\.po$/;
			my $a = $code = $1;
			$code =~ s/[_]/-/;
			$code =~ s/[@]/+/;
			$code = lc ($code);
			$code =~ s/\/.*//;
			$a =~ s/\/.*//;
			# tidy up the reported filename
			$file =~ s/.*(locale\/.*)/$1/;
			print CYAN, "found $pofile : $code : $a\n", RESET if ($verbose >= 2);
			# if a package has more than one translation, only set one lang_code
			$lang_codes{$code} = 1;
			$lang_equiv{$code} = $a;
		}
	}
}

sub parse_control()
{
	my @package_list = ();
	# remove SONAME
	if ($mainpackage =~ /(.*)[0-9]$/)
	{
		$mainpackage = $1;
	}
	$mainpackage =~ s/-$//;
	my $pkg;
	# check this is a debian working directory
	print GREEN, "Checking for debian/control\n", RESET if ($verbose >= 3);
	&check_emdebian_control;
	# parse the changelog to identify the $suite
	my $clog = `parsechangelog --format dpkg`;
	my $r = $clog;
	$r =~ /^Source: (.*)\n/;
	my $source = $1;
	# debhelper gets confused and puts the wrong "mainpackage" sometimes.
	$mainpackage = $source if (($mainpackage ne $source) && ($source ne ""));
	$r = $clog;
	$r =~ /Version: (.*)\n/;
	my $vers = $1;
	$r = $clog;
	$r =~ /Changes: .*\n/;
	$r =~ /\Q $source \($vers\) (.*);.*\n\E/;
	$suite = $1;
	print CYAN, "Source: $source Version: $vers\n", RESET if ($verbose >= 3);
	if ( -f "debian/control.in")
	{
		print GREEN, "Found debian/control.in\n", RESET if ($verbose >= 3);
		$file = "debian/control.in";
		open (CONTROL, $file) or die "Cannot open $file $!";
		my @data=<CONTROL>;
		close CONTROL;
		my $exists = join ('', @data);
		$_=$exists;
		@package_list = m/Package: (.*)\n/g;
	}
	print GREEN, "Using debian/control\n", RESET if ($verbose >= 3);
	$file = "debian/control";
	open (CONTROL, $file) or die "Cannot open $file $!";
	my @data=<CONTROL>;
	close CONTROL;
	my $exists = join ('', @data);
	$_=$exists;
	push @package_list, m/Package: (.*)\n/g;
	&cache_control($dh{MAINPACKAGE});
	if ($verbose == 1)
	{
		print CYAN, "Downloading Debian packages to calculate translation data . . .\n", RESET;
		print CYAN, "(this can take a while with large packages)\n", RESET;
	}
	foreach $pkg (@package_list)
	{
		next if ($pkg =~ /^$dh{MAINPACKAGE}-locale-/);
		print CYAN, "Checking $pkg\n", RESET if ($verbose >= 2);
		&find_messages($pkg);
	}
	# check to prevent duplication
	print CYAN, "Checking for existing translation packages.\n", RESET if ($verbose >= 2);
	my @sorted = sort (keys %lang_codes);
	foreach $lang (@sorted)
	{
		$fullname = $mainpackage . "-locale-" . $lang;
		my $line = "Package: $fullname\n";
		next if ($exists =~ /\Q$line\E/);
		push @new_locales, $lang;
	}
	$file = "debian/control.in" if ( -f "debian/control.in");
	print GREEN, "Writing new translation package data to $file.\n", RESET if ($verbose >= 2);
	&print_control(@new_locales);
	&print_files(sort keys %lang_codes);
	open (CONTROL, ">>$file") or die RED, "Cannot open $file $!", RESET;
	print CONTROL @emdebian_lines;
	close CONTROL;
	&remove_orig;
}

sub remove_orig
{
	my $file;
	my @orig;
	my @data;
	my $line;
	print GREEN, "Removing translation files from original package.\n", RESET if ($verbose >= 3);
	opendir(EM, "debian/") || die RED, "Cannot open debian directory: $!", RESET;
	while ($file=readdir EM)
	{
		next if (-d "debian/$file");
		next if ($file =~ /^rules$/);
		next if ($file =~ /-locale-/);
		open (F, "debian/$file") or warn RED, "Cannot open debian/$file: $!", RESET;
		while (<F>)
		{
			if (m[usr/share/locale])
			{
				push @orig, $file;
			}
		}
		close(F);
	}
	closedir(EM);
	foreach $file (@orig)
	{
		open (SRC, "debian/$file") or warn RED, "Cannot read debian/$file: $!", RESET;
		@data=<SRC>;
		close SRC;
		open (DEST, ">debian/$file") or warn RED, "Cannot write debian/$file: $!", RESET;
		foreach $line (@data)
		{
			next if ($line =~ m[usr/share/locale]);
			print DEST $line;
		}
		close DEST;
	}
}

sub cleandebs
{
	my $cwd = cwd();
	my @cleanlist;
	my $file = "$dpkg_cross_dir/emlocale.cache";
	open (KP, "$file") or
		warn (RED, "Cannot read list of downloaded packages in $file: $!", RESET);
	@cleanlist=<KP>;
	close (KP);
	chdir ("/tmp");
	foreach $file (@cleanlist)
	{
		$file = chomp($file);
		unlink $file;
	}
	open (KP, ">$file") or
		warn (RED, "Cannot clear list of downloaded packages in $file: $!", RESET);
	close (KP);
	chdir ("$cwd");
}
