[SCM] Debian package checker branch, master, updated. 2.5.3-15-g34c1db5
The following commit has been merged in the master branch:
commit 34c1db562c1230df37872ceb54af51b326a7fc92
Author: Niels Thykier <niels@thykier.net>
Date: Sat Sep 17 11:44:48 2011 +0200
Rewrote the graph generator
By default it now tries to rank/group collections and checks based
on their dependencies. This tends to make the dot-generated images
easier to understand.
diff --git a/private/graph b/private/graph
index 42e94cd..71f9c67 100755
--- a/private/graph
+++ b/private/graph
@@ -3,6 +3,8 @@
use strict;
use warnings;
+use Getopt::Long;
+
BEGIN {
my $root = $ENV{'LINTIAN_ROOT'}//'.';
$ENV{'LINTIAN_ROOT'} = $root;
@@ -11,27 +13,215 @@ use lib "$ENV{'LINTIAN_ROOT'}/lib";
use Util;
+my %opt = (
+ 'checks' => 1,
+ 'dep-level' => 1,
+);
+
+# $coll -> Needs-Info
my %coll_needs;
+# Reverse %coll_needs - note values are "$type-$name"
+my %coll_rneeds;
+# $check -> Needs-Info
+my %check_needs;
+
+my %nodes = ();
+my %edges = ();
+my @ranks = ();
my $LINTIAN_ROOT = $ENV{'LINTIAN_ROOT'};
+my %opthash = (
+ 'checks!' => \$opt{'checks'},
+ 'dep-level' => \$opt{'dep-level'},
+ 'h|help' => \&usage,
+);
+
+# init commandline parser
+Getopt::Long::config('bundling', 'no_getopt_compat', 'no_auto_abbrev');
+
+# process commandline options
+GetOptions(%opthash)
+ or die("error parsing options\n");
+
+
foreach my $collf (glob ("$LINTIAN_ROOT/collection/*.desc")) {
my $coll = get_dsc_info($collf) or die "$collf: $!";
my $name = $coll->{'collector-script'} or die "$collf is missing collector-script field.\n";
my @needs = split m/\s*+,\s*+/o, $coll->{'needs-info'}//'';
$coll_needs{$name} = \@needs;
+ foreach my $n (@needs) {
+ push @{ $coll_rneeds{$n} }, "coll-$name";
+ }
+}
+
+if ($opt{'checks'}) {
+ foreach my $checkf (glob ("$LINTIAN_ROOT/checks/*.desc")) {
+ my $check = get_dsc_info($checkf) or die "$checkf: $!";
+ my $name = $check->{'check-script'} or die "$checkf is missing check-script field.\n";
+ my @needs = split m/\s*+,\s*+/o, $check->{'needs-info'}//'';
+ $check_needs{$name} = \@needs;
+ foreach my $n (@needs) {
+ push @{ $coll_rneeds{$n} }, "check-$name";
+ }
+ }
}
-print <<EOF ;
+if ($opt{'dep-level'}) {
+ gen_tree_coll();
+}
+
+gen_coll_check();
+
+make_graph();
+
+exit 0;
+
+sub gen_tree_coll {
+ my @levels;
+ my @queue;
+ my %visited = (); # key -> "level" - also counts as "marker"
+ my %re = (); # "remaining" edges
+ # Breadth first search with multiple source nodes
+ # - Note we visit a node when we reach it through its LAST egde
+ # - first find the source nodes and enqueue them
+ foreach my $node (keys %coll_needs) {
+ my $needed = $coll_needs{$node};
+ if (scalar @$needed < 1) {
+ push @queue, $node; #enqueue
+ $visited{$node} = 0;
+ } else {
+ # "remaining" edges
+ my %e = map { $_ => 1 } @$needed;
+ $re{$node} = \%e;
+ }
+ }
+ # Do the BFS
+ while (@queue) {
+ my $node = shift @queue; #dequeue
+ my $level = $visited{$node};
+ push @{ $levels[$level] }, "coll-$node";
+ foreach my $other (@{ $coll_rneeds{$node} }) {
+ next unless $other =~ s/^coll-//o;
+ next if exists $visited{$other};
+ delete $re{$other}->{$node};
+ # Is this the last edge to this node?
+ next if scalar keys %{ $re{$other} };
+ # Yes, then we visit it.
+ $visited{$other} = $level + 1;
+ push @queue, $other; #enqueue
+ }
+ }
+ # BFS done, create ranks for checks (if needed)
+ if ($opt{'checks'}) {
+ foreach my $c (sort keys %check_needs) {
+ my $needs = $check_needs{$c};
+ my $level = 0;
+ if (@$needs) {
+ foreach my $dep (@$needs) {
+ $level = $visited{$dep} if $visited{$dep} > $level;
+ }
+ $level++;
+ }
+ push @{ $levels[$level] }, "check-$c";
+ }
+ }
+ # Done - generate ranks and the graph
+
+ @ranks = map { ['same', $_] } @levels;
+}
+
+sub make_graph {
+ _header();
+ print "// Nodes\n";
+ foreach my $node (sort keys %nodes) {
+ my $attr = $nodes{$node}//'';
+ my $n = "\"$node\"";
+ $n .= " [ $attr ]" if $attr;
+ print " $n\n";
+ }
+ print "\n// Edges\n";
+ foreach my $sn (sort keys %edges) {
+ foreach my $en (sort keys %{ $edges{$sn} }) {
+ my ($et, $attr) = @{ $edges{$sn}->{$en} };
+ my $e = "\"$sn\" $et \"$en\"";
+ $e .= " [ $attr ]" if $attr;
+ print " $e\n";
+ }
+ }
+ print "\n";
+ _footer();
+}
+
+sub gen_coll_check {
+
+ foreach my $coll (sort keys %coll_needs) {
+ my %ed;
+ $nodes{"coll-$coll"} = "label=\"$coll\"";
+ foreach my $dep (@{ $coll_needs{$coll} }) {
+ $ed{"coll-$dep"} = ['->'];
+ }
+ $edges{"coll-$coll"} = \%ed;
+ }
+
+ if ($opt{'checks'}) {
+ foreach my $check (sort keys %check_needs) {
+ my %ed;
+ $nodes{"check-$check"} = "label=\"$check\" shape=box color=blue";
+ foreach my $dep (@{ $check_needs{$check} }) {
+ $ed{"coll-$dep"} = ['->'];
+ }
+ $edges{"check-$check"} = \%ed;
+ }
+ }
+
+}
+
+sub _header {
+
+ print <<EOF ;
digraph "lintian-collections" {
// This graph shows the dependency relation ships between various
-// collections.
+// collections (and possibly also checks)
+
EOF
-foreach my $coll (sort keys %coll_needs) {
- foreach my $dep (@{ $coll_needs{$coll} }) {
- print "\"$coll\" -> \"$dep\"\n";
+}
+
+sub _footer {
+ if (@ranks) {
+ print "//Ranks\n";
+ foreach my $r (@ranks) {
+ my ($rank, $nodes) = @$r;
+ print " { rank=$rank; \"" . join('" "', @$nodes) . "\" }\n";
+ }
+ print "\n";
}
+ print "}\n";
}
-print "}\n";
+sub usage {
+ my $p = $0;
+ $p=~ s,.*/,,g;
+
+ print <<EOF ;
+Usage: $p [options]
+
+ --[no-]checks - Whether to include checks in the graph
+ --[no-]dep-level - Try to prettify the graph by using "dependency levels"
+
+Generates a (Graphviz dot) graph that describes relations between
+various checks and collections.
+
+If --dep-level is used, the nodes will be grouped together by how late
+the collection (or check) can be scheduled. A collection (or check)
+is considered schedulable when all of its dependencies (if any) have
+been scheduled.
+ This option has no effect on the "semantics" of the graph. It just
+tends to make dot generate images that are easier to understand.
+
+In a dot-generated image, the boxes (with blue borders) will be the checks
+and the ellipses are collections.
+
+EOF
+}
--
Debian package checker
Reply to: