Peppermint
/
debian-cd-clone
mirror of https://salsa.debian.org/images-team/debian-cd.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity
debian-cd-clone/pkg-order

416 lines
12 KiB
Perl
Executable File
Raw Blame History

#!/usr/bin/perl -w
eval 'exec /usr/bin/perl -w -S $0 ${1+"$@"}'
if 0; # not running under some shell
# -*- Mode: Perl -*-
# Debian-pkg.pm ---
# Author : Manoj Srivastava ( srivasta@tiamat.datasync.com )
# Created On : Wed Jan 22 09:53:33 1997
# Created On Node : tiamat.datasync.com
# Last Modified By : Manoj Srivastava
# Last Modified On : Sat Mar 14 13:08:24 1998
# Last Machine Used: tiamat.datasync.com
# Update Count : 346
# Status : Unknown, Use with caution!
# 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-order - A Package dependency checker and install ordering tool.
=cut
=head1 SYNOPSIS
usage: pkg-order [options] <Package-file-for-new-packages>
where the options are:
=over 2
=item --nocheck-depends
=item --check-depends Do a dependency check as well as the ordering [ON]
=item --nostrict-depends
=item --strict-depends Do not carry on ordering after dependency failure [ON]
=item --nooutput-order
=item --output-order Do a package ordering [ON]
=item --nocheck-recommends
=item --check-recommends Check the Recommends field as well [OFF]
=item --nocheck-suggests
=item --check-suggests Check the Suggests field as well [OFF]
=item --nocheck-consistency
=item --check-consistency Make sure that extra warning are issued if the
new packages are not consistent [ON]
=item --noprint-failures
=item --print-failures Make a full report of dependency failures [ON]
=item --noprint-dependencies
=item --print-dependencies Print fulfilled dependencies as well [OFF]
=item --installed-packages <Package-file-for-installed-packages>
=back
=cut
=head1 DESCRIPTION
This utility does dependency checks, if you wish. It knows the
difference between installed, new (and available) packages, and the
relationship fields (pre-depends, depends, recommends, and
suggests). (For example, the current packages list need not be read
in unless you want dependency checks; you may already have done that
and now merely wish an ordering). It comes with a Test::Harness test
suite, to protect the world against my typos. Oh, it knows about
epochs as well if your dpkg does. This could be the basis of mass
compiling the packages on a new architecture, or to build a release
from scratch.
It creates associative arrays of currently installed packages
(/var/lib/dpkg/status), and new packages (given a packages file at
the command line). Then, in the checking dependency phase, for each
package in the new packages list, it looks at the dependencies, and
ensure that each dependency is satisfied in either the new list or
the installed list If the directive is satisfied from the new list,
add a line to an output file with the format required by tsort, which
is the entity that gives us the ordered list.
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 already installed.
=cut
sub main {
my $installed;
my $candidates;
my $ret;
my $do_depends = 1;
my $strict_depends = 1;
my $do_conflicts = 1;
my $do_order = 1;
my $recommends = 0;
my $suggests = 0;
my $consistent = 1;
my $print_failures = 1;
my $print_found = 0;
my $dohelp = 0;
my $filename = '';
my $usage = '';
my $installed_packages = '';
my $MYNAME = '';
($MYNAME = $0) =~ s|.*/||;
$usage= <<EOUSAGE;
usage: $MYNAME [options] <Package-file-for-new-packages>
where the options are:
--help This message.
--nocheck-depends
--check-depends Do a dependency check as well as the ordering [ON]
--nostrict-depends
--strict-depends Die on failing to satisfy dependency. [ON]
--nocheck-conflicts
--check-conflicts Do a conflicts check [ON]
--nooutput-order
--output-order Do a package ordering [ON]
--nocheck-recommends
--check-recommends Check the Recommends field as well [OFF]
--nocheck-suggests
--check-suggests Check the Suggests field as well [OFF]
--nocheck-consistency
--check-consistency Make sure that extra warning are issued if the
new packages are not consistent [ON]
--noprint-failures
--print-failures Make a full report of dependency failures [ON]
--noprint-dependencies
--print-dependencies Print fulfilled dependencies as well [OFF]
--installed-packages <Package-file-for-installed-packages>
EOUSAGE
$ret = GetOptions("check-depends!" => \$do_depends,
"strict-depends!" => \$strict_depends,
"output-order!" => \$do_order,
"check-recommends!" => \$recommends,
"check-suggests!" => \$suggests,
"check-conflicts!" => \$do_conflicts,
"check-consistency!" => \$consistent,
"print-failures!" => \$print_failures,
"print-dependencies!" => \$print_found,
"help" => \$dohelp,
"installed-packages=s" => \$installed_packages);
if ($dohelp) {
print "$usage";
exit (0);
}
die "$usage" unless $ret;
$filename = shift @ARGV;
die "Need a New packages file (Packages))"
unless $filename;
die "Could not find new Packages file $filename"
unless -f $filename;
######################################################################
# Phase One: Gather data #
######################################################################
# Installed file (default value taken from status file)
if ($do_depends) {
if (-f $installed_packages) {
$installed = Debian::Package::New->new('filename' => $installed_packages);
}
else {
$installed = Debian::Package::Installed->new();
}
}
# The new candidates (taken from the packages file)
$candidates = Debian::Package::New->new('filename' => $filename);
######################################################################
# Phase Two: Check dependencies #
######################################################################
# Omit phase Two and Three unless $do_depends is TRUE
if ($do_depends) {
# This sets Types which will show up as critical errors. Does not
# change what errors are recorded.
$candidates->set_fatal_failure_on_types('Type List' =>
"Pre-Depends Depends Conflict");
# Check Pre-Dependencies
$candidates->check_relations('Consistent' => $consistent,
'Installed' => $installed,
'Field' => 'Pre-Depends');
# Check Dependencies
$candidates->check_relations('Consistent' => $consistent,
'Installed' => $installed,
'Field' => 'Depends');
# Check Conflicts
$candidates->check_relations('Consistent' => $consistent,
'Installed' => $installed,
'Field' => 'Conflicts')
if $do_conflicts;
# Check Recommendations
$candidates->check_relations('Consistent' => $consistent,
'Installed' => $installed,
'Warn' => 'True',
'Field' => 'Recommendations')
if $recommends;
# Check Suggestions
$candidates->check_relations('Consistent' => $consistent,
'Installed' => $installed,
'Warn' => 'True',
'Field' => 'Suggestions')
if $suggests;
######################################################################
# Phase Three: Print Results #
######################################################################
if ($print_failures) {
my $result_string =
$candidates->result_as_string('Type' => 'All',
'Category' => 'Failed');
if ($result_string) {
print STDERR "=" x70, "\n";
print STDERR "Failed:\n";
print "$result_string";
print STDERR "=" x70, "\n";
}
my $unknowns =
$candidates->result_as_string('Type' => 'All',
'Category' => 'Unknown');
if ($unknowns) {
print STDERR "=" x70, "\n";
print STDERR "Unknown:\n";
print "$unknowns";
print STDERR "=" x70, "\n";
}
# Different from above to see an example of print result
my $numconflicts =
$candidates->check_result('Type' => 'All',
'Category' => 'Conflict');
if ($numconflicts > 0) {
print STDERR "=" x70, "\n";
print STDERR "Conflicted:\n";
$candidates->print_result('Type' => 'All',
'Category' => 'Conflict');;
print STDERR "=" x70, "\n";
}
}
if ($print_found) {
my $result_string =
$candidates->result_as_string('Type' => 'All',
'Category' => 'Found');
if ($result_string) {
print STDERR "=" x70, "\n";
print STDERR "Found:\n";
print "$result_string";
print STDERR "=" x70, "\n";
}
}
if ($strict_depends) {
my $critical_errors =
$candidates->check_result('Type' => "Critical",
'Category' => 'Failed')
+ $candidates->check_result('Type' => "Critical",
'Category' => 'Conflict')
+ $candidates->check_result('Type' => "Critical",
'Category' => 'Unknown');
if ($critical_errors > 0) {
print "$critical_errors Critical errors encountered. Exiting.\n";
exit ($critical_errors);
}
}
}
######################################################################
# Phase Four: Gather ordering data #
######################################################################
return 0 unless $do_order;
# Order Pre-Dependencies
$candidates->order('Field' => 'Pre-Depends');
# Order Dependencies
$candidates->order('Field' => 'Depends');
# Order Conflicts
$candidates->order('Field' => 'Conflicts', 'Installed' => $installed);
######################################################################
# Phase Five: Do ordering #
######################################################################
# Get ordering info and do topological sorting
my $order_string = $candidates->get_ordering();
# This is the raw order string
# print $order_string;
print "No packages to order. Exiting.\n" unless $order_string;
return 2 unless $order_string;
# This is the first method used to insert Breaks
my $order_one =
$candidates->insert_breaks('Ordered List' => $order_string);
print "$order_one\n";
# This is another way to insert breaks
# print "=" x 70;
# my $order_two =
# $candidates->{' _Targets'}->insert_breaks('Ordered List' => $order_string);
# print "$order_two\n";
my %force_options = $candidates->list_marks("Mark" => '\-\-');
my $forced_pkg;
foreach $forced_pkg (keys %force_options) {
my $option;
my @options = split ' ', $force_options{$forced_pkg};
for $option (@options) {
next unless $option =~ /\-\-/o;
print "Package $forced_pkg will need $option for installation)\n";
}
}
exit 0;
}
=head2 list_diff
This is an example of how to detect packages and list packages in list
A that are not in list B. Takes two Package::List objects, and returns
a list object. This is how one may take an installed list, a final
list, and figure out the packages to be removed, and the new
packages, by just taking A - B and B - A set differences.
=cut
sub list_diff {
my %params = @_;
my $ListA;
my $ListB;
my $ListC;
croak("Need argument 'List A'") unless defined $params{'List A'};
croak("Need argument 'List B'") unless defined $params{'List B'};
$ListA = $params{'List A'};
$ListB = $params{'List B'};
$ListC = Debian::Package::New->new();
my $name;
for $name (sort keys %{$ListA}) {
my $pkg;
next if $name =~ /^\s+_/o;
$pkg = $ListA->{$name};
next if $ListB->{$name}->{'Package'};
$ListC->add('Package_desc' => $pkg->print());
}
return $ListC;
}
=head1 CAVEATS
This is very inchoate, at the moment, and needs testing.
=cut
=head1 BUGS
None Known so far.
=cut
=head1 AUTHOR
Manoj Srivastava <srivasta@debian.org>
=cut
&main::main();
__END__
Reference in New Issue View Git Blame Copy Permalink