#! /usr/bin/env perl
# -*-Perl-*- code

# This file is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2, or (at your option)
# any later version.

# This file is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.

# You should have received a copy of the GNU General Public License
# along with this software; see the file COPYING.  If not, write to
# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
# Boston, MA 02111-1307, USA.

# Copyright (C) 2005 Ian Zimmerman

# $Id: $

use strict;
use warnings;

use FileHandle;
use Graph::Directed;
use Getopt::Long;

sub collect_para {
    my ($g, $pipefh) = @_;
    my $line = '';
    $line = $pipefh->getline ()
        while (!$pipefh->eof && $line =~ m{^ \s* $ }x);
    return if $pipefh->eof;
    my @para = ();
    do {
        push @para, $line;
        $line = $pipefh->getline ();
    } while (!$pipefh->eof && $line !~ m{^ \s* $ }x);
    my ($target_line) = grep { $_ !~ m{^ ( \# | \s )}x } @para;
    return unless $target_line and $target_line =~ m{^ \s* ([^\s:]+) \s* :+ (.*) $ }x;
    my ($target, $deps) = ($1, $2);
    my @deps = split (' ', $deps);
    $g->add_edge ($_, $target) foreach (@deps);
    my ($phony_line) = grep { $_ =~ m{^ \# \s* phony \s+ target \b }xi } @para;
    $g->set_attribute ('phony', $target, 1) if $phony_line;
}

sub collect {
    my ($cmdline) = @_;
    my $g = Graph::Directed->new;
    my $pipefh = FileHandle->new ($cmdline);
    defined $pipefh or die "$!";
    my $line = '';
    $line = $pipefh->getline ()
        while (!$pipefh->eof && $line !~ m{^ \s* \# \s* files \s* $ }xi);
    &collect_para ($g, $pipefh) while (!$pipefh->eof);
    $pipefh->close ();
    return $g;
}

sub delete_ignored {
    my ($g, @ignore) = @_;
    my $ignore_pat = '(' . join ('|', @ignore) . ')';
    my $ignore_re = qr{$ignore_pat};
    $g->delete_vertices (grep /$ignore_re/, $g->vertices);
}

sub print_edges {
    my (@edges) = @_;
    while (1) {
        my ($dep, $target) = splice (@edges, 0, 2);
        last unless $target;
        print "\"$dep\" -> \"$target\";\n";
    }
}        

sub print_phonies {
    my (@vertices) = @_;
    print "\"$_\" [ color = \"lightgray\" ]; \n" foreach (@vertices);
}

sub main {
    my @ignore = ();
    my $prog = 'make -p -q ';
    my $gname = 'make.dot';
    my $sysheaders = 0;
    my %attribs = ();
    GetOptions (
      'ignore=s'    => \@ignore,
      'program=s'   => \$prog,
      'name=s'      => \$gname,
      'sysheaders'  => \$sysheaders,
    );
    push @ignore, '^\.PHONY$','^\.SUFFIXES$';
    push @ignore, '^/usr/(local/)?(lib|include)/', '^/opt/'
        unless $sysheaders;

    my $g = &collect ($prog . join (' ', @ARGV) . ' |');
    &delete_ignored ($g, @ignore);

    print "digraph \"$gname\" { \n" ;
    &print_edges ($g->edges);
    &print_phonies (grep { $g->get_attribute ('phony', $_) } $g->vertices);
    print "}\n";
}

$_ = main;

1;