#!/usr/bin/perl -w

# Copyright (C) 2008-2010 Modestas Vainius <modax@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 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/>

use strict;
use warnings;

use Debian::PkgKde qw(setup_datalibdir);
BEGIN {
    setup_datalibdir("Dpkg/Shlibs/SymbolFile.pm");
}

use File::Spec;
use File::Basename qw();
use File::Copy qw();
use Getopt::Long qw(:config noignore_case);
use Dpkg::ErrorHandling;
use Dpkg::Arch qw(get_host_arch get_valid_arches);
use Dpkg::Version;
use Dpkg::IPC;

use Debian::PkgKde::SymbolsHelper::SymbolFile;
use Debian::PkgKde::SymbolsHelper::SymbolFileCollection;
use Debian::PkgKde::SymbolsHelper::Patching;

######## Option processing ##################
my $opt_out;
my $opt_backup;
my $opt_in;
my $opt_package;
my $opt_arch = get_host_arch();
my $opt_version;
my $opt_verbose;

sub verify_opt_arch {
    my ($opt, $arch) = @_;
    error("unknown architecture: $arch")
	unless grep /^\Q$arch\E$/, get_valid_arches();
    $opt_arch = $arch;
}

sub verify_opt_in {
    my ($opt, $input) = @_;

    error("input file ($input) does not exit") unless (-f $input);
    $opt_in = $input;
}

