Perl script to show dependencies

[Rolf Ebert <re@waporo.muc.de>]

The following is a simple minded perl-script which analyses Ada files
and generates a spreadsheet of the dependencies between the Ada units.
I wrote it, because I wanted to know about the relation between several
units before reorganizing a project.

The script is very limited in several aspects.  

1) It requires the GNAT naming scheme without any "krunching",
i.e. specs are in *.ads, bodies are in *.adb and the filename
corresponds to the name of the unit. 

2) It requires that a with statement references a single unit.  If you
write

with Toto, Tata;

it will list only Toto as a unit on which the current one depends.  My
personal style is to write a new with statement for every unit.  If that
is not your style, don't use this script (or better send me a patch
which makes it working with your style)

3) all files must be present in the current directory.


The output is a comma separated ascii file (on stdout) which can be read
by most spreadsheet programs (Excel, StarCalc, ...).  The top line lists
all units on which others depend.  On the left you have all files (specs
and bodies) in alphabetical order.  The matrix element is either empty
(no dependency), contains a "w" (the file on the left explicitely
"withes" the unit on the top, parents included), and/or a "p" (the unit
on the top is a parent of the unit on the left)

It will show only explicit dependancies from "withing" or from being a
child.  No dependancy created by the compiler (generics, inlineing) is
shown.


Please mail me if you think the script is useful.

        Rolf
        ebert@waporo.muc.de


---------------------------------------------------------------
#!/opt/gnu/bin/perl

# generate a spreadsheet of explicit dependancies between Ada units

opendir(DIR, ".");
@specfiles = grep(/\.ads$/, readdir(DIR));
rewinddir(DIR);
@bodyfiles = grep(/\.adb$/, readdir(DIR));
closedir(DIR);

## Loop over all files.  Files are scanned for with clauses.  With
## clauses are supposed to have only one entry, which is on the same
## line as the "with" keyword itself.  
##
## Dependancy on parent packages is deduced from the filename itself.
## This algorithm assumes GNAT filename conventions without
## "krunching".
##

foreach $file (@specfiles, @bodyfiles) {
    open(FILE, $file) || warn "Cannot open file $file: $!.";

    # replace the dot of the file extension by a blank for sorting
    $file =~ tr/./ /;

    # We add units withed by the spec to the body as well.
    if (substr($file, -1) eq "s") { 
        $body = substr($file, 0, length($file)-1) . "b";
    } else {
        $body = $file;
        substr($file, -1) = "z";
    }

    while (<FILE>) {
        if (/^with\s+([\w\.]+)/) {
            $ref = $1;
            $ref =~ tr/A-Z/a-z/; # convert to lower case
            $depends_on{$ref}->{$file} = "w";
            if ($body) { $depends_on{$ref}->{$body} = "w"; }

            # all parent units of withed units are withed as well
            $p = rindex($ref, ".");
            while ($p >= $[) { # there is a "." in ref
                $ref = substr($ref, $[, $p); # extract leading part
                $depends_on{$ref}->{$file} = "w";
                if ($body) { $depends_on{$ref}->{$body} = "w"; }
                $p = rindex($ref, ".");
            }
        }
    }

    # unit depends on all own parents
    $ref = $file;
    $p = rindex($ref, " ");
    $ref = substr($ref, $[, $p); # ommit file extension
    $ref =~ tr/-/./;
    $p = rindex($ref, ".");
    while ($p >= $[) { # there is a "." in ref
        $ref = substr($ref, $[, $p); 
        if (substr($file, -1) eq "z") {
            $depends_on{$ref}->{$body} .= "p";
        } else {
            $depends_on{$ref}->{$file} .= "p";
        }
        $p = rindex($ref, ".");
    }

    close(FILE);
}



## print out the matrix
@sorted_keys = sort(keys(%depends_on));
foreach $unit (@sorted_keys) {
    print ";$unit";
}
print ";\n";

foreach $file (sort(@specfiles,@bodyfiles)) {
      if (substr($file, -1) eq "z") { 
          # rename bodyfiles back to original name
          substr($file, -1) = "b";
      }

    print "$file;";
    foreach $unit (@sorted_keys) {
        print $depends_on{$unit}->{$file};
        print ";";
    }
    print "\n";
}
    

---------------------------------------------------------------------------