File: creationgraph.pl

package info (click to toggle)
0ad 0.0.17-1
  • links: PTS, VCS
  • area: main
  • in suites: jessie, jessie-kfreebsd
  • size: 51,248 kB
  • ctags: 46,933
  • sloc: cpp: 223,208; ansic: 31,240; python: 16,343; perl: 4,083; sh: 1,011; makefile: 915; xml: 733; java: 621; ruby: 229; erlang: 53; sql: 40
file content (41 lines) | stat: -rw-r--r-- 1,134 bytes parent folder | download | duplicates (7)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
use strict;
use warnings;

use Entity;

my @files = Entity::find_entities();

my %files = map +($_ => 1), @files;

open my $g, '>', 'creation.dot' or die $!;
print $g "digraph G {\n";

for my $f (sort @files) {
    next if $f =~ /^template_/;
    print "# $f...\n";
    my $ent = Entity::load_inherited($f);

    if ($ent->{Entity}{Builder}) {
        my $ents = $ent->{Entity}{Builder}{Entities}{' content'};
        $ents =~ s/\{civ\}/$ent->{Entity}{Identity}{Civ}{' content'}/eg;
        for my $b (split /\s+/, $ents) {
            warn "Invalid Builder reference: $f -> $b\n" unless $files{$b};
            print $g qq{"$f" -> "$b" [color=green];\n};
        }
    }

    if ($ent->{Entity}{TrainingQueue}) {
        my $ents = $ent->{Entity}{TrainingQueue}{Entities}{' content'};
        $ents =~ s/\{civ\}/$ent->{Entity}{Identity}{Civ}{' content'}/eg;
        for my $b (split /\s+/, $ents) {
            warn "Invalid TrainingQueue reference: $f -> $b\n" unless $files{$b};
            print $g qq{"$f" -> "$b" [color=blue];\n};
        }
    }
}

print $g "}\n";

close $g;

system("dot -Tpng creation.dot -o creation.png");