← Back to branch summary

~ubuntu-branches/ubuntu/lucid/graphviz/lucid-updates

« back to all changes in this revision

Viewing changes to tclpkg/gv/demo/modgraph.pl

  • Committer: Bazaar Package Importer
  • Author(s): Bryce Harrington
  • Date: 2008-06-19 20:23:23 UTC
  • mfrom: (1.2.5 upstream)
  • Revision ID: james.westby@ubuntu.com-20080619202323-ls23h96ntj9ny94m
Tags: 2.18-1ubuntu1
https://launchpad.net/bugs/174749
* Merge from debian unstable, remaining changes:
  - Build depend on liblualib50-dev instead of liblua5.1-0-dev.
  - Drop libttf-dev (libttf-dev is in universe) (LP: #174749).
  - Replace gs-common with ghostscript.
  - Build-depend on python-dev instead of python2.4-dev or python2.5-dev.
  - Mention the correct python version for the python bindings in the
    package description.

Show diffs side-by-side

added added

removed removed

Lines of Context:
tclpkg/gv/demo/modgraph.pl
1
 
#!/usr/bin/perl
2
 
 
3
 
# display the kernel module dependencies
4
 
 
5
 
# author: John Ellson <ellson@research.att.com>
6
 
 
7
 
use lib "/usr/lib/graphviz/perl";
 
1
#!/usr/bin/perl -w
 
2
# Change ^^ to the version of Perl you installed the SWIG modules / Graphviz with
 
3
#
 
4
# Change this to point to your installed graphviz lib dir
 
5
#   Normally either /usr/local/lib/graphviz/perl or /usr/lib/graphviz/perl
 
6
#use lib '/home/maxb/lib/graphviz/perl';
8
7
use gv;
9
8
 
 
9
use Getopt::Long;
 
10
GetOptions(\%Args, 'h|help','d|debug');
 
11
$Debug   = $Args{d} || 0;
 
12
$Modules = shift @ARGV || '/proc/modules';
 
13
 
 
14
die &usage if $Args{h};
 
15
die "Cannot read $Modules. $!\n" unless (-r $Modules);
 
16
 
10
17
$G = gv::digraph("G");
11
18
$N = gv::protonode($G);
12
19
$E = gv::protoedge($G);
21
28
gv::setv($N, "fontname", "helvetica");
22
29
gv::setv($E, "arrowsize", ".4");
23
30
 
24
 
#FIXME - complete translation to perl
25
 
 
26
 
#f = File.open('/proc/modules', mode="r")
27
 
#while ! f.eof do
28
 
#       rec = f.gets()
29
 
#
30
 
#    for mod, usedbylist in string.gfind(rec, "([_%w]+) %w+ %w+ ([-,_%w]+)") do
31
 
#       n = gv.node(G, mod)
32
 
#       for usedby in string.gfind(usedbylist, "([-_%w]+)") do
33
 
#          if (usedby ~= '-') and (usedby ~= '') then
34
 
#             gv.edge(n, gv.node(G, usedby))
35
 
#          end
36
 
#       end
37
 
#    end
38
 
#
39
 
#end    
40
 
#f.close
 
31
open (M,"<$Modules") or die "Can't open $Modules. $!\n";
 
32
 
 
33
while (<M>) {
 
34
    chomp;
 
35
    my @f = split(/\s+/);
 
36
    # Should be at least three columns
 
37
    next unless scalar @f >= 3;
 
38
 
 
39
    # Linux 2.4 : parport 36832 1 (autoclean) [parport_pc lp]
 
40
    # Linux 2.6 : eeprom 14929 0 - Live 0xffffffff88cc5000
 
41
    my $module  = shift @f;
 
42
    my $size    = shift @f;
 
43
    my $used_by = shift @f;
 
44
    # this is ugly, needed to clean up the list of deps from 2.4 or 2.6
 
45
    my $deps    = join (' ',@f);
 
46
    $deps =~ s/ Live.*//;
 
47
    $deps =~ s/[\[\]\-(),]/ /g;
 
48
 
 
49
    Debug("$module");
 
50
    my $n = gv::node($G,$module);
 
51
 
 
52
    foreach my $d ( split(/\s+/,$deps) ){
 
53
        # gv::node($G, $d)  creates the node, if needed,
 
54
        #      but doesn't complain if it already exists
 
55
        Debug(" $d -> $module");
 
56
        gv::edge($n, gv::node($G, $d) );
 
57
    }
 
58
}
41
59
 
42
60
gv::layout($G, "dot");
43
 
gv::render($G, "gtk");
 
61
gv::render($G, "xlib");
 
62
 
 
63
sub Debug {
 
64
    return unless $Debug;
 
65
    warn join(" ",@_), "\n";
 
66
}
 
67
 
 
68
sub usage {
 
69
    return << "end_usage";
 
70
modgraph.pl
 
71
 
 
72
Displays Linux kernel module dependencies from $Modules
 
73
 
 
74
Author:    John Ellson <ellson\@research.att.com>
 
75
Perl Port: Max Baker <max\@warped.org>
 
76
 
 
77
Usage: $0 [--debug] [/proc/modules]
 
78
 
 
79
end_usage
 
80
}