bin/module-deps.pl

   1 #!/usr/bin/env perl
   2
   3 use strict;
   4 use warnings;
   5 use Getopt::Long qw(GetOptions VersionMessage);
   6 use Pod::Usage;
   7
   8 my $gnumake;
   9 my $src_root;
  10 my $makefile_build;
  11 my $verbose = 0;
  12 my $no_leaf;
  13 my $from_file;
  14 my $to_file;
  15 my $output_file;
  16 my $preserve_libs = 0;
  17 my $toposort = 0;
  18 my %merged_libs;
  19
  20 sub logit($)
  21 {
  22     print STDERR shift if ($verbose);
  23 }
  24
  25 sub read_deps()
  26 {
  27     my $p;
  28     my $to;
  29     my $invalid_tolerance = 100;
  30     my $line_count = 0;
  31     my %deps;
  32     if (defined $to_file)
  33     {
  34         open($to, ">$to_file") or die "can not open file for writing $to_file";
  35     }
  36     if (defined $from_file) {
  37         open ($p, $from_file) || die "can't read deps from cache file: $!";
  38     } else {
  39         open ($p, "ENABLE_PRINT_DEPS=1 $gnumake -qrf $makefile_build|") || die "can't launch make: $!";
  40     }
  41     $|=1;
  42     print STDERR "reading deps ";
  43     while (<$p>) {
  44         my $line = $_;
  45         $line_count++;
  46         print STDERR '.' if ($line_count % 10 == 0);
  47         logit($line);
  48         print $to $line if defined $to_file;
  49         chomp ($line);
  50         if ($line =~ m/^MergeLibContents:\s+(\S+.*)\s*$/) {
  51         for my $dep (split / /, $1) {
  52         $merged_libs{$dep} = 1 if $dep ne '';
  53         }
  54         } elsif ($line =~ m/^LibraryDep:\s+(\S+) links against (.*)$/) {
  55 #        if ($line =~ m/^LibraryDep:\s+(\S+)\s+links against/) {
  56             $deps{$1} = ' ' if (!defined $deps{$1});
  57             $deps{$1} = $deps{$1} . ' ' . $2;
  58         } elsif ($line =~ m/^LibraryDep:\s+links against/) {
  59 #           these need fixing, we call gb_LinkTarget__use_$...
  60 #           and get less than normal data back to gb_LinkTarget_use_libraries
  61 #           print STDERR "ignoring unhelpful external dep\n";
  62         } elsif ($invalid_tolerance < 0) {
  63 #           print "read all dependencies to: '$line'\n";
  64             last;
  65         } else {
  66 #           print "no match '$line'\n";
  67             $invalid_tolerance--;
  68         }
  69     }
  70     close ($p);
  71     print STDERR " done\n";
  72
  73     return \%deps;
  74 }
  75
  76 # graphviz etc. don't like some names
  77 sub clean_name($)
  78 {
  79     my $name = shift;
  80     $name =~ s/[\-\/\.]/_/g;
  81     return $name;
  82 }
  83
  84 # first create nodes for each entry
  85 sub clean_tree($)
  86 {
  87     my $deps = shift;
  88     my %tree;
  89     for my $name (sort keys %{$deps}) {
  90         my $need_str = $deps->{$name};
  91         $need_str =~ s/^\s+//g;
  92         $need_str =~ s/\s+$//g;
  93         my @needs = split /\s+/, $need_str;
  94         $name =~ m/^([^_]+)_(\S+)$/ || die "invalid target name: '$name'";
  95         my $type = $1;
  96         my $target = clean_name ($2);
  97         $type eq 'Executable' || $type eq 'Library' ||
  98             $type eq 'CppunitTest' || die "Unknown type '$type'";
  99
 100         my %result;
 101         $result{type} = $type;
 102         $result{target} = $target;
 103         $result{merged} = 0;
 104         my @clean_needs;
 105         for my $need (@needs) {
 106             push @clean_needs, clean_name($need);
 107         }
 108         $result{deps} = \@clean_needs;
 109         if (defined $tree{$target}) {
 110             logit("warning -duplicate target: '$target'\n");
 111             delete($tree{$target});
 112         }
 113         $tree{$target} = \%result;
 114
 115         logit("$target ($type): " . join (',', @clean_needs) . "\n");
 116     }
 117     return \%tree;
 118 }
 119
 120 sub has_child_dep($$$)
 121 {
 122     my ($tree,$search,$name) = @_;
 123     my $node = $tree->{$name};
 124     return defined $node->{flat_deps}->{$search};
 125 }
 126
 127 # flatten deps recursively into a single hash per module
 128 sub build_flat_dep_hash($$);
 129 sub build_flat_dep_hash($$)
 130 {
 131     my ($tree, $name) = @_;
 132     my %flat_deps;
 133
 134     my $node = $tree->{$name};
 135     return if (defined $node->{flat_deps});
 136
 137     # build flat deps for children
 138     for my $child (@{$node->{deps}}) {
 139         build_flat_dep_hash($tree, $child)
 140     }
 141
 142     for my $child (@{$node->{deps}}) {
 143         $flat_deps{$child} = 1;
 144         for my $dep (@{$tree->{$child}->{deps}}) {
 145             $flat_deps{$dep} = 1;
 146         }
 147     }
 148     $node->{flat_deps} = \%flat_deps;
 149
 150     # useful debugging ...
 151     if (defined $ENV{DEP_CACHE_FILE}) {
 152         logit("node '$name' has flat-deps: '" . join(',', keys %flat_deps) . "' " .
 153             "vs. '" . join(',', @{$node->{deps}}) . "'\n");
 154     }
 155 }
 156
 157 # many modules depend on vcl + sal, but vcl depends on sal
 158 # so we want to strip sal out - and the same for many
 159 # similar instances
 160 sub prune_redundant_deps($)
 161 {
 162     my $tree = shift;
 163     for my $name (sort keys %{$tree}) {
 164         build_flat_dep_hash($tree, $name);
 165     }
 166 }
 167
 168 # glob on libo directory
 169 sub create_lib_module_map()
 170 {
 171     my %l2m;
 172     # hardcode the libs that don't have a directory
 173     $l2m{'merged'} = 'merged';
 174
 175     for (glob($src_root."/*/Library_*.mk"))
 176     {
 177         /.*\/(.*)\/Library_(.*)\.mk/;
 178         # add module -> module
 179         $l2m{$1} = $1;
 180         # add lib -> module
 181         $l2m{$2} = $1;
 182     }
 183     return \%l2m;
 184 }
 185
 186 # call prune redundant_deps
 187 # rewrite the deps array
 188 sub optimize_tree($)
 189 {
 190     my $tree = shift;
 191     prune_redundant_deps($tree);
 192     for my $name (sort keys %{$tree}) {
 193         my $result = $tree->{$name};
 194         logit("minimising deps for $result->{target}\n");
 195         my @newdeps;
 196         for my $dep (@{$result->{deps}}) {
 197             # is this implied by any other child ?
 198             logit("checking if '$dep' is redundant\n");
 199             my $preserve = 1;
 200             for my $other_dep (@{$result->{deps}}) {
 201                 next if ($other_dep eq $dep);
 202                 if (has_child_dep($tree,$dep,$other_dep)) {
 203                     logit("$dep is implied by $other_dep - ignoring\n");
 204                     $preserve = 0;
 205                     last;
 206                 }
 207             }
 208             push @newdeps, $dep if ($preserve);
 209         }
 210         # re-write the shrunk set to accelerate things
 211         $result->{deps} = \@newdeps;
 212     }
 213     return $tree;
 214 }
 215
 216 # walking through the library based graph and creating a module based graph.
 217 sub collapse_lib_to_module($)
 218 {
 219     my $tree = shift;
 220     my %digraph;
 221     my $l2m = create_lib_module_map();
 222     my %unknown_libs;
 223     for my $lib_name (sort keys %{$tree}) {
 224         my $result = $tree->{$lib_name};
 225         $unknown_libs{$lib_name} = 1 && next if (!grep {/$lib_name/} keys %$l2m);
 226
 227     # new collapsed name.
 228         my $name = $l2m->{$lib_name};
 229
 230         # sal has no dependencies, take care of it
 231         # otherwise it doesn't have target key
 232         if (!@{$result->{deps}}) {
 233             if (!exists($digraph{$name})) {
 234                 my @empty;
 235                 $digraph{$name}{deps} = \@empty;
 236                 $digraph{$name}{target} = $result->{target};
 237                 $digraph{$name}{merged} = $result->{merged};
 238             }
 239         }
 240         for my $dep (@{$result->{deps}}) {
 241             my $newdep;
 242             $newdep = $l2m->{$dep};
 243
 244             die "Mis-named */Library_*.mk file - should match rules: '$dep'" if (!defined $newdep);
 245             $dep = $newdep;
 246
 247             # ignore: two libraries from the same module depend on each other
 248             next if ($name eq $dep);
 249             if (exists($digraph{$name}))
 250             {
 251                 my @deps = @{$digraph{$name}{deps}};
 252                 # only add if we haven't seen already that edge?
 253                 if (!grep {/$dep/} @deps)
 254                 {
 255                     push @deps, $dep;
 256                     $digraph{$name}{deps} = \@deps;
 257                 }
 258             }
 259             else
 260             {
 261                 my @deps;
 262                 push @deps, $dep;
 263                 $digraph{$name}{deps} = \@deps;
 264                 $digraph{$name}{target} = $result->{target};
 265                 $digraph{$name}{merged} = $result->{merged};
 266             }
 267         }
 268     }
 269     logit("warn: no module for libs were found and dropped: [" .
 270           join(",", (sort (keys(%unknown_libs)))) . "]\n");
 271     return optimize_tree(\%digraph);
 272 }
 273
 274 sub prune_leaves($)
 275 {
 276     my $tree = shift;
 277     my %newtree;
 278     my %name_has_deps;
 279
 280     # we like a few leaves around:
 281     for my $nonleaf ('desktop', 'sw', 'sc', 'sd', 'starmath') {
 282         $name_has_deps{$nonleaf} = 1;
 283     }
 284
 285     # find which modules are depended on by others
 286     for my $name (keys %{$tree}) {
 287         for my $dep (@{$tree->{$name}->{deps}}) {
 288             $name_has_deps{$dep} = 1;
 289         }
 290     }
 291
 292     # prune modules with no deps
 293     for my $name (keys %{$tree}) {
 294         delete $tree->{$name} if (!defined $name_has_deps{$name});
 295     }
 296
 297     return optimize_tree($tree);
 298 }
 299
 300 sub annotate_mergelibs($)
 301 {
 302     my $tree = shift;
 303     print STDERR "annotating mergelibs\n";
 304     for my $name (keys %{$tree}) {
 305     if (defined $merged_libs{$name}) {
 306         $tree->{$name}->{merged} = 1;
 307 #        print STDERR "mark $name as merged\n";
 308     }
 309     }
 310 }
 311
 312 sub dump_graphviz($)
 313 {
 314     my $tree = shift;
 315     my $to = \*STDOUT;
 316     open($to, ">$output_file") if defined($output_file);
 317     print $to <<END;
 318 digraph LibreOffice {
 319 edge  [color="#31CEF0", len=0.4]
 320 edge  [fontname=Arial, fontsize=10, fontcolor="#31CEF0"]
 321 END
 322 ;
 323
 324    my @merged_names;
 325    my @normal_names;
 326    for my $name (sort keys %{$tree}) {
 327        if ($tree->{$name}->{merged}) {
 328        push @merged_names, $name;
 329        } else {
 330        push @normal_names, $name;
 331        }
 332    }
 333    print $to "node  [fontname=Verdana, fontsize=10, height=0.02, width=0.02,".
 334             'shape=Mrecord,color="#BBBBBB"' .
 335             "];" . join(';', @normal_names) . "\n";
 336    print $to "node  [fontname=Verdana, fontsize=10, height=0.02, width=0.02,".
 337             'shape=box,style=filled,color="#CCCCCC"' .
 338             "];" . join(';', @merged_names) . "\n";
 339
 340    for my $name (sort keys %{$tree}) {
 341        my $result = $tree->{$name};
 342        logit("minimising deps for $result->{target}\n");
 343        for my $dep (@{$result->{deps}}) {
 344            print $to "$name -> $dep;\n" ;
 345        }
 346     }
 347     print $to "}\n";
 348 }
 349
 350 sub toposort_visit($$$$);
 351 sub toposort_visit($$$$)
 352 {
 353     my $tree = shift;
 354     my $list = shift;
 355     my $tags = shift;
 356     my $name = shift;
 357     die "dependencies don't form a DAG"
 358         if (defined($tags->{$name}) && $tags->{$name} == 1);
 359     if (!$tags->{$name}) {
 360         $tags->{$name} = 1;
 361         my $result = $tree->{$name};
 362         for my $dep (@{$result->{deps}}) {
 363             toposort_visit($tree, $list, $tags, $dep);
 364         }
 365         $tags->{$name} = 2;
 366         push @{$list}, $name;
 367     }
 368 }
 369
 370 sub dump_toposort($)
 371 {
 372     my $tree = shift;
 373     my @list;
 374     my %tags;
 375     for my $name (sort keys %{$tree}) {
 376         toposort_visit($tree, \@list, \%tags, $name);
 377     }
 378     my $to = \*STDOUT;
 379     open($to, ">$output_file") if defined($output_file);
 380     for (my $i = 0; $i <= $#list; ++$i) {
 381         print $to "$list[$i]\n";
 382     }
 383 }
 384
 385 sub filter_targets($)
 386 {
 387     my $tree = shift;
 388     for my $name (sort keys %{$tree})
 389     {
 390         my $result = $tree->{$name};
 391         if ($result->{type} eq 'CppunitTest' ||
 392             ($result->{type} eq 'Executable' &&
 393              $result->{target} ne 'soffice_bin'))
 394         {
 395             delete($tree->{$name});
 396         }
 397     }
 398 }
 399
 400 sub parse_options()
 401 {
 402     my %h = (
 403         'verbose|v' => \$verbose,
 404         'help|h' => \my $help,
 405         'man|m' => \my $man,
 406         'version|r' => sub {
 407             VersionMessage(-msg => "You are using: 1.0 of ");
 408         },
 409         'preserve-libs|p' => \$preserve_libs,
 410         'toposort|t' => \$toposort,
 411         'write-dep-file|w=s' => \$to_file,
 412         'read-dep-file|f=s' => \$from_file,
 413         'no-leaf|l' => \$no_leaf,
 414         'output-file|o=s' => \$output_file);
 415     GetOptions(%h) or pod2usage(2);
 416     pod2usage(1) if $help;
 417     pod2usage(-exitstatus => 0, -verbose => 2) if $man;
 418     ($gnumake, $makefile_build) = @ARGV if $#ARGV == 1;
 419     $gnumake = 'make' if (!defined $gnumake);
 420     $makefile_build = 'Makefile.gbuild' if (!defined $makefile_build);
 421     $src_root = defined $ENV{SRC_ROOT} ? $ENV{SRC_ROOT} : ".";
 422 }
 423
 424 sub main()
 425 {
 426     parse_options();
 427     my $deps = read_deps();
 428     my $tree = clean_tree($deps);
 429     filter_targets($tree);
 430     optimize_tree($tree);
 431     annotate_mergelibs($tree);
 432     if (!$preserve_libs && !defined($ENV{PRESERVE_LIBS})) {
 433         $tree = collapse_lib_to_module($tree);
 434     }
 435     if ($no_leaf) {
 436         $tree = prune_leaves($tree);
 437     }
 438     if ($toposort) {
 439         dump_toposort($tree);
 440     } else {
 441         dump_graphviz($tree);
 442     }
 443 }
 444
 445 main()
 446
 447  __END__
 448
 449 =head1 NAME
 450
 451 module-deps - Generate module dependencies for LibreOffice build system
 452
 453 =head1 SYNOPSIS
 454
 455 module_deps [options] [gnumake] [makefile]
 456
 457 =head1 OPTIONS
 458
 459 =over 8
 460
 461 =item B<--help>
 462
 463 =item B<-h>
 464
 465 Print a brief help message and exits.
 466
 467 =item B<--man>
 468
 469 =item B<-m>
 470
 471 Prints the manual page and exits.
 472
 473 =item B<--version>
 474
 475 =item B<-v>
 476
 477 Prints the version and exits.
 478
 479 =item B<--preserve-libs>
 480
 481 =item B<-p>
 482
 483 Don't collapse libs to modules
 484
 485 =item B<--toposort>
 486
 487 =item B<-t>
 488
 489 Output a topological sorting instead of a graph
 490
 491 =item B<--read-dep-file file>
 492
 493 =item B<-f>
 494
 495 Read dependency from file.
 496
 497 =item B<--write-dep-file file>
 498
 499 =item B<-w>
 500
 501 Write dependency to file.
 502
 503 =item B<--output-file file>
 504
 505 =item B<-o>
 506
 507 Write graph or sort output to file
 508
 509 =back
 510
 511 =head1 DESCRIPTION
 512
 513 B<This program> parses the output of LibreOffice make process
 514 (or cached input file) and generates the digraph build dependency,
 515 that must be piped to B<graphviz> program (typically B<dot>).
 516
 517 B<Hacking on it>:
 518
 519 The typical (optimized) B<workflow> includes 3 steps:
 520
 521 =over 3
 522
 523 =item 1
 524 Create cache dependency file: module_deps --write-dep-file lo.dep
 525
 526 =item 2
 527 Use cache dependency file: module_deps --read-dep-file lo.dep -o lo.graphviz
 528
 529 =item 3
 530 Pipe the output to graphviz: cat lo.graphviz | dot -Tpng -o lo.png
 531
 532 =back
 533
 534 =head1 TODO
 535
 536 =over 2
 537
 538 =item 1
 539 Add soft (include only) dependency
 540
 541 =item 2
 542 Add dependency on external modules
 543
 544 =back
 545
 546 =head1 AUTHOR
 547
 548 =over 2
 549
 550 =item Michael Meeks
 551
 552 =item David Ostrovsky
 553
 554 =back
 555
 556 =cut