File: pkg-order

package info (click to toggle)
pkg-order 1.02
  • links: PTS
  • area: main
  • in suites: hamm, slink
  • size: 484 kB
  • ctags: 172
  • sloc: perl: 4,094; makefile: 81
file content (407 lines) | stat: -rwxr-xr-x 12,345 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
#! /usr/bin/perl -w
#                              -*- 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_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]
 --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-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');
    # 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__