bin/module-deps.pl

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