#!/usr/bin/perl -w

eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
    if 0; # not running under some shell
#                              -*- Mode: Perl -*- 
# pkg-unused-libs --- 
# Author           : Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>
# Created On       : Wed, 27 Oct 1999 16:11:31 +0200
# Created On Node  : faui22c.informatik.uni-erlangen.de
# Last Modified By : Roman Hodek
# Last Modified On : Wed, 27 Oct 1999 16:11:31 +0200
# Last Machine Used: faui22c.informatik.uni-erlangen.de
# Update Count     : 0
# Status           : Should work
# HISTORY          : 
# Description      : 
# 
# 

use strict;
use diagnostics;
use Carp;
require 5.001;

use Debian::Package::Dependency_List;
use Debian::Package::Package;
use Debian::Package::List;
use Getopt::Long;

package main;


#Handle The auto generated eval line.
use vars qw($running_under_some_shell);

=head1 NAME

pkg-unused-libs - List library packages that noone depends on

=cut

=head1 SYNOPSIS

 usage: pkg-unused-libs [options] 
 where the options are:

=over 2

=item --nocheck-recommends 

=item --check-recommends   Check Recommends as well [OFF]

=item --nocheck-suggests

=item --check-suggests     Check Suggests as well   [OFF]

=item --installed-packages <Package-file-for-installed-packages> 

=item -v, --verbose        Also print unsure cases

=back

=cut

=head1 DESCRIPTION

This utility prints a list of installed library packages that have no
other packages that depend on them (optionally also checks Recommends
and Suggestions).

A package is considered to be a library if it provides a I<PKG}.shlibs file in
I</var/lib/dpkg/info>. Sometimes packages with an shlibs file provide the
libraries only as a side effect and do somthing really different otherwise
(e.g., apt and e2fsprogs). Therefore, packages that contain files in
directories for executables (I</bin>, I</usr/bin>, ...) are usually not
listed. You can print those, too, with the --verbose option. But please note
that the verbose output can't be used in backticks anymore, because it
contains additional comments.

The default is to assume that the list of installed packages may be
derived from the file I</var/lib/dpkg/status>, but the user may
override this by providing a I<Packages> file listing all the
packages that are assumed to be installed.

=cut 

sub main {
  my $installed;
  my $candidates;
  my $ret;
  my $verbose = 0;
  my $recommends = 0;
  my $suggests = 0;
  my $consistent = 1;
  my $installed_packages = '';
  my $usage;
  my $MYNAME;
  my $infodir = "/var/lib/dpkg/info";
  my @bin_dirs = qw(/bin /sbin /usr/bin /usr/sbin /usr/X11R6/bin /usr/bin/X11
		    /usr/games);
  
  ($MYNAME     = $0) =~ s|.*/||;


  $usage= <<EOUSAGE;
 usage: $MYNAME [options] <Package-file-for-new-packages>
 where the options are:
 --nocheck-recommends
 --check-recommends   Check the Recommends field as well            [OFF]
 --nocheck-suggests
 --check-suggests     Check the Suggests field as well              [OFF]
 --installed-packages <Package-file-for-installed-packages> 
 -v,--verbose         Also print unsure cases
EOUSAGE
  
  $ret = GetOptions("check-recommends!"    => \$recommends,
                    "check-suggests!"      => \$suggests,
		    "installed-packages=s" => \$installed_packages,
		    "v|verbose"            => \$verbose);
  die "$usage" unless $ret;

  ######################################################################
  #                     Phase One: Gather data                         #
  ######################################################################

  # Installed file (default value taken from status file)
  if (-f $installed_packages) {
    $installed = Debian::Package::New->new('filename' => $installed_packages);
  }
  else {
    $installed = Debian::Package::Installed->new();
  }
  
  $installed->get_dependency_information();
  
  ######################################################################
  #                 Phase Two: Check dependencies                      #
  ######################################################################

  # Check Pre-Dependencies
  $installed->check_relations('Consistent' => $consistent,
			      'Installed' => $installed,
			      'Field' => 'Pre-Depends');
  # Check Dependencies
  $installed->check_relations('Consistent' => $consistent,
			      'Installed' => $installed,
			      'Field' => 'Depends');
  # Check Recommendations
  $installed->check_relations('Consistent' => $consistent,
			      'Installed' => $installed,
			      'Warn'       => 'True',
			      'Field' => 'Recommendations')
    if $recommends;
  # Check Suggestions
  $installed->check_relations('Consistent' => $consistent,
			      'Installed'  => $installed,
			      'Warn'       => 'True',
			      'Field'      => 'Suggestions')
    if $suggests;
    
  
  ######################################################################
  #                Phase Three: Make Perl list of non-target pkgs      #
  ######################################################################
  
  my @non_targets = map { /^\s*(.*)\s*$/; }
    split("\n", $installed->non_target_as_string('Type' => "All"));

  ######################################################################
  #                Phase Four: Filter out pkgs that have no shlibs     #
  ######################################################################

  my ($pkg, @unused_libs, @unused_unsure);
  foreach $pkg (@non_targets) {
      local (*F);
      next if ! -f "$infodir/$pkg.shlibs";
      if (!open( F, "<$infodir/$pkg.list" )) {
	  warn "Cannot open $infodir/$pkg.list: $!\n";
	  warn "$pkg has no files installed?? Skipping.\n";
	  next;
      }
      my $bin_found = 0;
    FILE: while( <F> ) {
	  chomp;
	  foreach my $dir (@bin_dirs) {
	      $bin_found = 1, last FILE if m@^\Q$dir\E/.{2,}@;
	  }
      }
      close( F );
      if ($bin_found) {
	  push( @unused_unsure, $pkg );
      }
      else {
	  push( @unused_libs, $pkg );
      }
  }

  ######################################################################
  #                Print results                                       #
  ######################################################################

  if ($verbose) {
      print "Unused libraries:\n  ", join( "\n  ", @unused_libs ), "\n";
      print "Unsure cases (packages also provide binaries):\n  ",
	    join( "\n  ", @unused_unsure ), "\n"
	if @unused_unsure;
  }
  else {
      print join( "\n", @unused_libs ), "\n";
  }
  
  exit 0;
}

=head1 CAVEATS

This is very inchoate, at the moment, and needs testing.

=cut

=head1 BUGS

None Known so far.

=cut

=head1 AUTHOR

Roman Hodek <Roman.Hodek@informatik.uni-erlangen.de>

=cut

&main::main();
