src/filter-depend.pl

   1 #!/usr/bin/env perl
   2 #
   3 # filter-depend.pl
   4 #   by Paul Merrill <napalminc@gmail.com>
   5 #
   6 # Read an list of GNU make dependencies from STDIN.
   7 # Remove dependencies not matching a @whitelist pattern.
   8 # Print what's left to STDOUT.
   9 #
  10 use warnings;
  11 use strict;
  12
  13 my @whitelist = (
  14         "^[^/]" # Only track inner-project dependencies.
  15 );
  16
  17 # Output is wrapped to this many columns.
  18 my $width = 78;
  19
  20
  21 # Read a line that's been split with backslashes (\) over multiple lines.
  22 sub read_wrapped_line {
  23         my (@tokens, $line, $more);
  24         do {
  25                 ($line, $more) = <> =~ /^(.*?)(\\)?$/;
  26                 push(@tokens, split(/\s+/, $line));
  27         } while ($more);
  28         return @tokens;
  29 }
  30
  31 # Return true if a string matches any pattern in @whitelist.
  32 sub whitelisted {
  33         my $s = shift;
  34         return grep { $s =~ m/$_/ } @whitelist;
  35 }
  36
  37 # Given a list of tokens, return only those that are whitelisted.
  38 sub filter {
  39         return grep { whitelisted($_) } @_;
  40 }
  41
  42 # Word wrap a string to $outputwidth columns. If split over multiple lines, all
  43 # but the last line are suffixed with a backslash and all but the first line
  44 # are indented with a space.
  45 sub wrap {
  46         my ($space, $token, @rest) = @_;
  47         my $len = length($token);
  48         if ($space-2 < $len) {
  49                 return "\\\n " . wrap($width-1, $token, @rest);
  50         } elsif (@rest) {
  51                 return "$token " . wrap($space-$len-1, @rest);
  52         } else {
  53                 return "$token\n";
  54         }
  55 }
  56
  57 # Prefer files in the current directory, then files with only one "/", etc.
  58 sub by_locality {
  59         my ($c, $d) = (0, 0);
  60         $c++ while ($a =~ /\//g);
  61         $d++ while ($b =~ /\//g);
  62         $c <=> $d or $a cmp $b
  63 }
  64
  65 # Process STDIN one line at a time.
  66 until (eof()) {
  67         my ($target, @deps) = read_wrapped_line();
  68         print wrap($width, $target, sort by_locality filter(@deps));
  69 }
  70