我很久以前写过代码来为八度音程做这个。我主要使用它来为graphviz生成.dot文件来可视化依赖关系,但我也在makefile中使用它来在编译代码时包装依赖关系。不幸的是,它是 perl 代码,但您可以通过 shell 调用它来从脚本运行它。它是完全递归的。
要运行它,您必须将 OCT_BASE 更改为指向代码的根目录。(对不起,它不是 matlab 的路径变量感知)。那么我可能会将它作为 perl octavedepgrapher.pl -l 运行
#! /bin/sh
exec perl -x -S $0 ${1+"$@"} # -*-perl-*-
#!perl
#
# octavedepgrapher.pl
# find the dependancy graph of octave file(s). prints a
# dot file suitable for graphviz
# Author: steven e. pav
# Created: 2006.07.16
# SVN: $Id$
#
# * Thu Aug 30 2007 Steven Pav
# - expanding to recognize matlabs pragma of %#function funcname
# version 0.3 2007.04.17
# add raw output mode.
# version 0.2 2007.03.05
# add media selection
# version 0.1 2006.08.24
# fixed multiple functions within file.
# added multiple edgeout capability.
# adding clusters for files.
# version 0.0 2006.07.16
# created.
#
#
########################################################################
########################################
# change only this
########################################
#@OCT_BASE = qw(/home/spav/sys/octave/m/ ./ $ENV{OCTAVE});
@OCT_BASE = qw(/home/spav/sys/octave/m/ ./);
########################################################################
$VERSION = "octavedepgrapher version 0.02 2006.08.23\n";
########################################################################
use Getopt::Long;
$Getopt::Long::ignorecase = 0;
$Getopt::Long::order = $PERMUTE;
%OPT_MEANINGS = (
'H' => 'show Help.',
'l' => 'list the dependencies to standard out. do not make a dot file.',
'p' => 'give full path names.',
'm' => 'multi-edge. one for each function call.',
'g' => 'map connections from functions to global variables.',
'G' => 'map connections between functions which share global variables.',
'C' => 'do not cluster files.',
'D' => 'Debug.',
'd=s' => 'dependency mode for makefiles. sets -p and -l, and but outputs in makefile suitable format. the string is the extension (with dot) to substitute for .m',
'r=s' => 'aspect ratio (can be fill, auto, compact (default))',
'B=s' => 'base directory. if given, all directories are assumed relative to this one.',
'L=s' => 'colon separated list of base directories of libraries (_overrides_ OCT_BASE). should probably include ./',
'l=s' => 'colon separated list of base directories of libraries (in addition to OCT_BASE).',
'X=s' => 'colon separated list of base directories to exclude in the search.',
'M=s' => 'media selection',
);
$OPTS = join('',(map { substr($_,0,1); } keys(%OPT_MEANINGS)));
&GetOptions(keys %OPT_MEANINGS);
$opt_H && &die_usage; #done
$opt_L && (@OCT_BASE = split(/\s*:\s*/,$opt_L));
$opt_l && (push(@OCT_BASE,split(/\s*:\s*/,$opt_l)));
$opt_X && (@OCT_BASE = @{&rm_dirs(\@OCT_BASE,$opt_X)});
if (not $opt_M)
{ $size="25,20";
} else {
($opt_M =~ m/^legal/i) and $size = '8.5,14';
($opt_M =~ m/^letter/i) and $size = '8.5,11';
($opt_M =~ m/^A0$/i) and $size = '33.1,46.8';
($opt_M =~ m/^A1$/i) and $size = '23.4,33.1';
($opt_M =~ m/^A2$/i) and $size = '16.5,23.4';
($opt_M =~ m/^A3$/i) and $size = '11.7,16.5';
($opt_M =~ m/^A4$/i) and $size = '8.3,11.7';
($opt_M =~ m/^A4dj$/i) and $size = '8.3,11.7';
($opt_M =~ m/^A5$/i) and $size = '5.8,8.3';
}
#if (not $opt_r) { $ratio = 'fill'; } else { $ratio = $opt_r; }
$ratio = $opt_r || 'fill';
if ($opt_d)
{
$opt_l = $opt_p = 1;
}
#make sure it has a tailing slash.
if ($opt_B)
{
($opt_B !~ m{/$}) && ($opt_B .= q[/]);
}
########################################################################
$| = 1;
if (! @ARGV)
{
&die_usage;
} else
{
%mfhash = &map_name_to_filename(@ARGV);
}
if ($opt_d)
{
@myargv = @ARGV;
print join(' ',map { s/\.m/$opt_d/e;$_; } @ARGV),qq[ : ];
}
if ($opt_l) {
%bdhash = &find_base_libs(@OCT_BASE);
$alldepref = &find_all_deps(\%mfhash,\%bdhash,0);
print join(' ',@{$alldepref}),qq[\n];
} else {
&print_head();
%bdhash = &find_base_libs(@OCT_BASE);
&find_all_deps(\%mfhash,\%bdhash,1);
&print_tail();
}
$opt_X && (@OCT_BASE = @{&rm_dirs(\@OCT_BASE,$opt_X)});
########################################################################
sub
rm_dirs
#remove directories from OCT_BASE
{
my $ob_ref = shift(@_);
my $oX = shift(@_);
my @excludeus = split(/\s*:\s*/,$oX);
#FIX!
}
########################################################################
sub
make_relative
#just for the sake of opt_B#FOLDUP
{
my $fullname = shift(@_);
if ($opt_B)
{
$fullname =~ s{\Q$opt_B\E}{};
}
return $fullname;
}#UNFOLD
########################################################################
sub
map_name_to_filename#FOLDUP
{
my $mfile;
my %mfiles;
my $mfstub;
while ($mfile = shift(@_))
{
$mfstub = $mfile;
$mfstub =~ s/^\s*(.*\/)?([^\/]+)\.m\s*$/$2/;
$mfiles{$mfstub} = $mfile;
}
return %mfiles;
}#UNFOLD
########################################################################
sub
find_base_libs#FOLDUP
{
my $based;
my %bdhash;
my ($mfile,$mfstub);
my @mfiles;
while ($based = shift(@_))
{
# print "|$based|\n";
@mfiles = split(/\n/,qx(cd $based && find . -name '*.m'));
while ($mfile = shift(@mfiles))
{
$mfstub = $mfile;
$mfstub =~ s/.+\/([^\/]+)\.m/$1/;
$mfile =~ s/^\s*\.\//$based/;
$bdhash{$mfstub} = $mfile;
#print STDERR "|$mfstub| -> |$mfile| |$based|\n";
}
}
return %bdhash;
}#UNFOLD
########################################################################
#returns array of all the dependencies as filename strings.
sub
find_all_deps#FOLDUP
{
my $mfhashref = shift(@_);
my $bdhashref = shift(@_);
my $doprint = shift(@_); #if 0, do not print anything out.
my @mfhashlist = %{$mfhashref};
my %bdhash = %{$bdhashref};
my $output = [];
my %globals;
my $gname;
my %doneok;
my ($mfname,$mfloc);
my ($aline,$acommand,$copyline);
my %eegraph; #store as node::node in this hash set.
#prevents edges from being written multiple times?
my %dangling = {}; #any command which has yet to be found.
#store vals a list of things which want to point in.
my $pointsin;
my $foundnewfunc;
my $foundFuncPragma; #for looking for % #function fname stuff
#my @myDependencies; #every function that I call;
my $edgestr = '';
while ($mfname = shift(@mfhashlist))#FOLDUP
{
$mfloc = shift(@mfhashlist);
$mf_alias = ($opt_p)? &make_relative($mfloc) : $mfname; #full names or not
#prevent node -> self edges.
$eegraph{qq(${mfname}::${mfname})} = 1;
if ((! $opt_C) && $doprint)
{
print qq(subgraph cluster_$mfname {\n);
print qq(rank=min\n);
print qq(ordering=out\n);
}
#node
$doprint &&
print qq{$mfname [label="$mf_alias" shape=plaintext fontsize=44]\n};
push (@{$output},$mf_alias);
$doneok{$mfname} = 1;
#open a file#FOLDUP
open (FH,"$mfloc") || die "no open $mfloc, $!";
while (! eof(FH))
{
$aline = ;
chomp($aline);
$foundFuncPragma = 0;
if ($aline =~ /^[^%]*end\s*%?\s*function/) { $mfname = ''; }
if ($mfname) #inside a function
{
if ($opt_g || $opt_G) #look for globals#FOLDUP
{
if ($aline =~ /global/)
{
$copyline = $aline;
while ($copyline =~ s/(global\s+)([^;\s]+)(\s*;)/$1$3/)
{
$gname = $2;
if (exists $globals{$gname})
{
push(@{$globals{$gname}},$mfname);
} else {
$globals{$gname} = [$mfname];
}
}
}
}#UNFOLD
#look for #function pragma
$foundFuncPragma = ($aline =~ s/%\s*#function\s+(.+)$//);
if ($foundFuncPragma)
{
$opt_D && (print STDERR "found a function pragma! |$1|\n");
#what a bummer that we can't just use this: the
#problem is that we don't really know when a function
#ends in .m code, b/c endfunction is not required. bummer.
#push (@myDependencies,split(/\s+/,$1));
#
#that is, what we would really like to do is just push onto a list
#every time we saw a command, then puke at the end of the function,
#but we do not know really when a function ends in matlab. oops.
foreach $acommand (split(/\s+/,$1))
{
$opt_D && (print STDERR "found a command! |$acommand|\n");
#push (@myDependencies,$acommand);
if (exists($bdhash{$acommand}))
{
$opt_D && (print STDERR "exists in bdhash (prolly means is a file to itself)\n");
if (! $eegraph{qq(${mfname}::${acommand})})
{
if ($opt_C) { $doprint && print "$mfname -> $acommand\n";
} else { $edgestr .= "$mfname -> $acommand\n"; }
if (! $opt_m) { $eegraph{qq(${mfname}::${acommand})} = 1; }
}
if (! $doneok{$acommand})
{
$doneok{$acommand} = 1;
push(@mfhashlist,$acommand,$bdhash{$acommand});
}
} else
{
if (exists($dangling{$acommand}))
{ push(@{$dangling{$acommand}},$mfname);
} else { $dangling{$acommand} = [$mfname]; }
}
}
}
while ($aline =~ /([a-zA-Z0-9_]+)\s*\(/)#FOLDUP
{
$aline =~ s/([a-zA-Z0-9_]+)\s*\(//;
$acommand = $1;
$opt_D && (print STDERR "found a command! |$acommand|\n");
#push (@myDependencies,$acommand);
if (exists($bdhash{$acommand}))
{
$opt_D && (print STDERR "exists in bdhash (prolly means is a file to itself)\n");
if (! $eegraph{qq(${mfname}::${acommand})})
{
if ($opt_C) { $doprint && print "$mfname -> $acommand\n";
} else { $edgestr .= "$mfname -> $acommand\n"; }
if (! $opt_m) { $eegraph{qq(${mfname}::${acommand})} = 1; }
}
if (! $doneok{$acommand})
{
$doneok{$acommand} = 1;
push(@mfhashlist,$acommand,$bdhash{$acommand});
}
} else
{
if (exists($dangling{$acommand}))
{ push(@{$dangling{$acommand}},$mfname);
} else { $dangling{$acommand} = [$mfname]; }
}
}#UNFOLD
} else #not yet inside a function.
{
$foundnewfunc = 0;
if ($aline =~ /^[^%]*function\s+[^=]*=\s*([a-zA-Z0-9_]+)\s*(\(|;|%|$)/)
{
$mfname = $1;$foundnewfunc = 1;
} elsif ($aline =~ /^[^%]*function\s+([a-zA-Z0-9_]+)\s*(\(|;|%|$)/)
{
$mfname = $1;$foundnewfunc = 1;
}
if ($foundnewfunc)
{
#@myDependencies = ();
$opt_D && (print STDERR "now looking at function |$mfname|\n");
$eegraph{qq(${mfname}::${mfname})} = 1;
#subnode
$doprint && print "$mfname [shape=box]\n";
$doneok{$mfname} = 1;
$bdhash{$mfname} = 1; #innocent enough since doneok is set too.
if (exists($dangling{$mfname}))
{
while ($pointsin = shift(@{$dangling{$mfname}}))
{
$doprint && print "$pointsin -> $mfname\n";
}
}
}
}
}
close FH;#UNFOLD
if (! $opt_C)
{
$doprint && print qq(}\n);
$doprint && print $edgestr;
$edgestr = '';
}
}#UNFOLD
if ($doprint)
{
if ($opt_g)
{
foreach $key (keys(%globals))
{
print qq{$key [style=dotted label="$key" color=red shape=plaintext fontsize=44]\n};
foreach $f (@{$globals{$key}})
{
print qq{$f -> $key [color=red]\n};
}
}
} elsif ($opt_G)
{
foreach $key (keys(%globals))
{
while (defined($g = shift(@{$globals{$key}})))
{
# foreach $f (@{$globals{$key}}) { print qq{$g -- $f [color=red]\n}; }
foreach $f (@{$globals{$key}}) { print qq{$g -> $f [style=dotted label="$key" fontsize=30 fontcolor=red color=red]\n}; }
}
}
}
}
return $output;
}#UNFOLD
########################################################################
sub
print_head#FOLDUP
{
if (! $opt_m)
{
print qq[strict ];
}
# if ($opt_G) { print qq[octavedep {\n]; } else { print qq[digraph octavedep {\n]; }
print qq[digraph octavedep {\n];
print qq[nslimit=15.0\n];
print qq[mclimit=1.0\n];
print qq[ratio="$ratio"\n];
print qq[size="$size"\n];
}#UNFOLD
sub
print_tail#FOLDUP
{
print "}\n";
}#UNFOLD
########################################################################
sub
die_usage#FOLDUP
{
# print STDERR "usage: perl $0 [-$OPTS] [-$VALOPTS val] octfiles\n\n";
print STDERR "usage: perl $0 [-$OPTS] octfiles\n\n";
if ($opt_H)
{
%OPT_MEANINGS =
map {($a=$_)=~s/(.)+?[=:!]?[ifs]?/$1/;$a=>$OPT_MEANINGS{$_};}
keys %OPT_MEANINGS;
@OPTS = split(//,$OPTS);
while ($OP = shift(@OPTS)) {
print STDERR " $OP $OPT_MEANINGS{$OP}\n";
}
print STDERR "\n";
}
exit;
}#UNFOLD
########################################################################
__END__
为我工作...