#!/usr/bin/perl

use strict;
use warnings;

use File::Basename;

my $program = basename($0);

my %packages = ();

my $myarch = qx(dpkg --print-architecture);
chomp $myarch;

# pre-declare subroutines (see below for implementation)
use subs qw(parse_pkg);

# get details for all packages known by dpkg
open my $dpkg_fh, '-|', 'dpkg -l "*"';
while (<$dpkg_fh>) {
    next unless (m/^[uihrp][ncHUFWti]/);
    chomp;

    my ($status, $pkg, $version, $arch, $desc) = split /\s+/, $_, 5;
    $pkg =~ s/:.*//;

    $packages{$pkg}->{$arch}->{status} = sprintf('%-3s', $status);
    $packages{$pkg}->{$arch}->{version} = $version;
    $packages{$pkg}->{$arch}->{desc} = $desc;
}
close $dpkg_fh;

# now get missing details for uninstalled packages
$/ = '';
open my $dctrl_fh, '-|',
    "dpkg --print-avail";
while (<$dctrl_fh>) {
    parse_pkg('DCTRL', $_);
}
close $dctrl_fh;


my $dlist = '/var/lib/dlocate/dpkg-list';

open my $dpkglist_fh, '>', "$dlist.new"
    or die "$program: couldn't open $dlist.new for write: $!\n";
foreach (sort keys %packages) {
    foreach my $arch (sort keys %{$packages{$_}}) {
        next if ($arch eq '<none>');
        my $pkg = ($arch =~ m/^($myarch|all)$/io) ? $_ : "$_:$arch";

        printf { $dpkglist_fh } "%s\t%s\t%s:%s\t%s\n",
        #printf DPKGLIST "%s\t%s\t%s\t%s\t%s\n",
            $packages{$_}->{$arch}->{status},
            $pkg,
            $packages{$_}->{$arch}->{version}, $arch,
            $packages{$_}->{$arch}->{desc};
    }
}
close $dpkglist_fh;
rename("$dlist.new", $dlist);


###
### subroutines
###

sub parse_pkg {
    my $calltype = shift;
    my ($pkg, $desc, $status, $version, $arch) = (
        '',
        '(no description available)',
        'un ',
        '',
        '',
    );

    # split package details by newline
    foreach (split /\n/, $_) {
        next unless (m/^(Package|Description(?:-..)?|Architecture|Version):/o);

        my ($field, $val) = split /: /, $_, 2;
        if ($field eq 'Package') {
            $pkg = $val ;
        } elsif ($field =~ m/Description(?:-..)?/io) {
            $desc = $val;
        } elsif ($field eq 'Version') {
            $version = $val;
        } elsif ($field eq 'Architecture') {
            $arch = $val;
        }
    }

    #$desc = "$calltype $desc";

    return unless ($pkg && $arch);
    return if ($arch ne $myarch && !defined($packages{$pkg}->{$arch}));

    $packages{$pkg}->{$arch}->{desc} = $desc;

    if (! defined($packages{$pkg}->{$arch}->{status})) {
        $packages{$pkg}->{$arch}->{status} = 'un ';
    }

    if (! defined($packages{$pkg}->{$arch}->{version}) ||
        $packages{$pkg}->{$arch}->{version} eq '<none>') {
        $packages{$pkg}->{$arch}->{version} = $version;
    }

    if (! defined($packages{$pkg}->{$arch})) {
        $packages{$pkg}->{$arch}->{arch} = $arch;
    }

    return;
}
