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