diff options
Diffstat (limited to '')
| -rwxr-xr-x | bin/module-deps.pl | 584 |
1 files changed, 584 insertions, 0 deletions
diff --git a/bin/module-deps.pl b/bin/module-deps.pl new file mode 100755 index 000000000..b3efc72f4 --- /dev/null +++ b/bin/module-deps.pl @@ -0,0 +1,584 @@ +#!/usr/bin/env perl + +use strict; +use warnings; +use Getopt::Long qw(GetOptions VersionMessage); +use Pod::Usage; + +my $gnumake; +my $src_root; +my $makefile_build; +my $verbose = 0; +my $no_leaf; +my $from_file; +my $to_file; +my $output_file; +my $preserve_libs = 0; +my $toposort = 0; +my %merged_libs; + +sub logit($) +{ + print STDERR shift if ($verbose); +} + +sub read_deps() +{ + my $p; + my $to; + my $invalid_tolerance = 100; + my $line_count = 0; + my %deps; + my $child_pid = 0; + if (defined $to_file) + { + open($to, ">$to_file") or die "can not open file for writing $to_file"; + } + if (defined $from_file) { + open ($p, $from_file) || die "can't read deps from cache file: $!"; + } else { + $child_pid = open ($p, "-|", "ENABLE_PRINT_DEPS=1 $gnumake -qrf $makefile_build") // die "couldn't launch make: $!"; + exit if (!$child_pid); + } + $|=1; + print STDERR "reading deps "; + while (<$p>) { + my $line = $_; + $line_count++; + print STDERR '.' if (!$verbose && $line_count % 10 == 0); + logit($line); + print $to $line if defined $to_file; + chomp ($line); + if ($line =~ m/^MergeLibContents:\s+(\S+.*)\s*$/) { + for my $dep (split / /, $1) { + $merged_libs{$dep} = 1 if $dep ne ''; + } + } elsif ($line =~ m/^LibraryDep:\s+(\S+) links against (.*)$/) { +# if ($line =~ m/^LibraryDep:\s+(\S+)\s+links against/) { + $deps{$1} = ' ' if (!defined $deps{$1}); + $deps{$1} = $deps{$1} . ' ' . $2; + } elsif ($line =~ m/^LibraryDep:\s+links against/) { +# these need fixing, we call gb_LinkTarget__use_$... +# and get less than normal data back to gb_LinkTarget_use_libraries +# print STDERR "ignoring unhelpful external dep\n"; + } elsif ($invalid_tolerance < 0) { +# print "read all dependencies to: '$line'\n"; + last; + } else { +# print "no match '$line'\n"; + $invalid_tolerance--; + } + } + close ($p); + if ($child_pid) { + my $err = $? >> 8; + # make query mode returns 0 or 1, depending on the build status + if ($err != 0 && $err != 1) { + print STDERR " error\n" if (!$verbose); + die("Errorcode $err from make - aborting!"); + } + } + print STDERR " done\n"; + + return \%deps; +} + +# graphviz etc. don't like some names +sub clean_name($) +{ + my $name = shift; + $name =~ s/[\-\/\.]/_/g; + return $name; +} + +# first create nodes for each entry +sub clean_tree($) +{ + my $deps = shift; + my %tree; + for my $name (sort keys %{$deps}) { + my $need_str = $deps->{$name}; + $need_str =~ s/^\s+//g; + $need_str =~ s/\s+$//g; + my @needs = split /\s+/, $need_str; + $name =~ m/^([^_]+)_(\S+)$/ || die "invalid target name: '$name'"; + my $type = $1; + my $target = clean_name ($2); + $type eq 'Executable' || $type eq 'Library' || + $type eq 'CppunitTest' || die "Unknown type '$type'"; + + my %result; + $result{type} = $type; + $result{target} = $target; + $result{merged} = 0; + my @clean_needs; + for my $need (@needs) { + push @clean_needs, clean_name($need); + } + $result{deps} = \@clean_needs; + if (defined $tree{$target}) { + logit("warning -duplicate target: '$target'\n"); + delete($tree{$target}); + } + $tree{$target} = \%result; + + logit("$target ($type): " . join (',', @clean_needs) . "\n"); + } + return \%tree; +} + +sub has_child_dep($$$) +{ + my ($tree,$search,$name) = @_; + my $node = $tree->{$name}; + return defined $node->{flat_deps}->{$search}; +} + +# flatten deps recursively into a single hash per module +sub build_flat_dep_hash($$); +sub build_flat_dep_hash($$) +{ + my ($tree, $name) = @_; + my %flat_deps; + + my $node = $tree->{$name}; + return if (defined $node->{flat_deps}); + + # build flat deps for children + for my $child (@{$node->{deps}}) { + build_flat_dep_hash($tree, $child) + } + + for my $child (@{$node->{deps}}) { + $flat_deps{$child} = 1; + for my $dep (@{$tree->{$child}->{deps}}) { + $flat_deps{$dep} = 1; + } + } + $node->{flat_deps} = \%flat_deps; + + # useful debugging ... + if (defined $ENV{DEP_CACHE_FILE}) { + logit("node '$name' has flat-deps: '" . join(',', keys %flat_deps) . "' " . + "vs. '" . join(',', @{$node->{deps}}) . "'\n"); + } +} + +# many modules depend on vcl + sal, but vcl depends on sal +# so we want to strip sal out - and the same for many +# similar instances +sub prune_redundant_deps($) +{ + my $tree = shift; + for my $name (sort keys %{$tree}) { + build_flat_dep_hash($tree, $name); + } +} + +# glob on libo directory +sub create_lib_module_map() +{ + my %l2m; + # hardcode the libs that don't have a directory + $l2m{'merged'} = 'merged'; + + for (glob($src_root."/*/Library_*.mk")) + { + /.*\/(.*)\/Library_(.*)\.mk/; + # add module -> module + $l2m{$1} = $1; + # add lib -> module + $l2m{$2} = $1; + } + return \%l2m; +} + +# call prune redundant_deps +# rewrite the deps array +sub optimize_tree($) +{ + my $tree = shift; + prune_redundant_deps($tree); + my @errors; + for my $name (sort keys %{$tree}) { + my $result = $tree->{$name}; + if (!defined($result->{target})) { + push @errors, "missing target for dependency '$name'!"; + next; + } + logit("minimising deps for $result->{target}\n"); + my @newdeps; + for my $dep (@{$result->{deps}}) { + # is this implied by any other child ? + logit("checking if '$dep' is redundant\n"); + my $preserve = 1; + for my $other_dep (@{$result->{deps}}) { + next if ($other_dep eq $dep); + if (has_child_dep($tree,$dep,$other_dep)) { + logit("$dep is implied by $other_dep - ignoring\n"); + $preserve = 0; + last; + } + } + push @newdeps, $dep if ($preserve); + } + # re-write the shrunk set to accelerate things + $result->{deps} = \@newdeps; + } + if (scalar @errors > 0) { + print STDERR join("\n", @errors) . "\n"; + die("Missing targets for dependencies - aborting!"); + } + return $tree; +} + +# walking through the library based graph and creating a module based graph. +sub collapse_lib_to_module($) +{ + my $tree = shift; + my %digraph; + my $l2m = create_lib_module_map(); + my %unknown_libs; + for my $lib_name (sort keys %{$tree}) { + my $result = $tree->{$lib_name}; + $unknown_libs{$lib_name} = 1 && next if (!grep {/$lib_name/} keys %$l2m); + + # new collapsed name. + my $name = $l2m->{$lib_name}; + + # sal has no dependencies, take care of it + # otherwise it doesn't have target key + if (!@{$result->{deps}}) { + if (!exists($digraph{$name})) { + my @empty; + $digraph{$name}{deps} = \@empty; + $digraph{$name}{target} = $result->{target}; + $digraph{$name}{merged} = $result->{merged}; + } + } + for my $dep (@{$result->{deps}}) { + my $newdep; + $newdep = $l2m->{$dep}; + + die "Mis-named */Library_*.mk file - should match rules: '$dep'" if (!defined $newdep); + $dep = $newdep; + + # ignore: two libraries from the same module depend on each other + next if ($name eq $dep); + if (exists($digraph{$name})) + { + my @deps = @{$digraph{$name}{deps}}; + # only add if we haven't seen already that edge? + if (!grep {/$dep/} @deps) + { + push @deps, $dep; + $digraph{$name}{deps} = \@deps; + } + } + else + { + my @deps; + push @deps, $dep; + $digraph{$name}{deps} = \@deps; + $digraph{$name}{target} = $result->{target}; + $digraph{$name}{merged} = $result->{merged}; + } + } + } + logit("warn: no module for libs were found and dropped: [" . + join(",", (sort (keys(%unknown_libs)))) . "]\n"); + return optimize_tree(\%digraph); +} + +sub prune_leaves($) +{ + my $tree = shift; + my %newtree; + my %name_has_deps; + + # we like a few leaves around: + for my $nonleaf ('desktop', 'sw', 'sc', 'sd', 'starmath') { + $name_has_deps{$nonleaf} = 1; + } + + # find which modules are depended on by others + for my $name (keys %{$tree}) { + for my $dep (@{$tree->{$name}->{deps}}) { + $name_has_deps{$dep} = 1; + } + } + + # prune modules with no deps + for my $name (keys %{$tree}) { + delete $tree->{$name} if (!defined $name_has_deps{$name}); + } + + return optimize_tree($tree); +} + +sub annotate_mergelibs($) +{ + my $tree = shift; + print STDERR "annotating mergelibs\n"; + for my $name (keys %{$tree}) { + if (defined $merged_libs{$name}) { + $tree->{$name}->{merged} = 1; +# print STDERR "mark $name as merged\n"; + } + } +} + +sub dump_graphviz($) +{ + my $tree = shift; + my $to = \*STDOUT; + open($to, ">$output_file") if defined($output_file); + print $to <<END; +digraph LibreOffice { +edge [color="#31CEF0", len=0.4] +edge [fontname=Arial, fontsize=10, fontcolor="#31CEF0"] +END +; + + my @merged_names; + my @normal_names; + for my $name (sort keys %{$tree}) { + if ($tree->{$name}->{merged}) { + push @merged_names, $name; + } else { + push @normal_names, $name; + } + } + print $to "node [fontname=Verdana, fontsize=10, height=0.02, width=0.02,". + 'shape=Mrecord,color="#BBBBBB"' . + "];" . join(';', @normal_names) . "\n"; + print $to "node [fontname=Verdana, fontsize=10, height=0.02, width=0.02,". + 'shape=box,style=filled,color="#CCCCCC"' . + "];" . join(';', @merged_names) . "\n"; + + my @errors; + for my $name (sort keys %{$tree}) { + my $result = $tree->{$name}; + if (!defined($result->{target})) { + push @errors, "Missing target for dependency '$name'!"; + next; + } + logit("minimising deps for $result->{target}\n"); + for my $dep (@{$result->{deps}}) { + print $to "$name -> $dep;\n" ; + } + } + if (scalar @errors > 0) { + print STDERR join("\n", @errors) . "\n"; + die("Missing targets for dependencies - aborting!"); + } + print $to "}\n"; +} + +sub toposort_visit($$$$); +sub toposort_visit($$$$) +{ + my $tree = shift; + my $list = shift; + my $tags = shift; + my $name = shift; + die "dependencies don't form a DAG" + if (defined($tags->{$name}) && $tags->{$name} == 1); + if (!$tags->{$name}) { + $tags->{$name} = 1; + my $result = $tree->{$name}; + for my $dep (@{$result->{deps}}) { + toposort_visit($tree, $list, $tags, $dep); + } + $tags->{$name} = 2; + push @{$list}, $name; + } +} + +sub dump_toposort($) +{ + my $tree = shift; + my @list; + my %tags; + for my $name (sort keys %{$tree}) { + toposort_visit($tree, \@list, \%tags, $name); + } + my $to = \*STDOUT; + open($to, ">$output_file") if defined($output_file); + for (my $i = 0; $i <= $#list; ++$i) { + print $to "$list[$i]\n"; + } +} + +sub filter_targets($) +{ + my $tree = shift; + for my $name (sort keys %{$tree}) + { + my $result = $tree->{$name}; + if ($result->{type} eq 'CppunitTest' || + ($result->{type} eq 'Executable' && + $result->{target} ne 'soffice_bin')) + { + delete($tree->{$name}); + } + } +} + +sub parse_options() +{ + my %h = ( + 'verbose|v' => \$verbose, + 'help|h' => \my $help, + 'man|m' => \my $man, + 'version|r' => sub { + VersionMessage(-msg => "You are using: 1.0 of "); + }, + 'preserve-libs|p' => \$preserve_libs, + 'toposort|t' => \$toposort, + 'write-dep-file|w=s' => \$to_file, + 'read-dep-file|f=s' => \$from_file, + 'no-leaf|l' => \$no_leaf, + 'output-file|o=s' => \$output_file); + GetOptions(%h) or pod2usage(2); + pod2usage(1) if $help; + pod2usage(-exitstatus => 0, -verbose => 2) if $man; + ($gnumake, $makefile_build) = @ARGV if $#ARGV == 1; + $gnumake = 'make' if (!defined $gnumake); + $makefile_build = 'Makefile.gbuild' if (!defined $makefile_build); + $src_root = defined $ENV{SRC_ROOT} ? $ENV{SRC_ROOT} : "."; +} + +sub main() +{ + parse_options(); + my $deps = read_deps(); + my $tree = clean_tree($deps); + filter_targets($tree); + optimize_tree($tree); + annotate_mergelibs($tree); + if (!$preserve_libs && !defined($ENV{PRESERVE_LIBS})) { + $tree = collapse_lib_to_module($tree); + } + if ($no_leaf) { + $tree = prune_leaves($tree); + } + if ($toposort) { + dump_toposort($tree); + } else { + dump_graphviz($tree); + } +} + +main() + + __END__ + +=head1 NAME + +module-deps - Generate module dependencies for LibreOffice build system + +=head1 SYNOPSIS + +module_deps [options] [gnumake] [makefile] + +=head1 OPTIONS + +=over 8 + +=item B<--help> + +=item B<-h> + +Print a brief help message and exits. + +=item B<--man> + +=item B<-m> + +Prints the manual page and exits. + +=item B<--version> + +=item B<-v> + +Prints the version and exits. + +=item B<--preserve-libs> + +=item B<-p> + +Don't collapse libs to modules + +=item B<--toposort> + +=item B<-t> + +Output a topological sorting instead of a graph + +=item B<--read-dep-file file> + +=item B<-f> + +Read dependency from file. + +=item B<--write-dep-file file> + +=item B<-w> + +Write dependency to file. + +=item B<--output-file file> + +=item B<-o> + +Write graph or sort output to file + +=back + +=head1 DESCRIPTION + +B<This program> parses the output of LibreOffice make process +(or cached input file) and generates the digraph build dependency, +that must be piped to B<graphviz> program (typically B<dot>). + +B<Hacking on it>: + +The typical (optimized) B<workflow> includes 3 steps: + +=over 3 + +=item 1 +Create cache dependency file: module_deps --write-dep-file lo.dep + +=item 2 +Use cache dependency file: module_deps --read-dep-file lo.dep -o lo.graphviz + +=item 3 +Pipe the output to graphviz: cat lo.graphviz | dot -Tpng -o lo.png + +=back + +=head1 TODO + +=over 2 + +=item 1 +Add soft (include only) dependency + +=item 2 +Add dependency on external modules + +=back + +=head1 AUTHOR + +=over 2 + +=item Michael Meeks + +=item David Ostrovsky + +=back + +=cut |