#!/usr/bin/perl -w use strict; { if ($#ARGV > -1 && $ARGV[0] eq "-h") { print STDERR "usage: $0 [-h]\n"; print STDERR " builds the dependency tree of f90 files - run from the QE root directory\n"; print STDERR " html page with links written to standard output\n"; exit 0; } my $basedir = $0; # Orig: the following is the directory where this script is # $basedir =~ s/(.*)\/.*/$1/; # the following works only if we run the script from QE root $basedir = "./"; my @sources = split(/ /, `echo $basedir/*/*.f90 $basedir/*/*/*.f90`); # grab program, function and subroutine declarations my (%place, %fname, %pname, %sname); foreach my $file (@sources) { open(IN, "$file"); while () { $_ = "\L$_"; # cast everything to lowercase if (/^[^!'""']*\bfunction\s+(\w+)/o && ! /^\s*end\s+function\b/o) { $fname{$1} = 1; insert_place(\%place, $1, $file); } elsif (/^\s*program\s+(\w+)/o) { $pname{$1} = 1; insert_place(\%place, $1, $file); } elsif (/^\s*(?:(?:pure|recursive)\s+)?subroutine\s+(\w+)/o) { $sname{$1} = 1; insert_place(\%place, $1, $file); } } close(IN); } my @targets = sort keys %place; my @programs = sort keys %pname; my @functions = sort keys %fname; # html preamble print "\n"; print "\n"; print "\n"; # list of programs print "
\n"; print "
list of programs:
\n"; print "

\n"; foreach my $program (@programs) { print " $program\n"; } print "

\n"; print "
\n"; print "\n"; # list of all routines print "
\n"; foreach my $name (@targets) { print "
"; if (defined $pname{$name}) { print "program "; } elsif (defined $sname{$name}) { print "subroutine "; } elsif (defined $fname{$name}) { print "function "; } print "$name
\n"; my %cname; my @files = split(/ /, $place{$name}); foreach my $file (@files) { print "

defined in file: $file
\n"; print " calls:\n"; my $current = ""; open(IN, $file); while () { $_ = "\L$_"; if (/^\s*program\s+(\w+)/o) { $current = "$1"; } elsif (/^\s*(?:(?:pure|recursive)\s+)?subroutine\s+(\w+)/o) { $current = "$1"; } elsif (/^[^!'""']*\bfunction\s+(\w+)/o) { $current = "$1"; } # here we are inside the relevant program/subroutine/function elsif ($current eq $name) { # subroutine calls if (/^\s*call\s+(\w+)/o) { $cname{$1} = 1; } # function calls foreach my $fun (@functions) { if ($fun ne $name && /^[^!'""']*\b$fun\b/) { $cname{$fun} = 1; } } } } close(IN); my @calls = sort keys %cname; foreach my $call (@calls) { print " $call\n"; } print "

\n"; } } print "
\n"; # html postamble print "\n"; print "\n"; print "\n"; } sub insert_place { my ($place, $name, $file) = @_; if (defined $$place{$name}) { $$place{$name} = "$$place{$name} $file"; } else { $$place{$name} = "$file"; } }