--- /dev/null
+#! /usr/bin/perl -W
+
+use strict;
+
+my $controlfile = 'Control';
+my $controlfile_local = 'Control.local';
+my %pkgs;
+my %requires;
+my %provided;
+my %maintainer;
+my %srcpkgs;
+my %aliases;
+my %disabled;
+
+my $pcfiledir_for_aliases;
+
+sub set_pcfiledir_for_aliases($)
+{
+ $pcfiledir_for_aliases = shift;
+}
+
+sub write_alias_pcfile($@)
+{
+ my $alias = shift;
+
+ die "Path for pc-file not set, use '-P dir'"
+ unless defined $pcfiledir_for_aliases;
+
+ open(U, ">$pcfiledir_for_aliases/$alias.pc")
+ || die "Cannot create '$pcfiledir_for_aliases/$alias.pc': $!";
+
+ print U "Name: $alias\n".
+ "Version: 0\n".
+ "Description: Alias Dependency Package\n".
+ "Requires: ".join(' ', @_)."\n";
+
+ close U;
+}
+
+sub add_alias($$@)
+{
+ my $alias = shift;
+ my $do_write_pc_file = shift;
+
+ $requires{$alias} = [ @_ ];
+ $provided{$alias} = $alias;
+ $aliases{$alias} = 1;
+
+ write_alias_pcfile($alias, @_)
+ if $do_write_pc_file;
+}
+
+sub is_alias($)
+{
+ my $a = shift;
+ defined $aliases{$a};
+}
+
+sub read_aliases_dir($$)
+{
+ my $dir = shift;
+ my $do_write_pc_file = shift;
+
+ opendir(A, $dir) || die "Cannot open directory '$dir': $!";
+
+ foreach my $file (sort readdir(A))
+ {
+ next if $file =~ /^\./;
+ next if -d $file;
+
+ open(F, "$dir/$file") || die "Cannot open file '$dir/$file': $!";
+ my $line = 0;
+ while (<F>)
+ {
+ $line++;
+ chomp;
+ s/\#.*//;
+ s/^\s+$//;
+ next if /^$/;
+ if (/^\s*(\S+)\s*:?=\s*(.+)/)
+ {
+ add_alias($1, $do_write_pc_file, split(/\s+/, $2));
+ }
+ else
+ {
+ die "Invalid syntax in $dir/$file:$line";
+ }
+ }
+
+ close F;
+ }
+
+ closedir A;
+}
+
+sub scan_for_provided_pkg_configs($$$)
+{
+ my $path = shift;
+ my $pkg = shift;
+ my $scan_all = shift;
+
+ $disabled{$pkg} = 1 if -e "$path/broken" or -e "$path/obsolete";
+
+ return if not $scan_all and $disabled{$pkg};
+
+ foreach my $ctfn ($controlfile, $controlfile_local)
+ {
+ if (open(A, "$path/$ctfn"))
+ {
+ my $o;
+ {
+ undef local $/;
+ $o = <A>;
+ }
+
+ $o =~ s/#.*$//gm;
+ $o =~ s/\n[ \t]+/ /smg;
+
+ while (1)
+ {
+ if ($o =~ /^requires:[ \t]*(.+)$/im)
+ {
+ push @{$requires{$pkg}}, split /\s+/, $1;
+ }
+ elsif ($o =~ /^provides:[ \t]*(.+)$/im)
+ {
+ $provided{$_} = $pkg foreach (split /\s+/, $1);
+ }
+ elsif ($o =~ /^source-pkg:[ \t]*(.+)$/im)
+ {
+ push @{$srcpkgs{$pkg}}, split /\s+/, $1;
+ }
+ elsif ($o =~ /^maintainer:[ \t]*(.+)$/im)
+ {
+ push @{$maintainer{$pkg}}, split /[,\s]+/, $1;
+ }
+ else
+ {
+ last;
+ }
+ $o = $`."\n".$';
+ }
+
+ close A;
+ }
+ }
+}
+
+sub scan_files($$)
+{
+ my $base_path = shift;
+ my $scan_all = shift;
+ my $dh;
+ opendir($dh, $base_path) || die "Cannot readdir in '$base_path': $!";
+
+ foreach (readdir($dh)) {
+ my $path = "$base_path/$_";
+ $path = readlink $path if -l $path;
+ next unless -d $path;
+ next if /^\./ or /^CVS$/;
+ $pkgs{$_} = 1;
+ scan_for_provided_pkg_configs($path, $_, $scan_all);
+ }
+ closedir $dh;
+}
+
+sub generate_dep_makefile($)
+{
+ scan_files(shift, 0);
+ my $error_count = 0;
+
+ print "# Automatically generated Makefile for dependencies\n";
+ print "#\n";
+ print "# ", `date`;
+ print "#\n";
+
+ foreach my $a (sort keys %requires)
+ {
+ print "$a:";
+ foreach (sort @{$requires{$a}})
+ {
+ if (defined $provided{$_})
+ {
+ print " $provided{$_}";
+ }
+ else
+ {
+ if ($disabled{$_})
+ {
+ print STDERR "ERROR: Package providing \"$_\" disabled and required by \"$a\".\n";
+ $error_count++;
+ }
+ elsif (!is_alias($a))
+ {
+ print STDERR "ERROR: Package providing \"$_\" not found as required by \"$a\".\n";
+ $error_count++;
+ }
+ }
+ }
+ print "\n";
+ }
+
+ print "\n.PHONY: ".join(' ', sort keys %aliases)."\n" if %aliases;
+
+ if ($error_count)
+ {
+ print STDERR "PANIC: Detected $error_count dependency error(s).\n";
+ exit(1);
+ }
+}
+
+
+
+sub figure_out_pkg_dependecies(@)
+{
+ my %newpkgs;
+ foreach (@_)
+ {
+ if (not defined $requires{$_})
+ {
+ if (not defined $provided{$_})
+ {
+ print STDERR "WARNING: '$_' does not exist.\n";
+ next;
+ }
+ $newpkgs{$provided{$_}} = 1;
+ }
+ else
+ {
+ $newpkgs{$_} = 1;
+ }
+ }
+
+ my %pkgh;
+ my $again;
+ # get requires of package(s)
+ do
+ {
+ foreach (keys %newpkgs)
+ {
+ $newpkgs{$_} = 1 foreach @{$srcpkgs{$_}};
+ }
+
+ my %rdeps;
+ $again = 0;
+ foreach my $p (keys %newpkgs)
+ {
+ if ($requires{$p})
+ {
+ $rdeps{$_} = 1 foreach @{$requires{$p}};
+ }
+ $pkgh{$p} = 1;
+ }
+ %newpkgs = ();
+ if (%rdeps)
+ {
+ # translate to packages providing those
+ foreach (keys %rdeps)
+ {
+ my $p = $_;
+ $p = $provided{$p} if defined $provided{$p};
+ $newpkgs{$p} = 1 unless defined $pkgh{$p};
+ }
+ $again = 1;
+ }
+ }
+ while ($again);
+
+ # remove aliases
+ foreach my $p (keys %pkgh)
+ {
+ delete $pkgh{$p} if is_alias($p);
+ }
+
+ keys %pkgh;
+}
+
+# this sub figures out which packages depend on the given ones
+sub figure_out_dependant_pkgs(@)
+{
+ my %h;
+ my %r;
+ $h{$_} = 1 foreach @_;
+
+ while (1)
+ {
+ my %tmp = %r;
+ foreach my $a (keys %requires)
+ {
+ foreach (sort @{$requires{$a}})
+ {
+ my $p = $_;
+ $p = $provided{$_} if defined $provided{$_};
+ $tmp{$a} = 1 if defined $h{$p} or $tmp{$p};
+ }
+ }
+
+ last if scalar keys %r == scalar keys %tmp;
+ %r = %tmp;
+ }
+
+ # remove aliases
+ foreach my $p (keys %r)
+ {
+ delete $r{$p} if is_alias($p);
+ }
+
+ %r;
+}
+
+sub generate_dot_file_all($$)
+{
+ my $base_path = shift;
+ my $output = shift;
+ scan_files($base_path, 1) if defined $base_path;
+ my $error_count = 0;
+
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
+ = localtime(time);
+ $year += 1900;
+ $mon++;
+
+ open O, $output or die "Cannot open '$output': $!";
+
+ print O "# Automatically generated\n";
+ print O "#\n";
+ print O "# ", `date`;
+ print O "#\n";
+ print O "digraph dep {\n";
+ print O " graph [ label = \"\\nSource based package dependency\\n",
+ sprintf("%02d. %02d. %04d, %02d:%02d \"];\n", $mday, $mon, $year, $hour, $min);
+
+ my %disabled_because_of_deps = figure_out_dependant_pkgs(%disabled);
+
+ foreach my $a (sort keys %requires)
+ {
+ print O " \"$a\" [shape=septagon]\n" if is_alias($a);
+ foreach (sort @{$requires{$a}})
+ {
+ if (defined $provided{$_})
+ {
+ print O " \"$a\" -> \"$provided{$_}\" [color=black];\n";
+ }
+ elsif (not defined $disabled{$a} and not is_alias($a))
+ {
+ print STDERR "ERROR: Package providing \"$_\" not found as required by \"$a\".\n";
+ $error_count++;
+ }
+ }
+ print O "\n";
+ }
+
+ foreach my $a (sort keys %requires)
+ {
+ if (defined $disabled{$a})
+ {
+ print O " \"$a\" [style=filled, fillcolor=red];\n";
+ }
+ elsif (defined $disabled_because_of_deps{$a})
+ {
+ print O " \"$a\" [style=filled, fillcolor=sandybrown];\n";
+ }
+ }
+
+ print O "}\n";
+
+ close O;
+
+ if ($error_count)
+ {
+ print STDERR "PANIC: Detected $error_count dependency error(s).\n";
+ exit(1);
+ }
+}
+
+sub generate_overview_set($$)
+{
+ my $base_path = shift;
+ my $output_dir = shift;
+
+ die "Output directory not given." unless defined $output_dir;
+
+ scan_files($base_path, 1);
+ my $error_count = 0;
+
+ my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
+ = localtime(time);
+ $year += 1900;
+ $mon++;
+ my $datestring = sprintf("%02d. %02d. %04d, %02d:%02d",
+ $mday, $mon, $year, $hour, $min);
+
+ generate_dot_file_all(undef, "| tred | dot -Tsvg -o $output_dir/all.svg");
+
+ open INDEX, ">$output_dir/index.html" or die "Cannot create $output_dir/index.html: $!";
+ print INDEX <<EOFOO;
+<html>
+ <head>
+ <title>TUD:OS package dependency overview</title>
+ </head>
+ <body>
+ <h2>TUD:OS package dependency overview</h2>
+ <p>Generated: $datestring</p>
+ <p>
+ Legend of overview graphs:
+ <ul>
+ <li>Red: Broken package</li>
+ <li>Lightred: Package broken because it depends on broken package but is itself not broken</li>
+ </ul>
+ Legend of package graphs:
+ <ul>
+ <li>Blue: The package itself</li>
+ <li>Green: Reverse dependency of package</li>
+ <li>Yellow: Dependency of package</li>
+ </ul>
+ </p>
+ <p><a href=\"all.svg\">General overview</a><br/></p>
+ <table border=\"1\"><tr><td>Package</td><td>Maintainer(s)</td><td>Deps</td><td>Reverse Deps</td></tr>
+EOFOO
+
+ foreach my $pkg (sort keys %pkgs)
+ {
+ open F, "| tred | dot -Tsvg -o $output_dir/p_$pkg.svg" || die "Cannot open $output_dir/p_$pkg.svg: $!";
+ #open F, ">$output_dir/pkg_$pkg.dot" || die "Cannot open pkg_$pkg.dot: $!";
+
+ print F "# Automatically generated\n";
+ print F "#\n";
+ print F "# ", `date`;
+ print F "#\n";
+ print F "digraph dep {\n";
+ print F " graph [ label = \"\\nSource based package dependency for package '$pkg'\\n",
+ "$datestring\"];\n";
+
+ foreach my $a (sort keys %requires)
+ {
+ print F " \"$a\" [shape=septagon]\n" if is_alias($a);
+ foreach (sort @{$requires{$a}})
+ {
+ if (defined $provided{$_})
+ {
+ print F " \"$a\" -> \"$provided{$_}\" [color=black];\n";
+ }
+ elsif (not defined $disabled{$a} and not is_alias($a))
+ {
+ print STDERR "ERROR: Package providing \"$_\" not found as required by \"$a\".\n";
+ $error_count++;
+ }
+ }
+ print F "\n";
+ }
+
+ my %rev_deps = figure_out_dependant_pkgs($pkg);
+ my @deps = figure_out_pkg_dependecies($pkg);
+
+ print F " \"$_\" [style=filled, fillcolor=seagreen1];\n"
+ foreach keys %rev_deps;
+ print F " \"$_\" [style=filled, fillcolor=yellow1];\n"
+ foreach @deps;
+
+ print F " \"$pkg\" [style=filled, fillcolor=dodgerblue];\n";
+
+ print F "}\n";
+ close F;
+
+ # Generate HTML content
+
+ print INDEX "<tr><td><a href=\"p_$pkg.svg\">$pkg</a></td><td>\n";
+ print INDEX defined $maintainer{$pkg}
+ ? (join " ", map { "<a href=\"mailto:$_\">$_</a>" } @{$maintainer{$pkg}}) : "none";
+ print INDEX "</td><td>\n";
+ foreach my $a (sort @deps)
+ {
+ print INDEX " <a href=\"p_$a.svg\">$a</a> ";
+ }
+ print INDEX "</td><td>\n";
+ foreach my $a (sort keys %rev_deps)
+ {
+ print INDEX " <a href=\"p_$a.svg\">$a</a> ";
+ }
+ print INDEX "</td></tr>\n";
+ }
+
+ print INDEX "</table>\n";
+ print INDEX "</body>\n</html>\n";
+ close INDEX;
+
+ if ($error_count)
+ {
+ print STDERR "PANIC: Detected $error_count dependency error(s).\n";
+ exit(1);
+ }
+}
+
+sub check_control($)
+{
+ my $base_path = shift;
+
+ scan_files($base_path, 0);
+
+ foreach my $p (keys %pkgs)
+ {
+ my %pc_filenames;
+ my @libs_wo_pcfile;
+ open(F, "find '$base_path/$p' -name Makefile -o -name Make.rules |")
+ || die "Cannot start find: $!";
+ while (my $file = <F>)
+ {
+ my $is_lib_build;
+ my $found_pc_filename;
+ my $not_public;
+ chomp $file;
+ open(M, $file) || die "Cannot open \"$_\": $!";
+ while (<M>)
+ {
+ chomp;
+ $found_pc_filename = $1
+ if /^\s*PC_FILENAME\s*:?=\s*(.+)\s*$/;
+ $is_lib_build = 1
+ if /^\s*include\s+.+\/mk\/lib.mk\s*$/;
+ $not_public = 1
+ if /^\s*NOTARGETSTOINSTALL\s*:?=\s/;
+ }
+ close M;
+
+ print "ERROR: $p: Not public but PC_FILENAME given\n"
+ if defined $not_public and defined $found_pc_filename;
+
+ unless (defined $not_public)
+ {
+ if (defined $found_pc_filename)
+ {
+ $found_pc_filename =~ s/\$\(PKGNAME\)/$p/;
+ $pc_filenames{$found_pc_filename} = 1;
+ }
+ elsif (defined $is_lib_build)
+ {
+ $pc_filenames{$p} = 1;
+ push @libs_wo_pcfile, $file;
+ }
+ }
+ }
+
+ foreach my $a (keys %pc_filenames)
+ {
+ print "ERROR: $p: Missing in provides '$a'\n"
+ if not defined $provided{$a} or $provided{$a} ne $p;
+ }
+
+ foreach my $a (keys %provided)
+ {
+ print "ERROR: $p: Provide not found as PC_FILENAME '$a'\n"
+ if $provided{$a} eq $p and not defined $pc_filenames{$a};
+ }
+
+ print "ERROR: $p: Contains multiple libs without PC_FILENAME:\n",
+ " ", join("\n ", @libs_wo_pcfile), "\n"
+ if scalar @libs_wo_pcfile > 1;
+
+ close F;
+ }
+
+ print "TODO: check if something is provided by multiple packages\n";
+}
+
+
+sub show_pkg_deps($$@)
+{
+ my $base_path = shift;
+ my $prefix = shift;
+ scan_files($base_path, 0);
+
+ my @p = figure_out_pkg_dependecies(@_);
+
+ print join("\n", map { "$prefix$_" } sort @p), "\n" if $prefix;
+ print join(' ', sort @p), "\n" unless $prefix;
+}
+
+sub show_pkg_deps_and_rdeps($$@)
+{
+ my $base_path = shift;
+ my $prefix = shift;
+ scan_files($base_path, 0);
+
+ my %r = figure_out_dependant_pkgs(@_);
+ my @p = figure_out_pkg_dependecies(@_, keys %r);
+
+ print join("\n", map { "$prefix$_" } sort @p), "\n" if $prefix;
+ print join(' ', sort @p), "\n" unless $prefix;
+}
+
+sub show_maintainer($@)
+{
+ scan_files(shift, 1);
+
+ if (@_)
+ {
+ my %m;
+
+ foreach (@_)
+ {
+ if ($maintainer{$_})
+ {
+ $m{$_}++ foreach @{$maintainer{$_}};
+ }
+ else
+ {
+ $m{'NO MAINTAINER'} = 1;
+ }
+ }
+
+ print join(", ", keys %m), "\n";
+ }
+ else
+ {
+ my %m;
+ foreach (keys %pkgs)
+ {
+ if ($maintainer{$_})
+ {
+ print "$_: ", join(', ', @{$maintainer{$_}}), "\n";
+ $m{$_}++ foreach @{$maintainer{$_}};
+ }
+ else
+ {
+ print "$_: NO MAINTAINER\n";
+ }
+ }
+ print "Stats:\n", join("\n", map { sprintf "%3d: %s", $m{$_}, $_ } sort { $m{$b} <=> $m{$a} } keys %m), "\n";
+ }
+}
+
+
+sub smooth_control_file($$)
+{
+ my $path = shift;
+ my $pkg = shift;
+
+ scan_for_provided_pkg_configs($path, $pkg, 1);
+
+ print "Provides: ".join(' ', keys %provided)."\n";
+ print "Requires: ".join(' ', @{$requires{$pkg}})."\n";
+}
+
+# a bit of hand-crafted option parsing, if it gets more use getopt
+my @aliases_dirs;
+while (1)
+ {
+ last unless defined $ARGV[0];
+ if ($ARGV[0] eq '-A')
+ {
+ shift;
+ push @aliases_dirs, shift;
+ }
+ elsif ($ARGV[0] eq '-P')
+ {
+ shift;
+ set_pcfiledir_for_aliases(shift),
+ }
+ else
+ {
+ last;
+ }
+ }
+
+my $cmd = $ARGV[0];
+my $base_path = $ARGV[1];
+
+die "Missing arguments"
+ if not defined $cmd or not defined $base_path;
+
+read_aliases_dir($_, $cmd eq 'generate') foreach @aliases_dirs;
+
+if ($cmd eq 'generate') {
+ generate_dep_makefile($base_path);
+} elsif ($cmd eq 'dot') {
+ generate_dot_file_all($base_path, '>-');
+} elsif ($cmd eq 'overviewset') {
+ generate_overview_set($base_path, $ARGV[2]);
+} elsif ($cmd eq 'pkgdeps') {
+ show_pkg_deps($base_path, undef, @ARGV[2 .. $#ARGV]);
+} elsif ($cmd eq 'pkgdepspath') {
+ show_pkg_deps($base_path, $ARGV[2], @ARGV[3 .. $#ARGV]);
+} elsif ($cmd eq 'pkgdepsandrdeps') {
+ show_pkg_deps_and_rdeps($base_path, undef, @ARGV[2 .. $#ARGV]);
+} elsif ($cmd eq 'collect') {
+ die "Missing argument" unless defined $ARGV[2];
+ smooth_control_file("$base_path/$ARGV[2]", $ARGV[2]);
+} elsif ($cmd eq 'maintainer') {
+ show_maintainer($base_path, @ARGV[2 .. $#ARGV]);
+} elsif ($cmd eq 'check') {
+ check_control($base_path);
+} else {
+ die "Invalid command '$cmd'";
+}
projects / l4.git / blobdiff