1#!/usr/bin/perl
2
3# Generates a graph of the interdependencies between simulation components
4
5use strict;
6use warnings;
7
8use File::Find;
9use Data::Dumper;
10
11my %implements;
12my %implementedby;
13my %subscribes;
14my %queries;
15my %posts;
16my %native;
17
18for (<../../simulation2/components/CCmp*>)
19{
20    next if /CCmpTest/;
21    parse_ctype_cpp($_);
22}
23
24for (<../../../binaries/data/mods/public/simulation/components/*.js>)
25{
26    parse_ctype_js($_);
27}
28
29parse_helper_js("CommandQueue", "../../../binaries/data/mods/public/simulation/helpers/Commands.js");
30
31#parse_ctype_design("components.txt");
32
33# Add one that the parser misses
34$posts{RangeManager}{RangeUpdate} = 1;
35
36dump_stats();
37
38use Data::Dumper; print Dumper \%queries;
39
40dump_graph();
41system("dot -Tpng -o components.png components.dot");
42
43sub parse_ctype_cpp
44{
45    my ($fn) = @_;
46    print "$fn ...\n";
47    open my $f, $fn or die "can't open $fn: $!";
48    my $cmp;
49    if ($fn =~ /CCmpPathfinder/) { $cmp = 'Pathfinder'; } # because it's split into multiple .cpp files
50    while (<$f>) {
51        if (/class CCmp(\S+) : public ICmp(\S+)/) {
52            $implements{$1} = $2;
53            $implementedby{$2}{$1} = 1;
54            $native{$1} = 1;
55            $cmp = $1;
56        } elsif (/Subscribe(Globally)?ToMessageType\(MT_(\S+)\)/) {
57            $subscribes{$2}{$cmp} = 1;
58        } elsif (/CmpPtr<ICmp(\S+)>/) {
59            $queries{$cmp}{$1} = 1;
60        } elsif (/^\s*CMessage(\S+)/) {
61            $posts{$cmp}{$1} = 1;
62        }
63    }
64}
65
66sub parse_ctype_js
67{
68    my ($fn) = @_;
69    print "$fn ...\n";
70    open my $f, $fn or die "can't open $fn: $!";
71    my $cmp;
72    while (<$f>) {
73        if (/^\s*function (\S+)\s*\(\)\s*\{\s*\}\s*$/) {
74            $cmp = $1;
75        } elsif ($cmp and /\s*$cmp\.prototype\.On(?:Global)?(\S+)\s*=/) {
76            $subscribes{$1}{$cmp} = 1;
77        } elsif (/Engine\.QueryInterface\(.*?,\s*IID_(\S+?)\)/) {
78            $queries{$cmp}{$1} = 1;
79        } elsif (/Engine\.RegisterComponentType\(IID_(\S+), "(\S+)", (\S+)\);/) {
80            die unless $2 eq $cmp;
81            die unless $3 eq $cmp;
82            $implements{$cmp} = $1;
83            $implementedby{$1}{$cmp} = 1;
84        } elsif (/Engine\.(?:Post|Broadcast)Message\(\S+, MT_(\S+),/) {
85            $posts{$cmp}{$1} = 1;
86        }
87    }
88}
89
90sub parse_helper_js
91{
92    my ($cmp, $fn) = @_;
93    open my $f, $fn or die "can't open $fn: $!";
94    while (<$f>) {
95        if (/Engine\.QueryInterface\(.*?,\s*IID_(\S+)\)/) {
96            $queries{$cmp}{$1} = 1;
97        }
98        # TODO: check for message sending
99    }
100}
101
102sub parse_ctype_design
103{
104    my ($fn) = @_;
105    open my $f, $fn or die "can't open $fn: $!";
106    my $cmp;
107    while (<$f>) {
108        s/\s*#.*//;
109        next unless /\S/;
110        if (/^component (\S+)(?: : (\S+))?$/) {
111            $implements{$1} = ($2 || $1);
112            $implementedby{$2 || $1}{$1} = 1;
113            $cmp = $1;
114        } elsif (/^native$/) {
115            $native{$cmp} = 1;
116        } elsif (/^subscribe (\S+)$/) {
117            $subscribes{$1}{$cmp} = 1;
118        } elsif (/^query (\S+)$/) {
119            $queries{$cmp}{$1} = 1;
120        } elsif (/^post (\S+)$/) {
121            $posts{$cmp}{$1} = 1;
122        } else {
123            die "Invalid input line: $_ in $fn.";
124        }
125    }
126}
127
128sub dump_graph
129{
130    open my $f, '>', 'components.dot' or die $!;
131    print $f <<EOF;
132digraph g {
133    graph [ranksep=1 nodesep=0.1 fontsize=10 compound=true];
134    node [fontsize=10];
135    edge [fontsize=8];
136EOF
137
138#     for my $c (sort keys %implements) {
139#         print $f "$c;\n";
140#     }
141
142    for my $i (sort keys %implementedby) {
143        print $f "subgraph cluster_ifc_$i {\n";
144        print $f "label=\"$i\";\n";
145        for my $c (sort keys %{$implementedby{$i}}) {
146            my $col = ($native{$c} ? "green" : "black");
147            print $f "$c [color=$col];\n";
148        }
149        print $f "}\n";
150    }
151
152    print $f qq{node [color=gray fontcolor=gray];\n};
153
154    print $f qq{edge [color=blue fontcolor=blue];\n};
155
156    for my $c (sort keys %queries) {
157        next if $c eq 'GuiInterface' or $c eq 'CommandQueue'; # these make the graph messy
158        for my $t (sort keys %{$queries{$c}}) {
159            my $tc = (sort keys %{$implementedby{$t}})[0];
160            print $f qq{$c -> $tc [lhead=cluster_ifc_$t];\n};
161        }
162    }
163
164    print $f qq{edge [color=red fontcolor=red weight=0.9];\n};
165
166    for my $c (sort keys %posts) {
167        for my $m (sort keys %{$posts{$c}}) {
168            for my $t (sort keys %{$subscribes{$m}}) {
169                print $f qq{$c -> $t [label="$m"];\n};
170            }
171        }
172    }
173
174    print $f <<EOF;
175}
176EOF
177}
178
179sub dump_stats
180{
181    my ($native, $scripted) = (0, 0);
182    for my $c (keys %implements) {
183        if ($native{$c}) { ++$native; } else { ++$scripted; }
184    }
185    printf "Native components: %d\nScripted components: %d\nTotal components: %d\n", $native, $scripted, $native+$scripted;
186    printf "Interfaces: %d\n", (scalar keys %implementedby);
187}
188