[Pkg-ocaml-maint-commits] r1037 - in tools: . build-dep-graph

[Stefano Zacchiroli]

Author: zack
Date: 2005-03-22 17:33:14 +0100 (Tue, 22 Mar 2005)
New Revision: 1037

Added:
   tools/build-dep-graph/
   tools/build-dep-graph/build-dep-graph.pl
Log:
check in


Added: tools/build-dep-graph/build-dep-graph.pl
===================================================================
--- tools/build-dep-graph/build-dep-graph.pl	2005-03-22 08:34:52 UTC (rev 1036)
+++ tools/build-dep-graph/build-dep-graph.pl	2005-03-22 16:33:14 UTC (rev 1037)
@@ -0,0 +1,123 @@
+#!/usr/bin/perl -w
+#
+# Copyright (C) 2005, Stefano Zacchiroli <zack@cs.unibo.it>
+#
+# This is free software, you can redistribute it and/or modify it under the
+# terms of the GNU General Public License version 2 as published by the Free
+# Software Foundation.
+#
+# Usage: build-dep-graph.pl pkgname ...
+#
+
+use strict;
+use AptPkg::Cache;
+use AptPkg::Source;
+
+die "No package specified\n" if ($#ARGV == -1);
+my $aptSrc = AptPkg::Source->new();
+my $aptCache = AptPkg::Cache->new();
+
+# return the first package which Provides the given package name. If no Provides
+# are found return 0
+sub provides($) {
+  my $name = shift;
+  my $info = $aptCache->{$name} || die "Can't get cache info for $name\n";
+  my @pkgs = ();
+  if (exists $info->{"ProvidesList"}) {
+    foreach my $p (@{$info->{"ProvidesList"}}) {
+      push @pkgs, $p->{"OwnerPkg"}{"Name"};
+    }
+    return (shift @pkgs);
+  } else {
+    return 0;
+  }
+}
+
+# binary (or source) package name -> source package name resolution
+sub resolve($) {
+  my $name = shift;
+  my $srcname = $aptSrc->find($name) || provides($name);
+  return $srcname;
+}
+
+# resolve all provided name to source package names
+my @srcPkgs = ();
+foreach my $p (@ARGV) {
+  my $resolved = resolve($p) || $p;
+  push @srcPkgs, $resolved;
+}
+
+# return true if a given package has to be considered in the dependency graph,
+# false otherwise (i.e. it is part of packages specified on command line)
+sub consider($) {
+  my $name = shift;
+  my @matches = grep /^\Q$name\E$/, @srcPkgs;
+  return ($#matches >= 0);
+}
+
+my $node_counter = 0;
+my %nodes;  # mapping: label -> node
+my @deps;
+
+# create a new node with a given label, avoid creating it if it has already been
+# created in the past. Return the node name of the freshly created node
+sub new_node($) {
+  my $label = shift;
+  $node_counter++;
+  my $node_name = "node$node_counter";
+  $nodes{$label} = $node_name;
+  return $node_name;
+}
+
+# add a dependency between two packages, given their name
+sub add_dep($$) {
+  my ($src_pkg, $dst_pkg) = (@_);
+  my $src_node = $nodes{$src_pkg} || new_node($src_pkg);
+  my $dst_node = $nodes{$dst_pkg} || new_node($dst_pkg);
+  push @deps, "$src_node -> $dst_node;";
+}
+
+# print all nodes that have been generated, along with their labels
+sub print_nodes() {
+  foreach my $label (keys %nodes) {
+    print "\t$nodes{$label} [label=\"$label\"];\n";
+  }
+}
+
+# print all dependencies, filtering out duplicates
+sub print_deps() {
+  my $last_dep = "";
+  foreach my $dep (sort @deps) {
+    print "\t$dep\n" unless $dep eq $last_dep;
+    $last_dep = $dep;
+  }
+}
+
+# main
+sub main() {
+  my %processed;  # remember already processed packages
+  my @pkgs = @srcPkgs;
+  while (my $pkg = shift @pkgs) { # recursively find and add build-deps
+    next if exists $processed{$pkg};
+    print STDERR "Processing $pkg ...\n";
+    $processed{$pkg} = 1;
+    my $info = $aptSrc->get($pkg);
+    my $buildDeps = $$info[0]{"BuildDepends"}{"Build-Depends"};
+    foreach my $d (@$buildDeps) {
+      my $dep = $$d[0];
+      $dep = resolve($dep);
+      next unless $dep;
+      if (consider($dep)) {
+	add_dep($pkg, $dep);
+	push @pkgs, $dep;
+      }
+    }
+  }
+  print "digraph build_graph {\n";  # dump dot graph to stdout
+  print_nodes();
+  print_deps();
+  print "}\n";
+}
+
+main();
+


Property changes on: tools/build-dep-graph/build-dep-graph.pl
___________________________________________________________________
Name: svn:executable
   + *