#!/usr/bin/perl -w
#
#  em_make -- Prepare an Emdebian package from Debian source.
#
#  Copies upstream debian/* files into a $package.old directory
#  makes changes for emdebian and then creates relevant patches.
#
#  Copyright (C) 2006,2007  Neil Williams <codehelp@debian.org>
#  Copyright (C) 1998-2006 Craig Small <csmall@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.
#

use Cwd;
use File::HomeDir;
use Debian::Debhelper::Dh_Lib;
use Emdebian::Tools;
use strict;
require "dpkg-cross.pl";

use vars qw/ @packages $username $email $date $native $emdebvers $emN $progname $ourversion $verbose $source $home $arch $forceold %archtable /;

$ourversion = "0.1.1";
$verbose = 1;
&read_config();
$arch = &get_architecture();
$forceold = 0;

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

Usage:
 em_make [-a|--arch ARCH] [--forceold] [-v|--verbose] [-q|--quiet]
 em_make -h|--help|--version

Options:
 -a|--arch ARCH:      set architecture (default: defined by dpkg-cross)
 -v|--verbose:        Increase verbosity (max: 3)
    --forceold:       Force em_make to accept an old or missing
                      toolchain. Packages built with old versions
                      of gcc must not be uploaded to the Emdebian 
                      repositories.
 -q|--quiet:          Reduce verbosity.
 -h|--help:           print this usage message and exit
 --version:           print this usage message and exit

em_make is the emdebian version of dh_make.

Many packages will require manual editing of debian/rules or 
other files after running 'em_make' to make a usable 
emdebian package.

em_make calculates an emdebian versionstring for an initial 
emdebian release and inserts an entry into debian/changelog.
It parses debian/control (or debian/control.in if it exists), 
truncates all debian/*.doc-base.* files and removes all 
package descriptions that end in -doc from debian/control.

Only run em_make once for each package!

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

while( @ARGV ) {
    $_= shift( @ARGV );
    last if m/^--$/;
    if (!/^-/) {
        unshift(@ARGV,$_);
		last;
    }
	elsif (/^(-h|--help|--version)$/) {
        &usageversion();
		exit( 0 );
	}
	elsif (/^(-v|--verbose)$/) {
		$verbose++;
	}
	elsif (/^(-q|--quiet)$/) {
		$verbose--;
	}
	elsif (/^(-a|--arch)$/) {
		$arch = shift(@ARGV);
	}
	elsif (/^(--forceold)$/) {
		$forceold = 1;
	}
	else {
		die "$progname: Unknown option $_.\n";
	}
}

if ((!$arch)||($arch eq ""))
{
	die ("$progname: No default architecture and --arch not used.\n");
}
my $suite = &get_suite;
my $target_gnu_type = $archtable{$arch};
my $check = &check_toolchains($arch, $target_gnu_type);
# for non-standard toolchains.
if (($forceold == 1) && ($check eq "false"))
{
	print "Old or missing toolchain detected but '--forceold' used.\n";
	print "This setup is not supported by emdebian-tools, some scripts\n";
	print "(including this one) may not function correctly.\n";
	print "Packages built with this setup should not be uploaded to\n";
	print "Emdebian repositories.\n";
	$check = "true";
}
my $msg = qq/Unable to locate the cross-building toolchain, please run emsetup.\n/;
die ($msg) if ($check eq "false");

&check_emdebian_control;

&init;
@packages = &getpackages();
my $parse = `parsechangelog`;
$parse =~ /Source: (.*)\n/;
$source = $1;
$native = isnative($dh{MAINPACKAGE});
$source = $dh{MAINPACKAGE} if (!$source);

# handle svn here?
# check for emdebian-$arch-linux-gnu.cache.patch

# create a changelog entry
my $log = `dpkg-parsechangelog`;
$log =~ /(Version: .*)\n/;
if (&extract_emdebversion($1) ne "")
{
	die "\n$0 : $source has already been emdebianised.\n";
}
# remove other debhelper doc install calls and prepare a patch for rules.
&prepare_patches;

my $vers = &emdeb_versionstring("new");
system "debchange -p -v $vers \"New emdebian release.\"";

# find *.doc-base.* files and truncate each.
&remove_docbase();

# locate the -doc package(s) in control and remove.
&remove_doc_pkg();

# locate the -udeb package(s) in control and remove.
&remove_udeb();

# run emlocale only once we have a path to it via the emdebian-tools package.
# emlocale will check location as well but that's OK.
print "Running emlocale to handle translations . . \n" if ($verbose >= 1);
my $v = "";
$v = "-v" if ($verbose == 2);
$v = "-v -v" if ($verbose == 3);
system "emlocale $v -k" if (-f "/usr/bin/emlocale");

# create or update patches for all @patchfiles
&create_patches($source);

# end
exit 0;

# subroutines

sub remove_doc_pkg
{
	my @control_data;
	my $flag;
	my $file;
	# some packages pre-process control in debian/rules (e.g. Gnome)
	if ( -f "debian/control.in")
	{
		$file = "debian/control.in";
	}
	else
	{
		$file = "debian/control";
	}
	print "Checking $file for -doc packages\n" if ($verbose >= 2);
	open (CONTROL, $file) or die "Cannot open debian/control $!";
	while (<CONTROL>)
	{
		if (/^Package:\s*(.*)-doc\n/) {
			$flag = 1;
			next;
		}
		if (/^\n ?$/) {
			$flag = 0;
			push @control_data, "\n";
			next;
		}
		if (!$_) {
			$flag = 0;
			next;
		}
		push @control_data, $_ if (!$flag);
	}
	close (CONTROL);
	open (CONTROL, ">$file") or die "Cannot open debian/control $!";
	print CONTROL @control_data;
	close CONTROL;
}

sub remove_udeb
{
	my @control_data;
	my $flag;
	my $file;
	# some packages pre-process control in debian/rules (e.g. Gnome)
	if ( -f "debian/control.in")
	{
		$file = "debian/control.in";
	}
	else
	{
		$file = "debian/control";
	}
	print "Checking $file for -udeb packages.\n" if ($verbose >= 2);
	open (CONTROL, $file) or die "Cannot open debian/control $!";
	while (<CONTROL>)
	{
	#  XC-Package-Type: udeb
		if (/^Package:\s*.*-udeb\n/) {
			$flag = 1;
			next;
		}
		if (/^XC-Package-Type: udeb\n$/) {
			$flag = 2;
			next;
		}
		if (/^\n ?$/) {
			$flag = 0;
			push @control_data, "\n";
			next;
		}
		if (!$_) {
			$flag = 0;
			push @control_data, "\n";
			next;
		}
		push @control_data, $_ if (!$flag);
	}
	close (CONTROL);
	open (CONTROL, ">$file") or die "Cannot open debian/control $!";
	print CONTROL @control_data;
	close CONTROL;
}

sub remove_docbase
{
	my $f;
	opendir (DEBIAN, './debian') || die "Cannot read debian/ directory: $!";
	my @files = grep(!/^\.\.?/, readdir DEBIAN);
	closedir (DEBIAN);
	foreach $f (@files)
	{
		if ($f =~ /.*\.doc-base\..*/) {
			open (DUMP, ">debian/$f") || die "Cannot overwrite $f: $!";
			close DUMP;
		}
		if (($f =~ /.*-doc\.files$/) || ($f =~ /.*-doc.dirs$/)) {
			open (DUMP, ">debian/$f") || die "Cannot overwrite $f: $!";
			close DUMP;
		}
	}
}

