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