#!/usr/bin/perl -w
#
#  emlocale -- virtual language tool for cross compiling
#  Copyright (C) 2006, 2007  Neil Williams <codehelp@debian.org>
#
#  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., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
#

# 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.

# This principle is a copy of the OpenEmbedded build.

# In Debian:
# libqof1_0.7.2-1_arm.deb
# libqof-backend-sqlite0_0.7.2-1_arm.deb
# libqof-dev_0.7.2-1_arm.deb
# libqof-doc_0.7.2-1_arm.deb
# libqof-backend-qsf0_0.7.2-1_arm.deb

# In Emdebian:
# libqof1_0.7.2-1em1_arm.deb
# libqof-backend-sqlite_0.7.2-1em1_arm.deb
# libqof-dev_0.7.2-1em1_arm.deb
# qof-locale-en-gb_0.7.2-1em1_all.deb
# qof-locale-id_0.7.2-1em1_all.deb
# qof-locale-pt-br_0.7.2-1em1_all.deb
# qof-locale-ro_0.7.2-1em1_all.deb
# qof-locale-sv_0.7.2-1em1_all.deb
# qof-locale-vi_0.7.2-1em1_all.deb

use File::HomeDir;
use Debian::Debhelper::Dh_Lib;
use Emdebian::Tools;
use Cwd;
use strict;
use vars qw( $home $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 );
require "dpkg-cross.pl";

$ourversion = "0.0.4";
$home = File::HomeDir->my_home;
$dpkg_cross_dir = "$home/.dpkg-cross";
if (not -d $dpkg_cross_dir) {
	mkdir $dpkg_cross_dir;
}

# 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

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 "$progname: Unknown option $_.\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;
	foreach $lang (@_)
	{
		# $mainpackage is the root for all locale packages.
		$mainpackage =~ s/-$//;
		$fullname = $mainpackage . "-locale-" . $lang;
		my $newdeb = "Package: $fullname\n";
		$newdeb .= "Priority: $priority\n";
		$newdeb .= "Section: $section\n";
		# languages should be all.
		$newdeb .= "Architecture: all\n";
		# Depends is probably not necessary (and goes wrong for libraries).
		#$newdeb .= "Depends: $mainpackage (>= $cversion)\n";
		$newdeb .= "Description: $lang translation for $mainpackage\n";
		# this homepage value should be omitted if not found.
		my $langname = $lang_equiv{$lang};
		$newdeb .= " This package is only needed to display $mainpackage\n";
		$newdeb .= " messages in $langname.\n";
		# Add Depends, Replaces and Conflicts of the -data/-common package?
		$newdeb .= "\n";
		push @emdebian_lines, $newdeb;
		# now create the .files content
		open (FILES, ">debian/$fullname.files") or
			die ("Cannot create new .files files in debian/: $!");
		print FILES "usr/share/locale/$langname/*\n";
		close (FILES);
		open (INSTALLS, ">debian/$fullname.install") or
			die ("Cannot create new .install files in debian/: $!");
		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_suite();
	print ("Reading cached package data\n") if ($verbose >= 2);
	my $r = `apt-cache -q -q -o Apt::Architecture=$arch -c $dpkg_cross_dir/apt.conf-$suite showsrc $_[0] 2> /dev/null`;
	$result = $r;
	$version = "";
	if ($result =~ /Version: (.*)\n/)
	{
		$version = $1;
	}
	$r = `apt-cache -q -q -o Apt::Architecture=$arch -c $dpkg_cross_dir/apt.conf-$suite show $_[0] 2> /dev/null`;
	$result = $r;
	$result =~ /Package: (.*)\n/g;
	$package = $1;
	$name = $package;
	# remove SONAME if present
	if ($name =~ /^lib/)
	{
		$name =~ s/[0-9]$//;
	}
	$result = $r;
	$result =~ /Source: (.*)\n/g;
	$source = $1;
	$result = $r;
	$result =~ /Section: (.*)\n/g;
	$section = $1;
	$result = $r;
	$result =~ /Priority: (.*)\n/g;
	$priority = $1;
	# a translation can never be 'required' priority.
	$priority =~ s/required/optional/;
	# a translation can never be 'important' priority.
	$priority =~ s/important/optional/;
	$result = $r;
	$result =~ /Maintainer: (.*)\n/g;
	$maintainer = $1;
	$result = $r;
	$result =~ /Homepage: (.*)\n/g;
	$homepage = $1;
	$result = $r;
	$result =~ /Depends: (.*)\n/g;
	$depends = $1;
	print "Source: $source Section: $section Priority: $priority Maintainer: $maintainer\n"
		if ($verbose >= 3);
}

sub find_messages()
{
	my $code;
	my $v = "";
	my $location = cwd();
	print ("\nUsing apt-cross to get Debian package $_[0].\n") if ($verbose >= 2);
	chdir ("/tmp");
	print (" .") if ($verbose == 1);
	$v = "-v" if ($verbose == 2);
	$v = "-v -v" if ($verbose == 3);
	system "apt-cross $v -a $arch --get $_[0] 2> /dev/null";
	my $name = $_[0] . "_" . $version . "_" . $arch . ".deb";
	print "Calling dpkg to locate translations within the $_[0] package.\n"
		if ($verbose >= 3);
	$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)
	{
		print (" .") if ($verbose == 1);
		$code = '';
		if ($file =~ /locale\/(.*)\/LC_MESSAGES\/.*\.mo/)
		{
			print (" .") if ($verbose == 1);
			print ("found $file\n") if ($verbose >= 3);
			my $a = $code = $1;
			$code =~ s/[_]/-/;
			$code =~ s/[@]/+/;
			$code = lc ($code);
			# 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 ("Cannot create list of downloaded packages in $file: $!");
		print (KP "$name\n");
		close (KP);
	}
	else
	{
		unlink ($name);
	}
	print (" .") if ($verbose == 1);
	chdir $location;
}

sub parse_control()
{
	# remove SONAME
	if ($mainpackage =~ /(.*)[0-9]$/)
	{
		$mainpackage = $1;
	}
	$mainpackage =~ s/-$//;
	my $pkg;
	# check this is a debian working directory
	print ("Checking for debian/control\n") 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 =~ / $source \($vers\) (.*);.*\n/;
	$suite = $1;
	print ("Source: $source Version: $vers Suite: $suite\n") if ($verbose >= 3);
	if ( -f "debian/control.in")
	{
		print ("Found debian/control.in\n") if ($verbose >= 3);
		$file = "debian/control.in";
	}
	else
	{
		print ("Using debian/control\n") if ($verbose >= 3);
		$file = "debian/control";
	}
	open (CONTROL, $file) or die "Cannot open $file $!";
	my @data=<CONTROL>;
	my $exists = join ('', @data);
	$_=$exists;
	my @package_list = m/Package: (.*)\n/g;
	&cache_control($dh{MAINPACKAGE});
	print ("Calculating translation update data . . .") if ($verbose == 1);
	foreach $pkg (@package_list)
	{
		print " ." if ($verbose == 1);
		&find_messages($pkg);
	}
	print "\n" if ($verbose == 1);
	# check to prevent duplication
	print ("Checking for existing translation packages.\n") if ($verbose >= 3);
	my @sorted = sort (keys %lang_codes);
	foreach $lang (@sorted)
	{
		$fullname = $mainpackage . "-locale-" . $lang;
		my $line = "Package: $fullname\n";
		if ($exists =~ /\Q$line\E/)
		{
			next;
		}
		push @new_locales, $lang;
	}
	close CONTROL;
	print ("Writing new translation package data to $file.\n") if ($verbose >= 2);
	&print_control(@new_locales);
	open (CONTROL, ">>$file") or die "Cannot open $file $!";
	print CONTROL "\n";
	print CONTROL @emdebian_lines;
#	print @emdebian_lines;
	close CONTROL;
	&remove_orig;
}

sub remove_orig
{
	my $file;
	my @orig;
	my @data;
	my $line;
	print ("Removing translation files from original package.\n") if ($verbose >= 3);
	opendir(EM, "debian/") || die "Cannot open debian directory: $!";
	while ($file=readdir EM)
	{
		next if (-d "debian/$file");
		next if ($file =~ /-locale-/);
		open (F, "debian/$file") || warn "Cannot open debian/$file: $!";
		while (<F>)
		{
			if (m[usr/share/locale])
			{
				push @orig, $file;
			}
		}
		close(F);
	}
	closedir(EM);
	foreach $file (@orig)
	{
		open (SRC, "debian/$file") || warn "Cannot read debian/$file: $!";
		@data=<SRC>;
		close SRC;
		open (DEST, ">debian/$file") || warn "Cannot write debian/$file: $!";
		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 ("Cannot read list of downloaded packages in $file: $!");
	@cleanlist=<KP>;
	close (KP);
	chdir ("/tmp");
	foreach $file (@cleanlist)
	{
		$file = chomp($file);
		unlink $file;
	}
	open (KP, ">$file") or 
		warn ("Cannot clear list of downloaded packages in $file: $!");
	close (KP);
	chdir ("$cwd");
}
