#!/bin/sh
# -*-Perl-*-
#======================================================================#
# Run the right perl version:
if [ -x /usr/local/bin/perl ]; then
perl=/usr/local/bin/perl
elif [ -x /usr/bin/perl ]; then
perl=/usr/bin/perl
else
perl=`which perl| sed 's/.*aliased to *//'`
fi
exec $perl -x -S $0 "$@"; # -x: start from the following line
#======================================================================#
#! /Good_Path/perl -w
# line 17
# Name: mkdot
# Author: wd (Wolfgang.Dobler@kis.uni-freiburg.de)
# Started: 06-Jul-2002
# CVS: $Id$
# Usage:
# cd src
# scripts/mkdot *.f90 -o dependencies.dot
# dot -Tps dependencies.dot -o dependencies.ps
# Note: The `dot' command is part of the graphviz package
# History:
# 23-jun-05/tony: Created
#
# ---------------------------------------------------------------------- #
my $use_statement = '^\s*use\s+([A-Za-z_]+)\s*(,\s*only: ([A-Za-z0-9_,\s]+))*$';
my $module_start = '^\s*module\s+([A-Za-z_]+)\s*$';
my $module_end = '^\s*end\s*module\s+([A-Za-z_]+)\s*$';
my $program_start = '^\s*program\s+([A-Za-z_]+)\s*$';
my $program_end = '^\s*end\s*program\s+([A-Za-z_]+)\s*$';
my $main_program_module = 'MAIN_PROGRAM';
my $current_module = $main_program_module;
my %unique_dep;
# ---------------------------------------------------------------------- #
use strict;
use Getopt::Long;
my $line;
my $dust_string='1*4';
my $lmdvar='.false.';
my $lmice ='.false.';
my ($maux,$maux_com,$mvar,$mpvar,$ndustspec,$mvar_per_dust) = (0) x 6;
(my $cmdname = $0) =~ s{.*/}{};
## Process command line
my (%opts); # Variables written by GetOptions
GetOptions(\%opts,
qw( -h --help
--nono
-T=s --title=s
-o=s --output=s
));
my $nono = $opts{nono};
die usage() if ((@ARGV == 0) || $opts{h} || $opts{help});
my $title = ($opts{T} || $opts{title} || 'dependencies');
my $outfile = ($opts{o} || $opts{output} || "-");
open(OUT, "> $outfile") or die "Can't open $outfile for writing";
## Write output
print OUT <<"EOF";
// -*-f90-*- (for emacs) vim:set filetype=fortran: (for vim)
// DOT description for Module dependence
//
digraph "$title" {
rotate=90;
size="11,7.55";
ratio = fill;
node[width=5.5,hight=4.,fontsize=50];
EOF
# Cycle through files (later files will overwrite effect of earlier files)
file: foreach my $infile (@ARGV) {
# Now extract `?VAR CONTRIBUTION' info from each file
print OUT "// Processing file: $infile\n";
$current_module=$main_program_module;
unless (open(INPUT,"< $infile")) {
print STDERR "Skipping $infile (not found)\n";
next file;
}
# Cycle through all lines up to first non-empty non-comment line in file
line: while (defined($line=)) {
next line if ($line =~ /^\s*$/); # ignore empty lines
# last line if ($line !~ /^\s*!/); # done if non-comment line
# extract_decl ($line, $mvar_decl , \$mvar );
# extract_decl ($line, $maux_decl , \$maux );
# extract_decl ($line, $maux_com_decl, \$maux_com );
# extract_decl ($line, $mpvar_decl , \$mpvar );
# Check for information about number of dust species and discretization type
if ($line=~ /$program_start/i) {
$current_module="$1";
$current_module =~ tr/a-z/A-Z/;
}
if ($line=~ /$program_end/i) {$current_module=$main_program_module;}
if ($line=~ /$module_start/i) {
$current_module=$1;
$current_module =~ tr/a-z/A-Z/;
if ($infile =~ /^no/) { print OUT "$current_module [color=blue,fontcolor=blue]\n"}
}
if ($line=~ /$module_end/i) {$current_module=$main_program_module;}
if ($line=~ /$use_statement/i) {
my $dependency= $1;
$dependency =~ tr/a-z/A-Z/;
if (! exists($unique_dep{"$current_module$dependency"})) {
$unique_dep{"$current_module$dependency"}="exists";
if (!($nono && $infile=~ /^no/)) { print OUT " $current_module -> $dependency;\n"; }
}
}
}
}
## Write output
print OUT <<"EOF";
}
EOF
# ---------------------------------------------------------------------- #
sub extract_decl{
## Extract declaration of contribution to mvar and similar
my $line = shift;
my $regexp = shift;
my $counter_ref = shift;
if ($line =~ /$regexp/) {
$$counter_ref += $1;
}
}
# ---------------------------------------------------------------------- #
sub usage {
# Extract description and usage information from this file's header.
my $thisfile = __FILE__;
local $/ = ''; # Read paragraphs
open(FILE, "<$thisfile") or die "Cannot open $thisfile\n";
while () {
# Paragraph _must_ contain `Description:' or `Usage:'
next unless /^\s*\#\s*(Description|Usage):/m;
# Drop `Author:', etc. (anything before `Description:' or `Usage:')
s/.*?\n(\s*\#\s*(Description|Usage):\s*\n.*)/$1/s;
# Don't print comment sign:
s/^\s*# ?//mg;
last; # ignore body
}
$_ or "\n";
}
# ---------------------------------------------------------------------- #
# End of file mkdot