# copies the originals into .old/debian and prepares first rules patch
sub prepare_patches
{
	my @patchfiles = qw/rules control control.in changelog /;
	my $package = $source;
	my @control;
	my @rules;
	my $flag;
	my $cwd = cwd;
	print ("Preparing patches for debian files.\n") if ($verbose >= 2);
	mkdir "../$package.old", 0755;
	mkdir "../$package.old/debian", 0755;
	foreach my $file (@patchfiles)
	{
		if (! -f "debian/$file") { next; }
		open (CPY, "debian/$file") or die "Cannot open $file: $!";
		@control=<CPY>;
		close CPY;
		chdir ("../$package.old/");
		open (CPY, ">debian/$file") or die "Cannot write $file: $!";
		print CPY @control;
		close CPY;
		chdir ("$cwd");
		print "$file backed up to ../$package.old/debian/\n" if ($verbose >=2);
		if ($file eq "rules") { &patch_rules($source); }
	}
}

sub patch_rules
{
	my $package = $_;
	my @rules;
	my $cwd = cwd;
	# make changes to debian/rules
	print ("Making changes to debian/rules\n") if ($verbose >= 3);
	open (RULES, "debian/rules") or die "Cannot open debian/rules $!";
	while (<RULES>)
	{
		if (m>^include /usr/share/cdbs/1/rules/debhelper.mk\n$>) {
			print ("Using emdebian debhelper class for CDBS\n") if ($verbose >= 3);
			push (@rules, "include /usr/share/emdebian-tools/emdebhelper.mk\n");
			next;
		}
		next if (/^.*DEB_MAKE_CHECK_TARGET.*\n/);
		next if (/.*dh_installdocs.*\n/);
		next if (/.*dh_installexamples.*\n/);
		next if (/.*dh_installinfo.*\n/);
		next if (/.*dh_installchangelogs.*\n/);
		next if (/.*dh_installman.*\n/);
		next if (!$_);
		push @rules, $_;
	}
	close (RULES);
	open (RULES, ">debian/rules") or die "Cannot open debian/rules $!";
	print RULES @rules;
	close RULES;
	# ready for diff -u 
	print ("Preparing emdebian-rules.patch in $source.old\n") if ($verbose >= 3);
	chdir ("../");
	my $olddir = $source . ".old/debian/";
	my $err = `diff -u $olddir/rules $cwd/debian/rules > emdebian-rules.patch`;
	exit ($err) if ($err);
	chdir ($cwd);
}