sub get_common_options {
    my $args = shift;
    my (%args, %res);

    map { $args{$_} = 1 } split(//, $args);
    $res{"output|o:s"} = \$opt_out if ($args{o});
    $res{"backup|b!"} = \$opt_backup if ($args{b});
    $res{"input|i=s"} = \&verify_opt_in if ($args{i});
    $res{"package|p=s"} = \$opt_package if ($args{p});
    $res{"architecture|a=s"} = \&verify_opt_arch if ($args{a});
    $res{"version|v:s"} = \$opt_version if ($args{v});
    $res{"verbose|V!"} = \$opt_verbose if ($args{V});

    return %res;
}

sub check_mandatory_options {
    my ($args, $msg, @opts) = @_;
    my %args;

    $msg = "" if (!defined $msg);
    map { $args{$_} = 1 } split(//, $args);
    error("input file option (-i) is mandatory $msg") if (!$opt_in && $args{i});
    error("output file option (-o) is mandatory $msg") if (!$opt_out && $args{o});
    error("backup option (-b) is mandatory $msg") if (!defined $opt_backup && $args{b});
    error("package name option (-p) is mandatory $msg") if (!$opt_package && $args{p});
    error("architecture option (-a) is mandatory $msg") if (!$opt_arch && $args{a});
    error("version option (-v) is mandatory $msg") if (!$opt_version && $args{v});

    while (@opts) {
	my $val = shift @opts;
	my $msg = shift @opts;
	error($msg) if (!$val);
    }
    return 1;
}

sub sanitize_version {
    my ($ver, $default, $prompt) = @_;
    my %choices = ( v => $ver );
    my $answer;
    if ($ver =~ m/^(.+)-(.*[^~])$/) {
	# Non-native debian package
	$choices{u} = $1;
    }
    $choices{'d'} = $choices{v}.'~';

    if ($prompt && -t STDIN) {
	regular_print("Do you want to assign one version to all new symbols %s?",
	    ($default) ? "(default is '".uc($default)."')" : "(ENTER if no)");
	print STDERR sprintf("What version? [ %s / enter other ]: ", join(" / ",
	    (map { sprintf("%s = %s", ($_ eq ($default || '')) ? uc($_) : $_, $choices{$_}) }
		grep { exists $choices{$_} } qw(u d v))));
	$answer = lc(<STDIN>);
	chop $answer;
	$answer = $choices{$answer} if exists $choices{$answer};
    }
    if (! $answer) {
	$answer = (defined $default) ? $choices{$default} : $default;
    }

    return (wantarray) ? (\%choices, $answer) : $answer;
}

############### Common subroutines #################
sub regular_print {
    my $msg = shift;
    print STDERR sprintf($msg, @_), "\n";
}

sub verbose_print {
    regular_print(@_) if $opt_verbose;
}

sub find_package_symbolfile_path {
    my ($package, $arch) = @_;
    my @PATHS = (
	"debian/$package.symbols.$arch",
	"debian/symbols.$arch",
	"debian/$package.symbols",
	"debian/symbols"
    );
    for my $path (@PATHS) {
	return $path if (-f $path);
    }
    return undef;
}

sub out_symfile {
    my ($symfile, %opts) = @_;
    return 1 unless defined $symfile;

    my $out_fh;
    my $out_file = $opt_out;
    my $backup = $opt_backup;

    if (defined $out_file) {
	# If -o is specified, dump to STDOUT if it does not have an argument or
	# save to specified file otherwise.
	$out_fh = *STDOUT unless $out_file;
    } else {
	# If -o is not specified, save to the input file.
	$out_file = $opt_in;
    }

    if ($out_file) {
	File::Copy::copy($out_file, $out_file.'~') if ($backup && -r $out_file);
	$symfile->save($out_file, template_mode => 1, with_deprecated => 1, %opts);
    } elsif ($out_fh) {
	$symfile->output($out_fh, template_mode => 1, with_deprecated => 1, %opts);
    } else {
	error("output file could not be determined");
    }
    return 0;
}

sub tweak_symbol {
    my ($sym, $ver) = @_;
    $sym->handle_min_version($ver);
}

sub get_all_packages {
    open(CONTROL, "<", "debian/control") or syserr("unable to open debian/control");
    my @packages;
    while (<CONTROL>) {
	chop;
	if (/^Package:\s+(\S+)/) {
	    push @packages, $1;
	}
    }
    close(CONTROL);
    return @packages;
}

sub kill_dupes {
    my $prev;
    my @res;
    foreach my $a (sort @_) {
	if (!defined $prev || $prev ne $a) {
	    push @res, $a;
	}
	$prev = $a;
    }
    return @res;
}

sub print_changes_list {
    my ($changes, $header, $print_header_sub, $print_sub) = @_;

    if (@$changes) {
	&$print_header_sub($header);
	foreach my $info (@$changes) {
	    if ($info =~ /^\s/) {
		    # Symbol
		    &$print_sub(" %s", $info);
	    } else {
		# Soname
		&$print_sub(" SONAME: %s", $info);
	    }
	}
    }
}

# Load patches from supplied files
sub load_patches {
    my @files=@_;
    my @patches;

    sub _grep_patches {
	my @patches;
	foreach my $patch (@_) {
	    if (!$patch->has_info()) {
		verbose_print("* patch '%s' discarded due to absence of the info header",
		    $patch->get_name());
		next;
	    }
	    push @patches, $patch;
	}
	return @patches;
    };

    if (@files) {
	regular_print "Looking for patches and reading them ....";
    } else {
	return ();
    }

    for my $f (@files) {
	if (-d $f) {
	    opendir(DIR, $f) or error("unable to open directory with patches: $f");
	    while (my $filename = readdir(DIR)) {
		next if ($filename =~ /^.{1,2}$/);
		my $file = File::Spec->catfile($f, $filename);
		push @patches, _grep_patches(parse_patches_from_file($file));
	    }
	    closedir DIR;
	} elsif (-r $f) {
	    push @patches, _grep_patches(parse_patches_from_file($f));
	} elsif ($f eq "-") {
	    push @patches, _grep_patches(parse_patches_from_handle(\*STDIN));
	}
    }

    return @patches;
}

sub patch_symfile {
    my ($package, $version, $infile, $basefile, $patches, $confirmed_arches) = @_;
    my @patches = @$patches;
    my @confirmed_arches = @$confirmed_arches;
    $basefile = $infile unless $basefile;
    @patches = grep { $_->{package} eq $package } @patches;

    error("no valid patches found for the '%s' package", $package)
	unless (@patches);

    # Load input symfile
    my $symfile = Debian::PkgKde::SymbolsHelper::SymbolFile->new(
	file => $infile, arch => $opt_arch
    );
    my $curversion = $symfile->get_confirmed_version();
    unless ($curversion) {
	error("input symbol file template must have 'SymbolsHelper-Confirmed' header");
    }

    my $base_symfile = $symfile;
    if ($basefile ne $infile) {
	$base_symfile = Debian::PkgKde::SymbolsHelper::SymbolFile->new(
	    file => $basefile, arch => $opt_arch
	);
    }

    # Patch the base template with our patches and pick symbol files with
    # the highest version for each architecture.
    my (%psymfiles, %pversions);
    my $latest_ver;

    regular_print("Patching symbol file '%s' with supplied patches ...",
	$base_symfile->{file});
    my @psymfiles = $base_symfile->patch_template(@patches);
    foreach my $patch (@patches) {
	my $arch = $patch->{arch};
	my $str = sprintf("* patch '%s' for %s ... ",
	    $patch->get_name(), $arch);
	if ($patch->is_applied() && $psymfiles[0]->get_arch() eq $arch) {
	    regular_print($str . "OK.");

	    my $psymfile = shift @psymfiles;
	    if (!exists $pversions{$arch} ||
		version_compare($patch->{version}, $pversions{$arch}) > 0)
	    {
		$psymfiles{$arch} = $psymfile;
		$pversions{$arch} = $patch->{version};
		if (!defined $latest_ver ||
		    version_compare($patch->{version}, $latest_ver) > 0)
		{
		    $latest_ver = $patch->{version};
		}
	    }
	} else {
	    warning($str . "FAILED.");
	    info("the patch has been ignored. Failure output below:\n" .
		$patch->get_apply_output());
	}
    }
    unless (keys %psymfiles) {
	error("no valid symbol files could be loaded from the supplied patch files");
    }

    # Sanitize version
    unless (defined $version) {
	$version = sanitize_version($latest_ver, undef, 1);
    }
    if ($curversion && version_compare($version, $curversion) < 0) {
	error("input symbol file template version (%s) is higher than the specified one (%s)",
	    $curversion, $version);
    }

    # Reset version if requested and drop patched symbol files which have
    # lower version than original one
    foreach my $arch (keys %psymfiles) {
	my $psymfile = $psymfiles{$arch};
	if ($version) {
	    $psymfile->set_confirmed($version, $psymfile->get_confirmed_arches());
	}
	my $pver = $psymfile->get_confirmed_version();
	if (version_compare($pver, $curversion) < 0) {
	    warning("ignoring obsolete %s symbol file (its version (%s) < original (%s))",
		$arch, $pver, $curversion);
	    delete $psymfiles{$arch};
	    delete $pversions{$arch};
	}
    }
    error("no valid patched symbol files found") unless keys %psymfiles;

    # Fork $orig symbol file for the rest (unpatched) confirmed arches.
    my %confirmed_arches; $confirmed_arches{$_} = 1 foreach @confirmed_arches;
    my @carches = kill_dupes(
	grep { ! exists $psymfiles{$_} && ! exists $confirmed_arches{$_} }
	    $symfile->get_confirmed_arches()
    );
    @confirmed_arches = kill_dupes(
	grep { ! exists $psymfiles{$_} } @confirmed_arches
    );

    # Finally create a SymbolFile collection and generate template
    my $symfiles = new Debian::PkgKde::SymbolsHelper::SymbolFileCollection($symfile);
    $symfiles->add_new_symfiles(values %psymfiles);
    $symfiles->add_confirmed_arches(undef, @carches);
    # Add assume_arches at current version
    $symfiles->add_confirmed_arches($version, @confirmed_arches);

    # Detect templinst symbols before substitutions and create template
    regular_print("Confirmed arches: %s", join(", ", sort(@carches, @confirmed_arches)))
	if @carches || @confirmed_arches;
    regular_print("Generating symbol file template .... (this might take a while)");
    foreach my $arch ($symfiles->get_new_arches()) {
	my $symfile = $symfiles->get_symfile($arch);
	foreach my $sym ($symfile->get_symbols()) {
	    $sym->mark_cpp_templinst_as_optional();
	}
    }
    my $template = $symfiles->create_template()->fork();

    # Post process template and print various information about result
    my (@changes_new, @changes_lost, @changes_arch);
    foreach my $soname (sort $template->get_sonames()) {
	push @changes_new, $soname;
	push @changes_lost, $soname;
	push @changes_arch, $soname;
	foreach my $sym (sort { $a->get_symboltempl() cmp $b->get_symboltempl() }
			       $template->get_symbols($soname),
			       $template->get_patterns($soname))
	{
	    my $osym = $symfile->get_symbol_object($sym, $soname);
	    if (defined $osym) {
		if ($sym->{deprecated} && ! $osym->{deprecated}) {
		    push @changes_lost, " ".$sym->get_symbolspec(1);
		} elsif (! $sym->{deprecated} && $osym->{deprecated}) {
		    # Tweak symbol
		    tweak_symbol($sym, $version);
		    push @changes_new, " ".$sym->get_symbolspec(1);
		} else {
		    my $arches = $sym->get_tag_value("arch") || '';
		    my $oarches = $osym->get_tag_value("arch") || '';

		    if ($arches ne $oarches) {
			push @changes_arch,
			    " ".$sym->get_symbolspec(1)." (was arch=$oarches)";
		    }
		}
	    } else {
		# Tweak symbol
		tweak_symbol($sym, $version);
		push @changes_new, " ".$sym->get_symbolspec(1);
	    }
	}
	# Pop sonames if no symbols added
	pop @changes_new if $changes_new[$#changes_new] eq $soname;
	pop @changes_lost if $changes_lost[$#changes_lost] eq $soname;
	pop @changes_arch if $changes_arch[$#changes_arch] eq $soname;
    }

    print_changes_list(\@changes_new,
	"there are NEW symbols (including optional):",
	\&info, \&verbose_print) if $opt_verbose;
    print_changes_list(\@changes_lost,
	"there are LOST symbols (including optional):",
	\&warning, \&regular_print);
    print_changes_list(\@changes_arch,
	"architecture set changed for the symbols below:",
	\&info, \&regular_print);

    # Finally adjust confirmed arches list
    $template->set_confirmed($symfiles->get_latest_version(),
	$symfiles->get_latest_arches());

    # Generate diff
    if ($opt_verbose) {
	my $tmpfile = File::Temp->new(TEMPLATE => "${opt_in}.newXXXXXX");
	$template->output($tmpfile,
	    package => $opt_package,
	    template_mode => 1,
	    with_deprecated => 1,
	);
	$tmpfile->close();
	spawn(exec => ["diff", "-u", $symfile->{file}, $tmpfile->filename],
	      to_handle => \*STDERR, wait_child => 1, nocheck => 1);
    }

    return $template;
}

############### Subcommands ####################
sub _create_symfile {
    my ($file, $filename_re) = @_;
    my $filename = File::Basename::basename($file);
    my $symfile;
    if ($filename =~ $filename_re) {
	regular_print("* Loading \"%s\" symbol file '%s' ...", $1, $file);
	$symfile = Debian::PkgKde::SymbolsHelper::SymbolFile->new(
		file => $file,
		arch => "$1"
	);
    } else {
	warning("%s is not named properly. Expected *_<arch> or *.<arch>", $file);
    }
    return $symfile;
}

sub subcommand_create {
    my %opts = (
	get_common_options("oav"),
    );
    if (GetOptions(%opts)) {
	unless (defined $opt_out) {
	    error("output file option (-o) is mandatory");
	}

	# Load symbol files
	my @input_files = @ARGV;
	my %symfiles;
	my $str_arches = join("|", get_valid_arches());
	my $filename_re = qr/.*?[_.]($str_arches)$/;

	unless (@input_files) {
	    error("please pass files/directory with arch specific symbol files");
	}
	for my $f (@input_files) {
	    if (-d $f) {
		opendir(DIR, $f) or error("unable to open directory: $f");
		while (my $filename = readdir(DIR)) {
		    next if ($filename =~ /^.{1,2}$/);
		    my $file = File::Spec->catfile($f, $filename);
		    if (my $symfile = _create_symfile($file, $filename_re)) {
			if (exists $symfiles{$symfile->get_arch()}) {
			    error("duplicate symbol file (%s) for arch %s", $file,
				$symfile->get_arch());
			}
			$symfiles{$symfile->get_arch()} = $symfile;
		    }
		}
		closedir DIR;
	    } elsif (-r $f) {
		if (my $symfile = _create_symfile($f, $filename_re)) {
		    if (exists $symfiles{$symfile->get_arch()}) {
			error("duplicate symbol file (%s) for arch (%s)", $f,
			    $symfile->get_arch());
		    }
		    $symfiles{$symfile->get_arch()} = $symfile;
		}
	    } else {
		error("unreadale file/directory: %s", $f);
	    }
	}

	if (scalar(keys %symfiles) > 0) {
	    unless (exists $symfiles{$opt_arch}) {
		error("symbol file for the specified arch (%s) could not be found/loaded. ".
		      "Please specify another arch with -a option", $opt_arch);
	    }
	    # Set confirmed version
	    unless ($opt_version) {
		my $ver = $symfiles{$opt_arch}->get_highest_version();
		$opt_version = sanitize_version($ver, 'd', 1) || $ver;
	    }
	    foreach my $symfile (values %symfiles) {
		$symfile->set_confirmed($opt_version, $symfile->get_arch());
	    }

	    # Create collection and generate template
	    my $orig_symfile = $symfiles{$opt_arch}->fork();
	    delete $symfiles{$opt_arch};
	    my $symfiles = Debian::PkgKde::SymbolsHelper::SymbolFileCollection->new($orig_symfile);
	    $symfiles->add_new_symfiles(values %symfiles);
	    $symfiles->add_confirmed_arches(undef, $opt_arch);

	    # Detect templinst symbols before substitutions and create template
	    regular_print("Generating symbol file template .... (this might take a while)");
	    foreach my $symfile ($orig_symfile, $symfiles->get_symfiles()) {
		foreach my $sym ($symfile->get_symbols()) {
		    $sym->mark_cpp_templinst_as_optional();
		}
	    }
	    my $template = $symfiles->create_template();

	    # Set confirmed header
	    $template->set_confirmed($symfiles->get_latest_version(),
		$symfiles->get_latest_arches());

	    foreach my $sym ($template->get_symbols(),
	                     $template->get_patterns())
	    {
		tweak_symbol($sym, $opt_version);
	    }

	    return out_symfile($template);
	} else {
	    error("no properly named symbol files located");
	}
	return 0;
    }
    return 1;
}

sub subcommand_patch {
    my $opt_file2patch;
    my $opt_confirmed_arches = '';
    my @input_patches;
    my %opts = (
	get_common_options("obipavV"),
	"file-to-patch|f=s" => \$opt_file2patch,
	"confirmed-arches|c=s" => \$opt_confirmed_arches,
    );
    if (GetOptions(%opts)) {
	check_mandatory_options("p", "");
	@input_patches = @ARGV;
	unless ($opt_in) {
	    $opt_in = find_package_symbolfile_path($opt_package, $opt_arch);
	    error("symbol template file was not found for package '$opt_package'")
		unless (defined $opt_in && -r $opt_in);
	}
	push @input_patches, "-" unless @input_patches;

	my @patches = load_patches(@input_patches);
	my @confirmed_arches = split(/[\s,]+/, $opt_confirmed_arches);
	error("no valid patches found.") unless @patches;
	return out_symfile(
	    patch_symfile($opt_package, $opt_version, $opt_in, $opt_file2patch,
		\@patches, \@confirmed_arches)
	);
    }
    return 1;
}

sub subcommand_batchpatch {
    my @opt_packages;
    my @input_patches;
    my $opt_continue_on_err;
    my $opt_confirmed_arches = '';
    my $failed_packages = 0;

    my %opts = (
	get_common_options("bavV"),
	"package|p=s" => \@opt_packages,
	"continue-on-error!" => \$opt_continue_on_err,
	"confirmed-arches|c=s" => \$opt_confirmed_arches,
    );
    if (GetOptions(%opts)) {
	@input_patches = @ARGV;
	push @input_patches, "-" unless @input_patches;
	my @patches = load_patches(@input_patches);
	my @confirmed_arches = split(/[\s,]+/, $opt_confirmed_arches);
	my %packages = map({ $_->{package} => 1 }
	    grep { defined $_->{package} } @patches);

	my @packages;
	if (@opt_packages) {
	    foreach my $package (@opt_packages) {
		my @pkgs = split(/[\s\n]+/sm, $package);
		push @packages, @pkgs;
	    }
	} else {
	    @packages = grep { exists $packages{$_} } get_all_packages();
	}

	error("no valid patches found") unless @patches;
	error("no packages specified or none to patch for this source")
	    unless @packages;

	foreach my $package (@packages) {
	    my $msg = sprintf("| Processing %s package |", $package);
	    regular_print("-" x length($msg));
	    regular_print($msg);
	    regular_print("-" x length($msg));
	    if (my $infile = find_package_symbolfile_path($package, $opt_arch)) {
		my $template;
		eval {
		    $template = patch_symfile($package, $opt_version, $infile, undef,
			\@patches, \@confirmed_arches);
		};
		if ($@) {
		    if ($opt_continue_on_err) {
			print STDERR $@;
			info("%s patching FAILED. Continuing with subsequent package if any.", $package);
			$failed_packages++;
		    } else {
			print STDERR $@;
			error("%s patching FAILED. Will NOT continue.", $package);
			die $@;
		    }
		} else {
		    $opt_in = $infile;
		    out_symfile($template);
		}
	    } else {
		regular_print("* UNABLE to find symbol file for %s", $package);
	    }
	}
	return $failed_packages;
    }
    return 1;
}

sub subcommand_rewrite {
    my $opt_template = 1;
    my $opt_convert;
    my %opts = (
	get_common_options("boiav"),
	"template!" => \$opt_template,
	"convert" => \$opt_convert,
    );
    if (GetOptions(%opts)) {
	check_mandatory_options("i");

	if (-f $opt_in) {
	    my $symfile = Debian::PkgKde::SymbolsHelper::SymbolFile->new(file => $opt_in, arch => $opt_arch);
	    my %o = (
		template_mode => $opt_template
	    );

	    foreach my $sym ($symfile->get_symbols()) {
		$sym->upgrade_virtual_table_symbol($opt_arch) if ($opt_convert);
		tweak_symbol($sym, $opt_version);
	    }
	    foreach my $pat ($symfile->get_patterns()) {
		tweak_symbol($pat, $opt_version);
	    }

	    return out_symfile($symfile->fork(), %o);
	} else {
	    error("input symbol file ($opt_in) not found");
	    return 1;
	}
    }
    return 1;
}

# Boilerplate for the common subcommand handler
sub subcommand_boilerplate {
    my %opts = (
	get_common_options("obipav"),
    );
    if (GetOptions(%opts)) {
#	 check_mandatory_options("o");
	return 0;
    }
    return 1;
}

my %SUBCOMMANDS = (
    "create"		=> [ 1, \&subcommand_create, "create symbol file template" ],
    "patch"		=> [ 2, \&subcommand_patch, "apply dpkg-gensymbols patch(es) to the symbol file template" ],
    "batchpatch"	=> [ 3, \&subcommand_batchpatch, "apply dpkg-gensymbols patches to multiple packages at once" ],
    "rewrite"		=> [ 4, \&subcommand_rewrite, "filter/rewrite symbol file" ],
);

report_options(info_fh => \*STDERR);

my $curcmd = shift @ARGV;
if (defined $curcmd && exists $SUBCOMMANDS{$curcmd}) {
    my $ret = &{$SUBCOMMANDS{$curcmd}->[1]}();
    exit($ret);
} else {
    my $err;
    $err = ($curcmd) ? "unrecognized subcommand '$curcmd'." : "subcommand was not specified.";
    errormsg($err . " Valid subcommands are:");

    for my $cmd (sort({ $SUBCOMMANDS{$a}->[0] <=> $SUBCOMMANDS{$b}->[0] }
		 keys %SUBCOMMANDS)) {
	# Display command and its short help
	regular_print("	%s - %s", $cmd, $SUBCOMMANDS{$cmd}->[2]);
    }
    exit(2);
}

# vi: noexpandtab shiftwidth=4 tabstop=8