#!/usr/bin/perl -w
use strict;

# Copyright (C) 2009-2015 Aaron M. Ucko <ucko@debian.org>
#
# Permission is hereby granted, free of charge, to any person
# obtaining a copy of this software and associated documentation files
# (the "Software"), to deal in the Software without restriction,
# including without limitation the rights to use, copy, modify, merge,
# publish, distribute, sublicense, and/or sell copies of the Software,
# and to permit persons to whom the Software is furnished to do so,
# subject to the following conditions:
#
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Software.
#
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
# MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
# BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN
# ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN
# CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
# SOFTWARE.

# See POD-format synopsis at end.

# Adjust as appropriate for your system.
my $chroot = '/chroot/ia32-sid';

use Getopt::Long 2.32;
use IO::File;
use IO::Pipe;
use Pod::Usage;
use Set::Scalar;
use URI::Escape;

my $all;
my $help;
my $quiet;
my $want_url;

if ( !GetOptions('all|a'   => \$all,
		 'quiet|q' => \$quiet,
		 'url|u'   => \$want_url) ) {
    pod2usage(2);
} elsif (defined($help)) {
    pod2usage(1);
}

my $old = '/var/lib/aptitude/pkgstates';
my $new = $chroot . $old;

if (@ARGV == 2) {
    ($old, $new) = @ARGV;
} elsif (@ARGV) {
    pod2usage(2);
}

my $ost = ParseState($old);
my $nst = ParseState($new);

my $all_new_names = new Set::Scalar;
foreach my $pkg (keys %$ost) {
    $all_new_names->insert($pkg) if $ost->{$pkg};
}
foreach my $pkg (keys %$nst) {
    if ($nst->{$pkg}) {
	if (defined $all) {
	    $all_new_names->insert($pkg);
	} else {
	    $all_new_names->invert($pkg);
	}
    }
}

if ($want_url) {
    my @cmd = qw(dd-list --no-uploaders);
    foreach my $pkg ($all_new_names->members) {
	if (!$quiet  ||  !exists $ost->{$pkg}  ||  !exists $nst->{$pkg}) {
	    push @cmd, $pkg;
	}
    }
    my $pipe = new IO::Pipe;
    $pipe->reader(@cmd);
    my $sources = new Set::Scalar; # --no-uploaders isn't always sufficient.
    while (<$pipe>) {
	chomp;
	$sources->insert($1) if /^\s+(\S+)$/;
    }
    my @sources = sort $sources->elements;
    my $base='https://buildd.debian.org/status/package.php?';
    $base .= 'compact=compact&' if @sources > 1;
    print $base, 'p=', join(',', map { uri_escape $_ } @sources), "\n";
    exit;
}

foreach my $pkg (sort $all_new_names->members) {
    next if ($quiet  &&  exists $ost->{$pkg}  &&  exists $nst->{$pkg});
    if (exists $ost->{$pkg}) {
	if ($ost->{$pkg}) {
	    print((exists $nst->{$pkg} && $nst->{$pkg}) ? "\t" : $pkg);
	} else {
	    print '=';
	}
    }
    if (exists $nst->{$pkg}) {
	print "\t", $nst->{$pkg} ? $pkg : '=';
    }
    print "\n";
}

sub GetArch
{
    my $path = $_[0];
    $path =~ s,(?:/media/[^/]+/[^/]+)?/var/lib/aptitude/[^/]*$,/usr/bin/dpkg,;
    my $arch = `$path --print-architecture`;
    chomp $arch;
    return $arch;
}

sub ParseState
{
    my $arch   = GetArch($_[0]);
    my $result = ParseAptitudeState($arch, @_);
    if ($_[0] =~ m,^(.*)/var/(?:lib/aptitude/|backups/aptitude\.)pkgstates,) {
	# incorporate package names not yet recorded there
	foreach my $list (<$1/var/lib/apt/lists/*_binary-${arch}_Packages>) {
	    my $fh = new IO::File($list, 'r');
	    while (<$fh>) {
		chomp;
		if (/^Package:\s*(\S+)$/) {
		    $result->{$1} = 1 unless exists $result->{$1};
		}
	    }
	}
    }
    return $result;
}

sub ParseAptitudeState
{
    my ($arch, $path) = @_;
    local $/ = '';
    my $fh = new IO::File($path, 'r');
    my $result = {};
    while (<$fh>) {
	next unless /^Architecture:\s*$arch/m;
	if (/^Package:\s*(\S+)$/m) {
	    my $pkg = $1;
	    $result->{$pkg} = /^Unseen:\s*yes$/m;
	} else {
	    warn "Package name missing";
	}
    }
    return $result;
}

__END__

=head1 NAME

compare-new-names - Compare aptitude's lists of new package names

=head1 SYNOPSIS

compare-new-names [-a|--all] [-q|--quiet] [-u|--url] [OLD NEW]

=cut