#!/usr/bin/perl -w
# debsuggests.pl
# Spit out which Debian packages are suggested or recommended, but
# not installed.  Heavy users of `apt-get install ...' miss these fields.
# Copyright (C) 2000 Damian Gryski <dgryski@uwaterloo.ca>
# Released under the GPL, version 2 or later.

use strict;

my $file = '/var/lib/dpkg/status';

# typedef pkgs_elem = { $Version, \@Suggests, \@Recommends }
my %pkgs = ();
my $pkg = '';

my @lines = '' ;
my $what = '';
my $list = '';

my %opts = (verbose => 0);
$ARGV[0] && ($ARGV[0] eq "-v") && $opts{verbose}++;

open (FILE, $file) || die "Error: can't open $file: $!\n";

# snarf in paragraphs
$/ = "";

while(<FILE>) {
   @lines = split(/\n/);
   # for each entry in the status file...
   foreach (@lines) {
      # extract the package name into `$pkg'
      (/^Package:/) && ((undef, $pkg) = split);

      # Note that only installed packages have these fields in .../status
      # Thus, only installed packages have defined($pkgs{$pkg})

      # stick $pkg's version number in $pkgs{$pkg}->{Version}
      (/^Version:/) && ((undef, $pkgs{$pkg}->{Version}) = split);

       # add the suggested/recommended packages to an array in
       # $pkgs{$pkg}->{Suggests} or ->{Recommends}
      if (/^Suggests:/ || /^Recommends:/) {
	 ($what,$list) = split(/:/,$_,2);
	 $list =~ s/ //g;
	 foreach (split(/,/,$list)) {
	    push @{$pkgs{$pkg}->{$what}}, $_;
	 }
      }
      # does the package Provide anything?  Then they are installed too.
      if (/^Provides:/) {
	  (undef,$list) = split(/:/);
	  $list =~ s/ //g;
	  foreach (split(/,/,$list)) {
	     $pkgs{$_}->{Version} = "0";  # provides aren't versioned
          }
      }
   }
}

foreach $pkg (sort keys %pkgs) {
   $opts{verbose} && print "Checking $pkg\n";
   $list = join(', ', @{&missing(\@{$pkgs{$pkg}->{Suggests}})});
   $list && print "$pkg: Suggests: $list\n";
   $list = join(', ', @{&missing(\@{$pkgs{$pkg}->{Recommends}})});
   $list && print "$pkg: Recommends: $list\n";
}

# determines (and returns) a list of ``missing'' packages from the
# array ref containing a parsed Suggests or Recommends line.
sub missing ($) {
   my @what = @{(shift)};

   my @return = ();
   my $need = '';

WHAT:
   foreach (@what) {
      $opts{verbose} && print "\tLooking for $_ ...\n\t\t";
      foreach $need (split(/\|/)) {
	 if (&haspkg($need)) {
	    $opts{verbose} && print "has $need\n";
	    # if pkgA|pkgB|pkgC, and we found pkgB, then exit loop
	    next WHAT;
	 }
      }
      $opts{verbose} && print "not found\n";
      # add pkg (or pkgA|pkgB|pkgC line) to the list of missing packages
      push @return, $_;
   }
   return \@return ;
}

# determines if $pkg is installed 
sub haspkg ($) {
   $pkg = shift;

   $opts{verbose} && print "$pkg?.. ";

   # do we need a particular version?
   if ($pkg =~ /\(/) {
      my ($needpkg, $needver);
      ($pkg =~ /(.*)\((.*)\)/) && ($needpkg = $1, $needver = $2);
      # if the package isn't installed, we don't need to compare versions
      defined($pkgs{$needpkg}) || return 0;
      $needver =~ s/([<=>]+)(.*)/$2/;
      # we have /a/ version installed, so check if it's good enough
      return &vercmp($pkgs{$needpkg}->{Version}, $1, $needver);
   }
   # any version will do -- existence in the hash means installed.
   return $pkgs{$pkg} ;
}

# compare two versions -- I tried to do this in perl, but decided that
# calling dpkg was /way/ easier.
sub vercmp ($$) {
   my ($has, $op, $need) = @_;
   return system("dpkg --compare-versions $has \'$op\' $need") == 0;
}
