verilator/nodist/dot_pruner

#!/usr/bin/perl -w
# $Id$
######################################################################
#
# Copyright 2005-2008 by Wilson Snyder <wsnyder@wsnyder.org>.  This
# program is free software; you can redistribute it and/or modify it under
# the terms of either the GNU Lesser General Public License or the Perl
# Artistic License.
#
# This program 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.
#
######################################################################

require 5.006_001;
use Getopt::Long;
use IO::File;
use Pod::Usage;
use Data::Dumper; $Data::Dumper::Indent=1;
use strict;
use vars qw ($Debug);

#======================================================================

our @Header;
our %Vertexes;
our %Edges;
our %User;
our %User2;

#======================================================================
# main

$Debug = 0;
my $opt_filename;
my $opt_circle;
autoflush STDOUT 1;
autoflush STDERR 1;
if (! GetOptions (
		  "help"	=> \&usage,
		  "debug"	=> \&debug,
		  "<>"		=> \&parameter,
		  "circle=s"	=> \$opt_circle,
		  )) {
    usage();
}

dotread ($opt_filename);
circle($opt_circle) if $opt_circle;
simplify();
dotwrite();

#----------------------------------------------------------------------

sub usage {
    print '$Id$ ', "\n";
    pod2usage(-verbose=>2, -exitval => 2);
    exit (1);
}

sub debug {
    $Debug = 1;
}

sub parameter {
    my $param = shift;
    if (!$opt_filename) {
	$opt_filename = $param;
    } else {
	die "%Error: Unknown parameter: $param\n";
    }
}

#######################################################################

sub dotread {
    my $filename = shift;

    my $fh = IO::File->new($filename) or die "%Error: $! $filename,";
    my $header = 1;
    while (defined (my $line = $fh->getline)) {
	if ($line =~ /^\t([a-zA-Z0-9_]+)\t(.*)$/) {
	    $header = 0;
	    $Vertexes{$1} = $2;
	}
	elsif ($line =~ /^\t([a-zA-Z0-9_]+)\s+->\s+([a-zA-Z0-9_]+)\s+(.*)$/) {
	    $Edges{$1}{$2} = $3;
	}
	elsif ($header) {
	    push @Header, $line;
	}
    }
}

######################################################################

sub simplify {
    foreach my $ver (sort (keys %Vertexes)) {
	$Vertexes{$ver} = _simplify($Vertexes{$ver});
    }
    foreach my $v1 (sort (keys %Edges)) {
	foreach my $v2 (sort (keys %{$Edges{$v1}})) {
	    $Edges{$v1}{$v2} = _simplify($Edges{$v1}{$v2});
	}
    }
}

sub _simplify {
    my $text = shift;
    $text =~ s/__DOT__/./g;
    return $text;
}


sub dotwrite {
    foreach my $line (@Header) {
	print "$line";
    }
    foreach my $ver (sort (keys %Vertexes)) {
	print "\t$ver\t$Vertexes{$ver}\n";
    }
    foreach my $v1 (sort (keys %Edges)) {
	foreach my $v2 (sort (keys %{$Edges{$v1}})) {
	    print "\t$v1 -> $v2\t$Edges{$v1}{$v2}\n";
	}
    }
    print "}\n";
}

######################################################################

sub circle {
    my $node = shift;
    %User = ();
    %User2 = ();
    _circle_recurse($node, 1);

    foreach my $ver (keys %Vertexes) {
	if (!$User{$ver}) {
	    delete $Vertexes{$ver};
	    delete $Edges{$ver};
	}
    }
    foreach my $v1 (sort (keys %Edges)) {
	foreach my $v2 (sort (keys %{$Edges{$v1}})) {
	    if (!$Vertexes{$v2}) { delete $Edges{$v1}{$v2}; }
	}
    }
}

sub _circle_recurse {
    my $node = $_[0];
    my $level = $_[1];
    $Vertexes{$node} or warn "%Warning: Can't find ref node $node\n";

    $User{$node} = 1 if (($User2{$node}||0)==1);
    return $User{$node} if $User2{$node};

    $User2{$node} = 1;
    my $r = 0;
    foreach my $v2 (keys %{$Edges{$node}}) {
	$r |= _circle_recurse($v2,$level++)||0;
    }
    $User{$node} = 1 if $r;
    $User2{$node} = 2;
    return $r;
}

#######################################################################
__END__

=pod

=head1 NAME

dot_pruner - 

=head1 SYNOPSIS

  dot_pruner *.log

=head1 DESCRIPTION

dd

=head1 ARGUMENTS

=over 4

=item --help

Displays this message and program version and exits.

=back

=head1 DISTRIBUTION

Copyright 2005-2008 by Wilson Snyder.  This package is free software; you
can redistribute it and/or modify it under the terms of either the GNU
Lesser General Public License or the Perl Artistic License.

=head1 AUTHORS

Wilson Snyder <wsnyder@wsnyder.org>

=head1 SEE ALSO

=cut

######################################################################
### Local Variables:
### compile-command: "./dot_pruner | tee ~/d/a.dot"
### End: