#! /usr/bin/perl
#
# dpkg-prof2purp.pl - Convert profile syntax to purpose override syntax.
#
# Copyright © 2012 Patrick "P. J." McDermott <pjm@nac.net>
#
# This program is free software; you may 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 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 Getopt::Std;
use Dpkg::Deps;
use Dpkg::Control::Info;

sub print_usage
{
	my ($fh) = @_;

	$fh = *STDOUT if not defined($fh);

	printf($fh "Usage: %s [<option>...] [<control-file>]\n", $0);
}

sub HELP_MESSAGE
{
	my ($fh) = @_;

	$fh = *STDOUT if not defined($fh);

	print_usage($fh);
	print $fh <<EOF
Convert profile syntax to purpose override syntax.

<control-file> is the control file to process (default: debian/control).

Options:
  -d <build-deps>   use the given string as build dependencies instead
                    of retrieving them from a control file
  -c <build-conf>   use the given string as build conflicts instead of
                    retrieving them from a control file
  -C                print all control fields
  -v                print verbose informational messages
  -h, --help        display this help and exit
  -V, --version     display version information and exit
EOF
}

sub VERSION_MESSAGE
{
	my ($fh) = @_;

	$fh = *STDOUT if not defined($fh);

	print $fh <<EOF
dpkg-prof2purp.pl 1.0.0

This is free software; see the GNU General Public License version 2 or
later for copying conditions. There is NO warranty.
EOF
}

my %opts;
my $control_file;
my $control;
my $fields;
my @profiles;
my %deps_full;

$Getopt::Std::STANDARD_HELP_VERSION = 1;
getopts('d:c:CvhV', \%opts);

if (defined($opts{'h'})) {
	HELP_MESSAGE();
	exit(0);
}
if (defined($opts{'V'})) {
	VERSION_MESSAGE();
	exit(0);
}
if (defined($opts{'C'}) and defined($opts{'v'})) {
	print(STDERR "Error: Cannot combine -C and -v.\n");
	exit(1);
}

$control_file = shift || 'debian/control';
$control = Dpkg::Control::Info->new($control_file);
$fields = $control->get_source();

if (defined($opts{'d'}) or defined($opts{'c'})) {
	foreach my $field_name (keys(%{$fields})) {
		if ($field_name eq 'Build-Depends' and defined($opts{'d'})) {
			$fields->{$field_name} = $opts{'d'};
		} elsif ($field_name eq 'Build-Conflicts' and defined($opts{'c'})) {
			$fields->{$field_name} = $opts{'c'};
		} elsif ($field_name =~ /^Build-(Depends|Conflicts)/) {
			delete $fields->{$field_name};
		}
	}
	# FIXME: The output order is a bit messed up...
	$fields->{'Build-Depends'} = $opts{'d'} if defined($opts{'d'});
	$fields->{'Build-Conflicts'} = $opts{'c'} if defined($opts{'c'});
}

print("Control with profiles:\n") if defined($opts{'v'});
while (my ($field_name, $field_value) = each(%{$fields})) {
	next if not $field_name =~ /^Build-(Depends|Conflicts)/;
	$deps_full{$field_name} = deps_parse($field_value);
	# Collect profiles.
	foreach my $dep_and ($deps_full{$field_name}->get_deps()) {
		foreach my $dep_or ($dep_and->get_deps()) {
			next if not defined($dep_or->{'profiles'});
			foreach my $prof (@{$dep_or->{'profiles'}}) {
				next if not $prof;
				# Normalize if negative.
				my $normal_prof = $prof;
				$normal_prof =~ s/^!//;
				push(@profiles, $normal_prof)
					if not grep(lc($_) eq lc($normal_prof), @profiles);
			}
		}
	}
	# Print original field.
	if (defined($opts{'v'})) {
		printf("  %s: %s\n", $field_name, $deps_full{$field_name});
	}
}

# Print supported profiles.
if (defined($opts{'v'})) {
	printf("Supported profiles: %s\n", join(', ', @profiles));
}

# Add default empty profile.
@profiles = ('', @profiles);

# Print fields with purpose overrides.
print("Control with purpose overrides:\n") if defined($opts{'v'});
while (my ($field_name, $field_value) = each(%{$fields})) {
	if (not $field_name =~ /^Build-(Depends|Conflicts)/) {
		printf("%s: %s\n", $field_name, $field_value) if defined $opts{'C'};
		next;
	}
	my $deps_reduced_def = deps_parse($field_value, reduce_profile => 1);
	foreach my $prof (@profiles) {
		my $deps_reduced_prof = deps_parse($field_value,
			reduce_profile => 1, build_profile => $prof);
		# Skip if there are no dependencies for this profile.
		next if not $deps_reduced_prof;
		# Skip if this profile is equivalent to the default.
		next if $prof and $deps_reduced_def eq $deps_reduced_prof;
		printf("%s%s%s: %s\n",
			(defined($opts{'v'}) ? '  ' : ''),
			$field_name,
			($prof ? '[' . $prof . ']' : ''),
			$deps_reduced_prof);
	}
}

# Print binary package paragraphs.
if (defined($opts{'C'})) {
	foreach my $pkg ($control->get_packages()) {
		print("\n" . $pkg);
	}
}
